From aeea80ede9603e4e5182a4527e8dfd2a2b479593 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 3 Mar 2023 10:38:52 +0300 Subject: [PATCH 001/143] refactor: COOMatrix --- .../Matrix/COOMatrix/COOMatrix.fs | 609 +++++++++++------- .../Matrix/CSRMatrix/CSRMatrix.fs | 12 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 10 +- 3 files changed, 385 insertions(+), 246 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs index 720ec20a..a674d235 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs @@ -2,6 +2,7 @@ namespace GraphBLAS.FSharp.Backend.Matrix.COO open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects @@ -10,305 +11,454 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext module COOMatrix = - let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupSize - = + module private Map2 = + let binSearch<'a> = + <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> - let preparePositions = - <@ fun (ndRange: Range1D) length (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftValuesBuffer: ClArray<'a>) (rightValuesBuffer: ClArray<'b>) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) (isLeftBitmap: ClArray) -> + let mutable leftEdge = 0 + let mutable rightEdge = lenght - let i = ndRange.GlobalID0 + let mutable result = None + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentIndex: uint64 = + ((uint64 rowIndices.[middleIdx]) <<< 32) + ||| (uint64 columnIndices.[middleIdx]) + + if sourceIndex = currentIndex then + result <- Some values[middleIdx] + + rightEdge <- leftEdge - 1 + elif sourceIndex < currentIndex then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + + let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) rowCount columnCount length (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < rowCount * columnCount then + + let rowInd = gid / rowCount + let columnInd = gid % rowCount - if (i < length - 1 - && allRowsBuffer.[i] = allRowsBuffer.[i + 1] - && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1]) then + let index = (uint64 rowInd <<< 32) ||| (uint64 columnInd) - let result = - (%opAdd) (Some leftValuesBuffer.[i + 1]) (Some rightValuesBuffer.[i]) + let leftValue = + (%binSearch) length index leftRows leftColumns leftValues - (%PreparePositions.both) i result rawPositionsBuffer allValuesBuffer - elif (i > 0 - && i < length - && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1] - || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1])) - || i = 0 then + let rightValue = + (%binSearch) length index rightRows rightColumn rightValues - let leftResult = - (%opAdd) (Some leftValuesBuffer.[i]) None + match (%op) leftValue rightValue with + | Some value -> + resultValues.[gid] <- value + resultRows.[gid] <- rowInd + resultColumns.[gid] <- columnInd - let rightResult = - (%opAdd) None (Some rightValuesBuffer.[i]) + resultBitmap.[gid] <- 1 + | None -> + resultBitmap.[gid] <- 0 @> - (%PreparePositions.leftRight) - i - leftResult - rightResult - isLeftBitmap - allValuesBuffer - rawPositionsBuffer @> + let kernel = clContext.Compile <| preparePositions opAdd - let kernel = clContext.Compile(preparePositions) + fun (processor: MailboxProcessor<_>) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> - fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> - let length = leftValues.Length + let (resultLength: int) = columnCount * rowCount - let ndRange = - Range1D.CreateValid(length, workGroupSize) + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let rawPositionsGpu = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let allValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let kernel = kernel.GetKernel() + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, resultLength) - processor.Post( - Msg.MsgSetArguments - (fun () -> + let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments( + fun () -> kernel.KernelFunc ndRange - length - allRows - allColumns + rowCount + columnCount + leftValues.Length leftValues + leftRows + leftColumns rightValues - allValues - rawPositionsGpu - isLeft) - ) + rightRows + rightColumns + resultBitmap + resultValues + resultRows + resultColumns)) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - rawPositionsGpu, allValues + processor.Post(Msg.CreateRunMsg<_, _> kernel) - let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = + resultBitmap, resultValues, resultRows, resultColumns - let merge = - <@ fun (ndRange: Range1D) firstSide secondSide sumOfSides (firstRowsBuffer: ClArray) (firstColumnsBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondRowsBuffer: ClArray) (secondColumnsBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftMergedValuesBuffer: ClArray<'a>) (rightMergedValuesBuffer: ClArray<'b>) (isLeftBitmap: ClArray) -> + ///. + ///. + ///Should be a power of 2 and greater than 1. + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let map2 = preparePositions clContext workGroupSize opAdd - let i = ndRange.GlobalID0 + let setPositions = Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 + let bitmap, values, rows, columns = + map2 queue matrixLeft.RowCount matrixLeft.ColumnCount matrixLeft.Values matrixLeft.Rows matrixLeft.Columns matrixRight.Values matrixRight.Rows matrixRight.Columns - if localID < 2 then - let x = localID * (workGroupSize - 1) + i - 1 + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode rows columns values bitmap - let diagonalNumber = min (sumOfSides - 1) x + queue.Post(Msg.CreateFreeMsg<_>(bitmap)) + queue.Post(Msg.CreateFreeMsg<_>(values)) + queue.Post(Msg.CreateFreeMsg<_>(rows)) + queue.Post(Msg.CreateFreeMsg<_>(columns)) - let mutable leftEdge = diagonalNumber + 1 - secondSide - leftEdge <- max 0 leftEdge + { Context = clContext + RowCount = matrixLeft.RowCount + ColumnCount = matrixLeft.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } - let mutable rightEdge = firstSide - 1 + let map2 = Map2.run - rightEdge <- min diagonalNumber rightEdge + module private AtLeastOneMap2 = + let preparePositionsAtLeastOne<'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 + = - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 + let preparePositions = + <@ fun (ndRange: Range1D) length (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftValuesBuffer: ClArray<'a>) (rightValuesBuffer: ClArray<'b>) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) (isLeftBitmap: ClArray) -> - let firstIndex: uint64 = - ((uint64 firstRowsBuffer.[middleIdx]) <<< 32) - ||| (uint64 firstColumnsBuffer.[middleIdx]) + let i = ndRange.GlobalID0 - let secondIndex: uint64 = - ((uint64 secondRowsBuffer.[diagonalNumber - middleIdx]) - <<< 32) - ||| (uint64 secondColumnsBuffer.[diagonalNumber - middleIdx]) + if (i < length - 1 + && allRowsBuffer.[i] = allRowsBuffer.[i + 1] + && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1]) then - if firstIndex < secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 + let result = + (%opAdd) (Some leftValuesBuffer.[i + 1]) (Some rightValuesBuffer.[i]) - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge + (%PreparePositions.both) i result rawPositionsBuffer allValuesBuffer + elif (i > 0 + && i < length + && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1] + || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1])) + || i = 0 then - barrierLocal () + let leftResult = + (%opAdd) (Some leftValuesBuffer.[i]) None - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength + let rightResult = + (%opAdd) None (Some rightValuesBuffer.[i]) - if endIdx = firstSide then - x <- secondSide - i + localID + beginIdx + (%PreparePositions.leftRight) + i + leftResult + rightResult + isLeftBitmap + allValuesBuffer + rawPositionsBuffer @> - let secondLocalLength = x + let kernel = clContext.Compile(preparePositions) - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize + fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + let length = leftValues.Length - if localID < firstLocalLength then - localIndices.[localID] <- - ((uint64 firstRowsBuffer.[beginIdx + localID]) - <<< 32) - ||| (uint64 firstColumnsBuffer.[beginIdx + localID]) + let ndRange = + Range1D.CreateValid(length, workGroupSize) - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- - ((uint64 secondRowsBuffer.[i - beginIdx]) <<< 32) - ||| (uint64 secondColumnsBuffer.[i - beginIdx]) + let rawPositionsGpu = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - barrierLocal () + let allValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - leftEdge <- max 0 leftEdge + let kernel = kernel.GetKernel() - let mutable rightEdge = firstLocalLength - 1 + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + length + allRows + allColumns + leftValues + rightValues + allValues + rawPositionsGpu + isLeft) + ) - rightEdge <- min localID rightEdge + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + rawPositionsGpu, allValues - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] + let merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] + let merge = + <@ fun (ndRange: Range1D) firstSide secondSide sumOfSides (firstRowsBuffer: ClArray) (firstColumnsBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondRowsBuffer: ClArray) (secondColumnsBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftMergedValuesBuffer: ClArray<'a>) (rightMergedValuesBuffer: ClArray<'b>) (isLeftBitmap: ClArray) -> - if firstIndex < secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 + let i = ndRange.GlobalID0 - let boundaryX = rightEdge - let boundaryY = localID - leftEdge + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 - // 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 + if localID < 2 then + let x = localID * (workGroupSize - 1) + i - 1 - let mutable fstIdx = 0UL + let diagonalNumber = min (sumOfSides - 1) x - if isValidX then - fstIdx <- localIndices.[boundaryX] + let mutable leftEdge = diagonalNumber + 1 - secondSide + leftEdge <- max 0 leftEdge - let mutable sndIdx = 0UL + let mutable rightEdge = firstSide - 1 - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] + rightEdge <- min diagonalNumber rightEdge - if not isValidX || isValidY && fstIdx < sndIdx then - allRowsBuffer.[i] <- int (sndIdx >>> 32) - allColumnsBuffer.[i] <- int sndIdx - rightMergedValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - isLeftBitmap.[i] <- 0 - else - allRowsBuffer.[i] <- int (fstIdx >>> 32) - allColumnsBuffer.[i] <- int fstIdx - leftMergedValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - isLeftBitmap.[i] <- 1 @> + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 - let kernel = clContext.Compile(merge) + let firstIndex: uint64 = + ((uint64 firstRowsBuffer.[middleIdx]) <<< 32) + ||| (uint64 firstColumnsBuffer.[middleIdx]) - fun (processor: MailboxProcessor<_>) (matrixLeftRows: ClArray) (matrixLeftColumns: ClArray) (matrixLeftValues: ClArray<'a>) (matrixRightRows: ClArray) (matrixRightColumns: ClArray) (matrixRightValues: ClArray<'b>) -> + let secondIndex: uint64 = + ((uint64 secondRowsBuffer.[diagonalNumber - middleIdx]) + <<< 32) + ||| (uint64 secondColumnsBuffer.[diagonalNumber - middleIdx]) - let firstSide = matrixLeftValues.Length - let secondSide = matrixRightValues.Length - let sumOfSides = firstSide + secondSide + if firstIndex < secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 - let allRows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + // Here localID equals either 0 or 1 + if localID = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge - let allColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + barrierLocal () - let leftMergedValues = - clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) + let beginIdx = beginIdxLocal + let endIdx = endIdxLocal + let firstLocalLength = endIdx - beginIdx + let mutable x = workGroupSize - firstLocalLength - let rightMergedValues = - clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) + if endIdx = firstSide then + x <- secondSide - i + localID + beginIdx - let isLeft = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + let secondLocalLength = x - let ndRange = - Range1D.CreateValid(sumOfSides, workGroupSize) + //First indices are from 0 to firstLocalLength - 1 inclusive + //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive + let localIndices = localArray workGroupSize - let kernel = kernel.GetKernel() + if localID < firstLocalLength then + localIndices.[localID] <- + ((uint64 firstRowsBuffer.[beginIdx + localID]) + <<< 32) + ||| (uint64 firstColumnsBuffer.[beginIdx + localID]) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - matrixLeftRows - matrixLeftColumns - matrixLeftValues - matrixRightRows - matrixRightColumns - matrixRightValues - allRows - allColumns - leftMergedValues - rightMergedValues - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - allRows, allColumns, leftMergedValues, rightMergedValues, isLeft + if localID < secondLocalLength then + localIndices.[firstLocalLength + localID] <- + ((uint64 secondRowsBuffer.[i - beginIdx]) <<< 32) + ||| (uint64 secondColumnsBuffer.[i - beginIdx]) - ///. - ///. - ///Should be a power of 2 and greater than 1. - 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 - = + barrierLocal () - let merge = merge clContext workGroupSize + if i < sumOfSides then + let mutable leftEdge = localID + 1 - secondLocalLength + leftEdge <- max 0 leftEdge - let preparePositions = - preparePositions clContext opAdd workGroupSize + let mutable rightEdge = firstLocalLength - 1 - let setPositions = - Matrix.Common.setPositions<'c> clContext workGroupSize + rightEdge <- min localID rightEdge - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] - let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = - merge - queue - matrixLeft.Rows - matrixLeft.Columns - matrixLeft.Values - matrixRight.Rows - matrixRight.Columns - matrixRight.Values + let secondIndex = + localIndices.[firstLocalLength + localID - middleIdx] - let rawPositions, allValues = - preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft + if firstIndex < secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + let boundaryX = rightEdge + let boundaryY = localID - leftEdge - let resultRows, resultColumns, resultValues, _ = - setPositions queue allocationMode allRows allColumns allValues rawPositions + // 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 - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) + let mutable fstIdx = 0UL - { Context = clContext - RowCount = matrixLeft.RowCount - ColumnCount = matrixLeft.ColumnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues } + if isValidX then + fstIdx <- localIndices.[boundaryX] + + let mutable sndIdx = 0UL + + if isValidY then + sndIdx <- localIndices.[firstLocalLength + boundaryY] + + if not isValidX || isValidY && fstIdx < sndIdx then + allRowsBuffer.[i] <- int (sndIdx >>> 32) + allColumnsBuffer.[i] <- int sndIdx + rightMergedValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + isLeftBitmap.[i] <- 0 + else + allRowsBuffer.[i] <- int (fstIdx >>> 32) + allColumnsBuffer.[i] <- int fstIdx + leftMergedValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitmap.[i] <- 1 @> + + let kernel = clContext.Compile(merge) + + fun (processor: MailboxProcessor<_>) (matrixLeftRows: ClArray) (matrixLeftColumns: ClArray) (matrixLeftValues: ClArray<'a>) (matrixRightRows: ClArray) (matrixRightColumns: ClArray) (matrixRightValues: ClArray<'b>) -> + + let firstSide = matrixLeftValues.Length + let secondSide = matrixRightValues.Length + let sumOfSides = firstSide + secondSide + + let allRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let allColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let leftMergedValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) + + let rightMergedValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) + + let isLeft = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let ndRange = + Range1D.CreateValid(sumOfSides, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + matrixLeftRows + matrixLeftColumns + matrixLeftValues + matrixRightRows + matrixRightColumns + matrixRightValues + allRows + allColumns + leftMergedValues + rightMergedValues + isLeft) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allRows, allColumns, leftMergedValues, rightMergedValues, isLeft + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let merge = merge clContext workGroupSize + + let preparePositions = + preparePositionsAtLeastOne clContext opAdd workGroupSize + + let setPositions = + Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + + let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = + merge + queue + matrixLeft.Rows + matrixLeft.Columns + matrixLeft.Values + matrixRight.Rows + matrixRight.Columns + matrixRight.Values + + let rawPositions, allValues = + preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft + + queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) + queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode allRows allColumns allValues rawPositions + + queue.Post(Msg.CreateFreeMsg<_>(isLeft)) + queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) + queue.Post(Msg.CreateFreeMsg<_>(allRows)) + queue.Post(Msg.CreateFreeMsg<_>(allColumns)) + queue.Post(Msg.CreateFreeMsg<_>(allValues)) + + { Context = clContext + RowCount = matrixLeft.RowCount + ColumnCount = matrixLeft.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + workGroupSize + = + + AtLeastOneMap2.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize let getTuples (clContext: ClContext) workGroupSize = @@ -384,7 +534,7 @@ module COOMatrix = let cols = copy processor allocationMode matrix.Columns - let vals = + let values = copyData processor allocationMode matrix.Values { Context = clContext @@ -392,7 +542,7 @@ module COOMatrix = ColumnCount = matrix.ColumnCount RowPointers = rowPointers Columns = cols - Values = vals } + Values = values } let toCSRInplace (clContext: ClContext) workGroupSize = let prepare = compressRows clContext workGroupSize @@ -410,17 +560,6 @@ module COOMatrix = Columns = matrix.Columns Values = matrix.Values } - ///. - ///. - ///Should be a power of 2 and greater than 1. - let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - workGroupSize - = - - map2 clContext (Convert.atLeastOneToOption opAdd) workGroupSize - let transposeInplace (clContext: ClContext) workGroupSize = let sort = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs index 21882051..1713d6c1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs @@ -26,14 +26,14 @@ module CSRMatrix = let program = clContext.Compile(expandRowPointers) - let create = ClArray.create clContext workGroupSize + let create = ClArray.zeroCreate clContext workGroupSize let scan = ClArray.prefixSumIncludeInplace <@ max @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> - let rows = create processor allocationMode nnz 0 + let rows = create processor allocationMode nnz let kernel = program.GetKernel() @@ -63,7 +63,7 @@ module CSRMatrix = let cols = copy processor allocationMode matrix.Columns - let vals = + let values = copyData processor allocationMode matrix.Values { Context = clContext @@ -71,7 +71,7 @@ module CSRMatrix = ColumnCount = matrix.ColumnCount Rows = rows Columns = cols - Values = vals } + Values = values } let toCOOInplace (clContext: ClContext) workGroupSize = let prepare = @@ -96,7 +96,7 @@ module CSRMatrix = let prepareRows = expandRowPointers clContext workGroupSize - let eWiseCOO = + let map2COO = COOMatrix.map2 clContext opAdd workGroupSize let toCSRInplace = @@ -120,7 +120,7 @@ module CSRMatrix = Values = m2.Values } let m3COO = - eWiseCOO processor allocationMode m1COO m2COO + map2COO processor allocationMode m1COO m2COO processor.Post(Msg.CreateFreeMsg(m1COO.Rows)) processor.Post(Msg.CreateFreeMsg(m2COO.Rows)) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 5e38c56b..65639812 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -248,19 +248,19 @@ module Matrix = |> ClMatrix.CSC let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = - let COOElementwise = + let map2COO = COOMatrix.map2 clContext opAdd workGroupSize - let CSRElementwise = + let map2CSR = CSRMatrix.map2 clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> - COOElementwise processor allocationMode m1 m2 + map2COO processor allocationMode m1 m2 |> ClMatrix.COO | ClMatrix.CSR m1, ClMatrix.CSR m2 -> - CSRElementwise processor allocationMode m1 m2 + map2CSR processor allocationMode m1 m2 |> ClMatrix.CSR | ClMatrix.CSC m1, ClMatrix.CSC m2 -> let csrT1 = @@ -280,7 +280,7 @@ module Matrix = Values = m2.Values } let resT = - CSRElementwise processor allocationMode csrT1 csrT2 + map2CSR processor allocationMode csrT1 csrT2 { Context = resT.Context RowCount = resT.ColumnCount From 98e7271e72720f93d770ac5865287b6ce8ee3df6 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 6 Mar 2023 19:50:25 +0300 Subject: [PATCH 002/143] refactor: ToCSC, ToCSR --- .../BenchmarksEWiseAdd.fs | 21 +- .../VectorEWiseAddGen.fs | 10 +- .../GraphBLAS-sharp.Backend.fsproj | 10 +- .../Matrix/COOMatrix/COOMatrix.fs | 594 ------------------ .../Matrix/COOMatrix/Map2.fs | 144 +++++ .../Matrix/COOMatrix/Map2AtLeastOne.fs | 312 +++++++++ .../Matrix/COOMatrix/Matrix.fs | 155 +++++ .../CSRMatrix/{Map2.fs => Map2AtLeastOne.fs} | 70 ++- .../CSRMatrix/{CSRMatrix.fs => Matrix.fs} | 153 +---- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 255 ++------ src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 28 +- .../Vector/SparseVector/Common.fs | 37 ++ .../Vector/SparseVector/Map2.fs | 269 ++++---- .../Vector/SparseVector/Map2AtLeastOne.fs | 261 ++++++++ .../Vector/SparseVector/SparseVector.fs | 311 +-------- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 59 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 11 + tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 7 +- tests/GraphBLAS-sharp.Tests/Program.fs | 115 ++-- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 40 +- 20 files changed, 1334 insertions(+), 1528 deletions(-) delete mode 100644 src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs rename src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/{Map2.fs => Map2AtLeastOne.fs} (81%) rename src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/{CSRMatrix.fs => Matrix.fs} (52%) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs create mode 100644 src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs index 1c398910..c75c4770 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs @@ -9,8 +9,7 @@ open BenchmarkDotNet.Columns open Brahma.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Matrix.COO -open GraphBLAS.FSharp.Backend.Matrix.CSR +open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Objects.Matrix open GraphBLAS.FSharp.Benchmarks.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext @@ -196,7 +195,7 @@ module M = type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COOMatrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCOO @@ -208,7 +207,7 @@ type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = type EWiseAddBenchmarks4Float32COOWithDataTransfer() = inherit EWiseAddBenchmarksWithDataTransfer,float32>( - (fun context wgSize -> COOMatrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCOO, @@ -222,7 +221,7 @@ type EWiseAddBenchmarks4Float32COOWithDataTransfer() = type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COOMatrix.map2 context ArithmeticOperations.boolSum wgSize), + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.boolSum wgSize), (fun _ -> true), (fun _ -> true), Matrix.ToBackendCOO @@ -235,7 +234,7 @@ type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSRMatrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCSR @@ -248,7 +247,7 @@ type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = type EWiseAddBenchmarks4BoolCSRWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSRMatrix.map2 context ArithmeticOperations.boolSum wgSize), + (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.boolSum wgSize), (fun _ -> true), (fun _ -> true), Matrix.ToBackendCSR @@ -262,7 +261,7 @@ type EWiseAddBenchmarks4BoolCSRWithoutDataTransfer() = type EWiseAddAtLeastOneBenchmarks4BoolCOOWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COOMatrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), + (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), (fun _ -> true), (fun _ -> true), Matrix.ToBackendCOO @@ -274,7 +273,7 @@ type EWiseAddAtLeastOneBenchmarks4BoolCOOWithoutDataTransfer() = type EWiseAddAtLeastOneBenchmarks4BoolCSRWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSRMatrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), + (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), (fun _ -> true), (fun _ -> true), Matrix.ToBackendCSR @@ -286,7 +285,7 @@ type EWiseAddAtLeastOneBenchmarks4BoolCSRWithoutDataTransfer() = type EWiseAddAtLeastOneBenchmarks4Float32COOWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COOMatrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), + (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCOO @@ -298,7 +297,7 @@ type EWiseAddAtLeastOneBenchmarks4Float32COOWithoutDataTransfer() = type EWiseAddAtLeastOneBenchmarks4Float32CSRWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSRMatrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), + (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCSR diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs index 935ca206..378a2036 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs @@ -155,7 +155,7 @@ type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( override this.GlobalCleanup() = () /// Without data transfer - +/// AtLeastOne type VectorEWiseBenchmarks4FloatSparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( @@ -173,13 +173,13 @@ type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = type VectorEWiseGeneralBenchmarks4FloatSparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2General context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSum), VectorGenerator.floatPair Sparse) type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2General context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSum), VectorGenerator.intPair Sparse) /// With data transfer @@ -201,11 +201,11 @@ type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = type VectorEWiseGeneralBenchmarks4FloatSparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2General context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSum), VectorGenerator.floatPair Sparse) type VectorEWiseGeneralBenchmarks4Int32SparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2General context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSum), VectorGenerator.intPair Sparse) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 35d7e632..b24ea69c 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,12 +35,16 @@ - - + + + + - + + + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs deleted file mode 100644 index a674d235..00000000 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/COOMatrix.fs +++ /dev/null @@ -1,594 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.COO - -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common -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 COOMatrix = - module private Map2 = - let binSearch<'a> = - <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> - - let mutable leftEdge = 0 - let mutable rightEdge = lenght - - let mutable result = None - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - - let currentIndex: uint64 = - ((uint64 rowIndices.[middleIdx]) <<< 32) - ||| (uint64 columnIndices.[middleIdx]) - - if sourceIndex = currentIndex then - result <- Some values[middleIdx] - - rightEdge <- leftEdge - 1 - elif sourceIndex < currentIndex then - rightEdge <- middleIdx - 1 - else - leftEdge <- middleIdx + 1 - - result @> - - let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = - - let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = - <@ fun (ndRange: Range1D) rowCount columnCount length (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> - - let gid = ndRange.GlobalID0 - - if gid < rowCount * columnCount then - - let rowInd = gid / rowCount - let columnInd = gid % rowCount - - let index = (uint64 rowInd <<< 32) ||| (uint64 columnInd) - - let leftValue = - (%binSearch) length index leftRows leftColumns leftValues - - let rightValue = - (%binSearch) length index rightRows rightColumn rightValues - - match (%op) leftValue rightValue with - | Some value -> - resultValues.[gid] <- value - resultRows.[gid] <- rowInd - resultColumns.[gid] <- columnInd - - 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.Length - 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 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 map2 = preparePositions clContext workGroupSize opAdd - - let setPositions = Common.setPositions<'c> clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> - - let bitmap, values, rows, columns = - map2 queue matrixLeft.RowCount matrixLeft.ColumnCount matrixLeft.Values matrixLeft.Rows matrixLeft.Columns matrixRight.Values matrixRight.Rows 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 map2 = Map2.run - - module private AtLeastOneMap2 = - let preparePositionsAtLeastOne<'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 preparePositions = - <@ fun (ndRange: Range1D) length (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftValuesBuffer: ClArray<'a>) (rightValuesBuffer: ClArray<'b>) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) (isLeftBitmap: ClArray) -> - - let i = ndRange.GlobalID0 - - if (i < length - 1 - && allRowsBuffer.[i] = allRowsBuffer.[i + 1] - && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1]) then - - let result = - (%opAdd) (Some leftValuesBuffer.[i + 1]) (Some rightValuesBuffer.[i]) - - (%PreparePositions.both) i result rawPositionsBuffer allValuesBuffer - elif (i > 0 - && i < length - && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1] - || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1])) - || i = 0 then - - let leftResult = - (%opAdd) (Some leftValuesBuffer.[i]) None - - let rightResult = - (%opAdd) None (Some rightValuesBuffer.[i]) - - (%PreparePositions.leftRight) - i - leftResult - rightResult - isLeftBitmap - allValuesBuffer - rawPositionsBuffer @> - - let kernel = clContext.Compile(preparePositions) - - fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> - let length = leftValues.Length - - let ndRange = - Range1D.CreateValid(length, workGroupSize) - - let rawPositionsGpu = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - let allValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allRows - allColumns - leftValues - rightValues - allValues - rawPositionsGpu - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - rawPositionsGpu, allValues - - let merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = - - let merge = - <@ fun (ndRange: Range1D) firstSide secondSide sumOfSides (firstRowsBuffer: ClArray) (firstColumnsBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondRowsBuffer: ClArray) (secondColumnsBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftMergedValuesBuffer: ClArray<'a>) (rightMergedValuesBuffer: ClArray<'b>) (isLeftBitmap: ClArray) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - - if localID < 2 then - let x = localID * (workGroupSize - 1) + i - 1 - - let diagonalNumber = min (sumOfSides - 1) x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - leftEdge <- max 0 leftEdge - - let mutable rightEdge = firstSide - 1 - - rightEdge <- min diagonalNumber rightEdge - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - - let firstIndex: uint64 = - ((uint64 firstRowsBuffer.[middleIdx]) <<< 32) - ||| (uint64 firstColumnsBuffer.[middleIdx]) - - let secondIndex: uint64 = - ((uint64 secondRowsBuffer.[diagonalNumber - middleIdx]) - <<< 32) - ||| (uint64 secondColumnsBuffer.[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 - - barrierLocal () - - 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] <- - ((uint64 firstRowsBuffer.[beginIdx + localID]) - <<< 32) - ||| (uint64 firstColumnsBuffer.[beginIdx + localID]) - - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- - ((uint64 secondRowsBuffer.[i - beginIdx]) <<< 32) - ||| (uint64 secondColumnsBuffer.[i - beginIdx]) - - barrierLocal () - - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - leftEdge <- max 0 leftEdge - - let mutable rightEdge = firstLocalLength - 1 - - rightEdge <- min localID rightEdge - - 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 = 0UL - - if isValidX then - fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0UL - - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx < sndIdx then - allRowsBuffer.[i] <- int (sndIdx >>> 32) - allColumnsBuffer.[i] <- int sndIdx - rightMergedValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - isLeftBitmap.[i] <- 0 - else - allRowsBuffer.[i] <- int (fstIdx >>> 32) - allColumnsBuffer.[i] <- int fstIdx - leftMergedValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - isLeftBitmap.[i] <- 1 @> - - let kernel = clContext.Compile(merge) - - fun (processor: MailboxProcessor<_>) (matrixLeftRows: ClArray) (matrixLeftColumns: ClArray) (matrixLeftValues: ClArray<'a>) (matrixRightRows: ClArray) (matrixRightColumns: ClArray) (matrixRightValues: ClArray<'b>) -> - - let firstSide = matrixLeftValues.Length - let secondSide = matrixRightValues.Length - let sumOfSides = firstSide + secondSide - - let allRows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let allColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let leftMergedValues = - clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) - - let rightMergedValues = - clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) - - let isLeft = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let ndRange = - Range1D.CreateValid(sumOfSides, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - matrixLeftRows - matrixLeftColumns - matrixLeftValues - matrixRightRows - matrixRightColumns - matrixRightValues - allRows - allColumns - leftMergedValues - rightMergedValues - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - allRows, allColumns, leftMergedValues, rightMergedValues, isLeft - - ///. - ///. - ///Should be a power of 2 and greater than 1. - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupSize - = - - let merge = merge clContext workGroupSize - - let preparePositions = - preparePositionsAtLeastOne clContext opAdd workGroupSize - - let setPositions = - Common.setPositions<'c> clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> - - let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = - merge - queue - matrixLeft.Rows - matrixLeft.Columns - matrixLeft.Values - matrixRight.Rows - matrixRight.Columns - matrixRight.Values - - let rawPositions, allValues = - preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft - - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) - - let resultRows, resultColumns, resultValues, _ = - setPositions queue allocationMode allRows allColumns allValues rawPositions - - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) - - { Context = clContext - RowCount = matrixLeft.RowCount - ColumnCount = matrixLeft.ColumnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues } - - ///. - ///. - ///Should be a power of 2 and greater than 1. - let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - workGroupSize - = - - AtLeastOneMap2.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize - - let getTuples (clContext: ClContext) workGroupSize = - - let copy = ClArray.copy clContext workGroupSize - - let copyData = ClArray.copy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> - - let resultRows = - copy processor allocationMode matrix.Rows - - let resultColumns = - copy processor allocationMode matrix.Columns - - let resultValues = - copyData processor allocationMode matrix.Values - - { Context = clContext - RowIndices = resultRows - ColumnIndices = resultColumns - Values = resultValues } - - let private compressRows (clContext: ClContext) workGroupSize = - - let compressRows = - <@ fun (ndRange: Range1D) (rows: ClArray) (nnz: int) (rowPointers: ClArray) -> - - let i = ndRange.GlobalID0 - - if i < nnz then - let row = rows.[i] - - if i = 0 || row <> rows.[i - 1] then - rowPointers.[row] <- i @> - - let program = clContext.Compile(compressRows) - - let create = ClArray.create clContext workGroupSize - - let scan = - ClArray.prefixSumBackwardsIncludeInplace <@ min @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (rowIndices: ClArray) rowCount -> - - let nnz = rowIndices.Length - - let rowPointers = - create processor allocationMode (rowCount + 1) nnz - - let kernel = program.GetKernel() - - let ndRange = Range1D.CreateValid(nnz, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowIndices nnz rowPointers)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - let result = scan processor rowPointers nnz - processor.Post <| Msg.CreateFreeMsg(result) - - rowPointers - - let toCSR (clContext: ClContext) workGroupSize = - let prepare = compressRows clContext workGroupSize - - let copy = ClArray.copy clContext workGroupSize - - let copyData = ClArray.copy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> - let rowPointers = - prepare processor allocationMode matrix.Rows matrix.RowCount - - let cols = - copy processor allocationMode matrix.Columns - - let values = - copyData processor allocationMode matrix.Values - - { Context = clContext - RowCount = matrix.RowCount - ColumnCount = matrix.ColumnCount - RowPointers = rowPointers - Columns = cols - Values = values } - - let toCSRInplace (clContext: ClContext) workGroupSize = - let prepare = compressRows clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> - let rowPointers = - prepare processor allocationMode matrix.Rows matrix.RowCount - - processor.Post(Msg.CreateFreeMsg(matrix.Rows)) - - { Context = clContext - RowCount = matrix.RowCount - ColumnCount = matrix.ColumnCount - RowPointers = rowPointers - Columns = matrix.Columns - Values = matrix.Values } - - let transposeInplace (clContext: ClContext) workGroupSize = - - let sort = - BitonicSort.sortKeyValuesInplace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.COO<'a>) -> - sort queue matrix.Columns matrix.Rows matrix.Values - - { Context = clContext - RowCount = matrix.ColumnCount - ColumnCount = matrix.RowCount - Rows = matrix.Columns - Columns = matrix.Rows - Values = matrix.Values } - - let transpose (clContext: ClContext) workGroupSize = - - let transposeInplace = transposeInplace clContext workGroupSize - - let copy = ClArray.copy clContext workGroupSize - - let copyData = ClArray.copy clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> - - { Context = clContext - RowCount = matrix.RowCount - ColumnCount = matrix.ColumnCount - Rows = copy queue allocationMode matrix.Rows - Columns = copy queue allocationMode matrix.Columns - Values = copyData queue allocationMode matrix.Values } - |> transposeInplace queue diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs new file mode 100644 index 00000000..d4376a1d --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -0,0 +1,144 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.COO + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Matrix +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 Map2 = + let binSearch<'a> = + <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> + + let mutable leftEdge = 0 + let mutable rightEdge = lenght - 1 + + let mutable result = None + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentIndex: uint64 = + ((uint64 rowIndices.[middleIdx]) <<< 32) + ||| (uint64 columnIndices.[middleIdx]) + + if sourceIndex = currentIndex then + result <- Some values.[middleIdx] + + rightEdge <- -1 // TODO() break + elif sourceIndex < currentIndex then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + + let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) rowCount columnCount length (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: 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 index = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) + + let leftValue = + (%binSearch) length index leftRows leftColumns leftValues + + let rightValue = + (%binSearch) length index rightRows 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.Length + 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 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 map2 = preparePositions clContext workGroupSize opAdd + + let setPositions = Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + + let bitmap, values, rows, columns = + map2 queue matrixLeft.RowCount matrixLeft.ColumnCount matrixLeft.Values matrixLeft.Rows matrixLeft.Columns matrixRight.Values matrixRight.Rows 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 } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs new file mode 100644 index 00000000..2acff06f --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs @@ -0,0 +1,312 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.COO + +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 Map2AtLeastOne = + let preparePositionsAtLeastOne<'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 preparePositions = + <@ fun (ndRange: Range1D) length (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftValuesBuffer: ClArray<'a>) (rightValuesBuffer: ClArray<'b>) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) (isLeftBitmap: ClArray) -> + + let i = ndRange.GlobalID0 + + if (i < length - 1 + && allRowsBuffer.[i] = allRowsBuffer.[i + 1] + && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1]) then + + let result = + (%opAdd) (Some leftValuesBuffer.[i + 1]) (Some rightValuesBuffer.[i]) + + (%PreparePositions.both) i result rawPositionsBuffer allValuesBuffer + elif (i > 0 + && i < length + && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1] + || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1])) + || i = 0 then + + let leftResult = + (%opAdd) (Some leftValuesBuffer.[i]) None + + let rightResult = + (%opAdd) None (Some rightValuesBuffer.[i]) + + (%PreparePositions.leftRight) + i + leftResult + rightResult + isLeftBitmap + allValuesBuffer + rawPositionsBuffer @> + + let kernel = clContext.Compile(preparePositions) + + fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + let length = leftValues.Length + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let rawPositionsGpu = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + let allValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + length + allRows + allColumns + leftValues + rightValues + allValues + rawPositionsGpu + isLeft) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + rawPositionsGpu, allValues + + let merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = + + let merge = + <@ fun (ndRange: Range1D) firstSide secondSide sumOfSides (firstRowsBuffer: ClArray) (firstColumnsBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondRowsBuffer: ClArray) (secondColumnsBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftMergedValuesBuffer: ClArray<'a>) (rightMergedValuesBuffer: ClArray<'b>) (isLeftBitmap: ClArray) -> + + let i = ndRange.GlobalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 + + if localID < 2 then + let x = localID * (workGroupSize - 1) + i - 1 + + let diagonalNumber = min (sumOfSides - 1) x + + let mutable leftEdge = diagonalNumber + 1 - secondSide + leftEdge <- max 0 leftEdge + + let mutable rightEdge = firstSide - 1 + + rightEdge <- min diagonalNumber rightEdge + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let firstIndex: uint64 = + ((uint64 firstRowsBuffer.[middleIdx]) <<< 32) + ||| (uint64 firstColumnsBuffer.[middleIdx]) + + let secondIndex: uint64 = + ((uint64 secondRowsBuffer.[diagonalNumber - middleIdx]) + <<< 32) + ||| (uint64 secondColumnsBuffer.[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 + + barrierLocal () + + 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] <- + ((uint64 firstRowsBuffer.[beginIdx + localID]) + <<< 32) + ||| (uint64 firstColumnsBuffer.[beginIdx + localID]) + + if localID < secondLocalLength then + localIndices.[firstLocalLength + localID] <- + ((uint64 secondRowsBuffer.[i - beginIdx]) <<< 32) + ||| (uint64 secondColumnsBuffer.[i - beginIdx]) + + barrierLocal () + + if i < sumOfSides then + let mutable leftEdge = localID + 1 - secondLocalLength + leftEdge <- max 0 leftEdge + + let mutable rightEdge = firstLocalLength - 1 + + rightEdge <- min localID rightEdge + + 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 = 0UL + + if isValidX then + fstIdx <- localIndices.[boundaryX] + + let mutable sndIdx = 0UL + + if isValidY then + sndIdx <- localIndices.[firstLocalLength + boundaryY] + + if not isValidX || isValidY && fstIdx < sndIdx then + allRowsBuffer.[i] <- int (sndIdx >>> 32) + allColumnsBuffer.[i] <- int sndIdx + rightMergedValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + isLeftBitmap.[i] <- 0 + else + allRowsBuffer.[i] <- int (fstIdx >>> 32) + allColumnsBuffer.[i] <- int fstIdx + leftMergedValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitmap.[i] <- 1 @> + + let kernel = clContext.Compile(merge) + + fun (processor: MailboxProcessor<_>) (matrixLeftRows: ClArray) (matrixLeftColumns: ClArray) (matrixLeftValues: ClArray<'a>) (matrixRightRows: ClArray) (matrixRightColumns: ClArray) (matrixRightValues: ClArray<'b>) -> + + let firstSide = matrixLeftValues.Length + let secondSide = matrixRightValues.Length + let sumOfSides = firstSide + secondSide + + let allRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let allColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let leftMergedValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) + + let rightMergedValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) + + let isLeft = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let ndRange = + Range1D.CreateValid(sumOfSides, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + matrixLeftRows + matrixLeftColumns + matrixLeftValues + matrixRightRows + matrixRightColumns + matrixRightValues + allRows + allColumns + leftMergedValues + rightMergedValues + isLeft) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allRows, allColumns, leftMergedValues, rightMergedValues, isLeft + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let merge = merge clContext workGroupSize + + let preparePositions = + preparePositionsAtLeastOne clContext opAdd workGroupSize + + let setPositions = + Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + + let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = + merge + queue + matrixLeft.Rows + matrixLeft.Columns + matrixLeft.Values + matrixRight.Rows + matrixRight.Columns + matrixRight.Values + + let rawPositions, allValues = + preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft + + queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) + queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode allRows allColumns allValues rawPositions + + queue.Post(Msg.CreateFreeMsg<_>(isLeft)) + queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) + queue.Post(Msg.CreateFreeMsg<_>(allRows)) + queue.Post(Msg.CreateFreeMsg<_>(allColumns)) + queue.Post(Msg.CreateFreeMsg<_>(allValues)) + + { Context = clContext + RowCount = matrixLeft.RowCount + ColumnCount = matrixLeft.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs new file mode 100644 index 00000000..b7714251 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs @@ -0,0 +1,155 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.COO + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Quotes +open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClMatrix + +module Matrix = + let map2 = Map2.run + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let rec map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + workGroupSize + = + + Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize + + let getTuples (clContext: ClContext) workGroupSize = + + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + + let resultRows = + copy processor allocationMode matrix.Rows + + let resultColumns = + copy processor allocationMode matrix.Columns + + let resultValues = + copyData processor allocationMode matrix.Values + + { Context = clContext + RowIndices = resultRows + ColumnIndices = resultColumns + Values = resultValues } + + let private compressRows (clContext: ClContext) workGroupSize = + + let compressRows = + <@ fun (ndRange: Range1D) (rows: ClArray) (nnz: int) (rowPointers: ClArray) -> + + let i = ndRange.GlobalID0 + + if i < nnz then + let row = rows.[i] + + if i = 0 || row <> rows.[i - 1] then + rowPointers.[row] <- i @> + + let program = clContext.Compile(compressRows) + + let create = ClArray.create clContext workGroupSize + + let scan = + ClArray.prefixSumBackwardsIncludeInplace <@ min @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (rowIndices: ClArray) rowCount -> + + let nnz = rowIndices.Length + + let rowPointers = + create processor allocationMode (rowCount + 1) nnz + + let kernel = program.GetKernel() + + let ndRange = Range1D.CreateValid(nnz, workGroupSize) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowIndices nnz rowPointers)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + let result = scan processor rowPointers nnz + processor.Post <| Msg.CreateFreeMsg(result) + + rowPointers + + let toCSR (clContext: ClContext) workGroupSize = + let prepare = compressRows clContext workGroupSize + + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + let rowPointers = + prepare processor allocationMode matrix.Rows matrix.RowCount + + let cols = + copy processor allocationMode matrix.Columns + + let values = + copyData processor allocationMode matrix.Values + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + RowPointers = rowPointers + Columns = cols + Values = values } + + let toCSRInplace (clContext: ClContext) workGroupSize = + let prepare = compressRows clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + let rowPointers = + prepare processor allocationMode matrix.Rows matrix.RowCount + + processor.Post(Msg.CreateFreeMsg(matrix.Rows)) + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + RowPointers = rowPointers + Columns = matrix.Columns + Values = matrix.Values } + + let transposeInplace (clContext: ClContext) workGroupSize = + + let sort = + BitonicSort.sortKeyValuesInplace clContext workGroupSize + + fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.COO<'a>) -> + sort queue matrix.Columns matrix.Rows matrix.Values + + { Context = clContext + RowCount = matrix.ColumnCount + ColumnCount = matrix.RowCount + Rows = matrix.Columns + Columns = matrix.Rows + Values = matrix.Values } + + let transpose (clContext: ClContext) workGroupSize = + + let transposeInplace = transposeInplace clContext workGroupSize + + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = copy queue allocationMode matrix.Rows + Columns = copy queue allocationMode matrix.Columns + Values = copyData queue allocationMode matrix.Values } + |> transposeInplace queue diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs similarity index 81% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs index 63de131c..65bc2e42 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs @@ -5,8 +5,12 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix.COO +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClMatrix -module internal Map2 = +module internal Map2AtLeastOne = let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) @@ -276,3 +280,67 @@ module internal Map2 = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) allRows, allColumns, leftMergedValues, rightMergedValues, isEndOfRow, isLeft + + 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 merge = merge clContext workGroupSize + + let preparePositions = + preparePositions clContext opAdd workGroupSize + + let setPositions = + Matrix.Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + + let allRows, allColumns, leftMergedValues, rightMergedValues, isRowEnd, isLeft = + merge + queue + matrixLeft.RowPointers + matrixLeft.Columns + matrixLeft.Values + matrixRight.RowPointers + matrixRight.Columns + matrixRight.Values + + let positions, allValues = + preparePositions queue allColumns leftMergedValues rightMergedValues isRowEnd isLeft + + queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) + queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode allRows allColumns allValues positions + + queue.Post(Msg.CreateFreeMsg<_>(allRows)) + queue.Post(Msg.CreateFreeMsg<_>(isLeft)) + queue.Post(Msg.CreateFreeMsg<_>(isRowEnd)) + queue.Post(Msg.CreateFreeMsg<_>(positions)) + queue.Post(Msg.CreateFreeMsg<_>(allColumns)) + queue.Post(Msg.CreateFreeMsg<_>(allValues)) + + { 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 elementwiseToCOO = runToCOO clContext opAdd workGroupSize + + let toCSRInplace = + Matrix.toCSRInplace clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + elementwiseToCOO queue allocationMode matrixLeft matrixRight + |> toCSRInplace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs similarity index 52% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index 1713d6c1..ff1cabae 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -2,15 +2,14 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Backend.Matrix.CSR.Map2 +open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Quotations -open GraphBLAS.FSharp.Backend.Matrix.COO open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClContext -module CSRMatrix = +module Matrix = let private expandRowPointers (clContext: ClContext) workGroupSize = let expandRowPointers = @@ -90,57 +89,53 @@ module CSRMatrix = Columns = matrix.Columns Values = matrix.Values } - ///Old version - let map2WithCOO (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = + 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 prepareRows = - expandRowPointers clContext workGroupSize + let firstToCOO = toCOO clContext workGroupSize - let map2COO = - COOMatrix.map2 clContext opAdd workGroupSize + let secondToCOO = toCOO clContext workGroupSize - let toCSRInplace = - COOMatrix.toCSRInplace clContext workGroupSize + let COOMap2 = COO.Matrix.map2 clContext opAdd workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (m1: ClMatrix.CSR<'a>) (m2: ClMatrix.CSR<'b>) -> - let m1COO = - { Context = clContext - RowCount = m1.RowCount - ColumnCount = m1.ColumnCount - Rows = prepareRows processor allocationMode m1.RowPointers m1.Values.Length m1.RowCount - Columns = m1.Columns - Values = m1.Values } + let toCSR = COO.Matrix.toCSRInplace clContext workGroupSize - let m2COO = - { Context = clContext - RowCount = m2.RowCount - ColumnCount = m2.ColumnCount - Rows = prepareRows processor allocationMode m2.RowPointers m2.Values.Length m2.RowCount - Columns = m2.Columns - Values = m2.Values } + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let leftCOOMatrix = firstToCOO processor DeviceOnly leftMatrix - let m3COO = - map2COO processor allocationMode m1COO m2COO + let rightCOOMatrix = secondToCOO processor DeviceOnly rightMatrix - processor.Post(Msg.CreateFreeMsg(m1COO.Rows)) - processor.Post(Msg.CreateFreeMsg(m2COO.Rows)) + COOMap2 processor DeviceOnly leftCOOMatrix rightCOOMatrix + |> toCSR processor allocationMode - toCSRInplace processor allocationMode m3COO + let map2AtLeastOneToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + workGroupSize + = - ///Old version - let map2AtLeastOneWithCOO (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = + Map2AtLeastOne.runToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize + + let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + workGroupSize + = - map2WithCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize let transposeInplace (clContext: ClContext) workGroupSize = let toCOOInplace = toCOOInplace clContext workGroupSize let transposeInplace = - COOMatrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInplace clContext workGroupSize let toCSRInplace = - COOMatrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOOInplace queue allocationMode matrix @@ -152,96 +147,16 @@ module CSRMatrix = let toCOO = toCOO clContext workGroupSize let transposeInplace = - COOMatrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInplace clContext workGroupSize let toCSRInplace = - COOMatrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix |> transposeInplace queue |> toCSRInplace queue allocationMode - let map2ToCOO<'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 merge = merge clContext workGroupSize - - let preparePositions = - preparePositions clContext opAdd workGroupSize - - let setPositions = - Matrix.Common.setPositions<'c> clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - - let allRows, allColumns, leftMergedValues, rightMergedValues, isRowEnd, isLeft = - merge - queue - matrixLeft.RowPointers - matrixLeft.Columns - matrixLeft.Values - matrixRight.RowPointers - matrixRight.Columns - matrixRight.Values - - let positions, allValues = - preparePositions queue allColumns leftMergedValues rightMergedValues isRowEnd isLeft - - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) - - let resultRows, resultColumns, resultValues, _ = - setPositions queue allocationMode allRows allColumns allValues positions - - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(isRowEnd)) - queue.Post(Msg.CreateFreeMsg<_>(positions)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) - - { Context = clContext - RowCount = matrixLeft.RowCount - ColumnCount = matrixLeft.ColumnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues } - - 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 elementwiseToCOO = map2ToCOO clContext opAdd workGroupSize - - let toCSRInplace = - COOMatrix.toCSRInplace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - elementwiseToCOO queue allocationMode matrixLeft matrixRight - |> toCSRInplace queue allocationMode - - let map2AtLeastOneToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - workGroupSize - = - - map2ToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize - - let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - workGroupSize - = - - map2 clContext (Convert.atLeastOneToOption opAdd) workGroupSize - let spgemmCSC (clContext: ClContext) workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 65639812..bd7ba337 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -3,8 +3,7 @@ namespace GraphBLAS.FSharp.Backend.Matrix open Brahma.FSharp open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Matrix.COO -open GraphBLAS.FSharp.Backend.Matrix.CSR +open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix @@ -47,26 +46,19 @@ module Matrix = ///OpenCL context. ///Should be a power of 2 and greater than 1. let toCSR (clContext: ClContext) workGroupSize = - let toCSR = COOMatrix.toCSR clContext workGroupSize + let toCSR = COO.Matrix.toCSR clContext workGroupSize let copy = copy clContext workGroupSize let transpose = - CSRMatrix.transpose clContext workGroupSize + CSR.Matrix.transpose clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> toCSR processor allocationMode m |> ClMatrix.CSR | ClMatrix.CSR _ -> copy processor allocationMode matrix | ClMatrix.CSC m -> - - { Context = m.Context - RowCount = m.ColumnCount - ColumnCount = m.RowCount - RowPointers = m.ColumnPointers - Columns = m.Rows - Values = m.Values } - + m.ToCSR |> transpose processor allocationMode |> ClMatrix.CSR @@ -78,10 +70,10 @@ module Matrix = ///Should be a power of 2 and greater than 1. let toCSRInplace (clContext: ClContext) workGroupSize = let toCSRInplace = - COOMatrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInplace clContext workGroupSize let transposeInplace = - CSRMatrix.transposeInplace clContext workGroupSize + CSR.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -90,13 +82,7 @@ module Matrix = |> ClMatrix.CSR | ClMatrix.CSR _ -> matrix | ClMatrix.CSC m -> - { Context = m.Context - RowCount = m.ColumnCount - ColumnCount = m.RowCount - RowPointers = m.ColumnPointers - Columns = m.Rows - Values = m.Values } - + m.ToCSR |> transposeInplace processor allocationMode |> ClMatrix.CSR @@ -106,26 +92,19 @@ module Matrix = ///OpenCL context. ///Should be a power of 2 and greater than 1. let toCOO (clContext: ClContext) workGroupSize = - let toCOO = CSRMatrix.toCOO clContext workGroupSize + let toCOO = CSR.Matrix.toCOO clContext workGroupSize let copy = copy clContext workGroupSize let transposeInplace = - COOMatrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> copy processor allocationMode matrix | ClMatrix.CSR m -> toCOO processor allocationMode m |> ClMatrix.COO | ClMatrix.CSC m -> - - { Context = m.Context - RowCount = m.ColumnCount - ColumnCount = m.RowCount - RowPointers = m.ColumnPointers - Columns = m.Rows - Values = m.Values } - + m.ToCSR |> toCOO processor allocationMode |> transposeInplace processor |> ClMatrix.COO @@ -138,10 +117,10 @@ module Matrix = ///Should be a power of 2 and greater than 1. let toCOOInplace (clContext: ClContext) workGroupSize = let toCOOInplace = - CSRMatrix.toCOOInplace clContext workGroupSize + CSR.Matrix.toCOOInplace clContext workGroupSize let transposeInplace = - COOMatrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -150,14 +129,7 @@ module Matrix = toCOOInplace processor allocationMode m |> ClMatrix.COO | ClMatrix.CSC m -> - - { Context = m.Context - RowCount = m.ColumnCount - ColumnCount = m.RowCount - RowPointers = m.ColumnPointers - Columns = m.Rows - Values = m.Values } - + m.ToCSR |> toCOOInplace processor allocationMode |> transposeInplace processor |> ClMatrix.COO @@ -168,40 +140,26 @@ module Matrix = ///OpenCL context. ///Should be a power of 2 and greater than 1. let toCSC (clContext: ClContext) workGroupSize = - let toCSR = COOMatrix.toCSR clContext workGroupSize + let toCSR = COO.Matrix.toCSR clContext workGroupSize let copy = copy clContext workGroupSize let transposeCSR = - CSRMatrix.transpose clContext workGroupSize + CSR.Matrix.transpose clContext workGroupSize let transposeCOO = - COOMatrix.transpose clContext workGroupSize + COO.Matrix.transpose clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> copy processor allocationMode matrix | ClMatrix.CSR m -> - let csrT = transposeCSR processor allocationMode m - - { Context = csrT.Context - RowCount = csrT.ColumnCount - ColumnCount = csrT.RowCount - Rows = csrT.Columns - ColumnPointers = csrT.RowPointers - Values = csrT.Values } + (transposeCSR processor allocationMode m).ToCSC |> ClMatrix.CSC | ClMatrix.COO m -> - let csrT = - transposeCOO processor allocationMode m - |> toCSR processor allocationMode - - { Context = csrT.Context - RowCount = csrT.ColumnCount - ColumnCount = csrT.RowCount - Rows = csrT.Columns - ColumnPointers = csrT.RowPointers - Values = csrT.Values } + (transposeCOO processor allocationMode m + |> toCSR processor allocationMode) + .ToCSC |> ClMatrix.CSC /// @@ -212,47 +170,33 @@ module Matrix = ///Should be a power of 2 and greater than 1. let toCSCInplace (clContext: ClContext) workGroupSize = let toCSRInplace = - COOMatrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInplace clContext workGroupSize let transposeCSRInplace = - CSRMatrix.transposeInplace clContext workGroupSize + CSR.Matrix.transposeInplace clContext workGroupSize let transposeCOOInplace = - COOMatrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> matrix | ClMatrix.CSR m -> - let csrT = - transposeCSRInplace processor allocationMode m - - { Context = csrT.Context - RowCount = csrT.ColumnCount - ColumnCount = csrT.RowCount - Rows = csrT.Columns - ColumnPointers = csrT.RowPointers - Values = csrT.Values } + (transposeCSRInplace processor allocationMode m) + .ToCSC |> ClMatrix.CSC | ClMatrix.COO m -> - let csrT = - toCSRInplace processor allocationMode - <| transposeCOOInplace processor m - - { Context = csrT.Context - RowCount = csrT.ColumnCount - ColumnCount = csrT.RowCount - Rows = csrT.Columns - ColumnPointers = csrT.RowPointers - Values = csrT.Values } + (transposeCOOInplace processor m + |> toCSRInplace processor allocationMode) + .ToCSC |> ClMatrix.CSC - let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = + let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = // TODO() let map2COO = - COOMatrix.map2 clContext opAdd workGroupSize + COO.Matrix.map2 clContext opAdd workGroupSize let map2CSR = - CSRMatrix.map2 clContext opAdd workGroupSize + CSR.Matrix.map2 clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with @@ -263,24 +207,8 @@ module Matrix = map2CSR processor allocationMode m1 m2 |> ClMatrix.CSR | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - let csrT1 = - { Context = m1.Context - RowCount = m1.ColumnCount - ColumnCount = m1.RowCount - RowPointers = m1.ColumnPointers - Columns = m1.Rows - Values = m1.Values } - - let csrT2 = - { Context = m2.Context - RowCount = m2.ColumnCount - ColumnCount = m2.RowCount - RowPointers = m2.ColumnPointers - Columns = m2.Rows - Values = m2.Values } - let resT = - map2CSR processor allocationMode csrT1 csrT2 + map2CSR processor allocationMode m1.ToCSR m2.ToCSR { Context = resT.Context RowCount = resT.ColumnCount @@ -291,52 +219,12 @@ module Matrix = |> ClMatrix.CSC | _ -> failwith "Matrix formats are not matching" - let map2ToCOO (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = - let COOElementwise = - COOMatrix.map2 clContext opAdd workGroupSize - - let CSRElementwise = - CSRMatrix.map2ToCOO clContext opAdd workGroupSize - - let transposeCOOInplace = - COOMatrix.transposeInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> - match matrix1, matrix2 with - | ClMatrix.COO m1, ClMatrix.COO m2 -> - COOElementwise processor allocationMode m1 m2 - |> ClMatrix.COO - | ClMatrix.CSR m1, ClMatrix.CSR m2 -> - CSRElementwise processor allocationMode m1 m2 - |> ClMatrix.COO - | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - let csrT1 = - { Context = m1.Context - RowCount = m1.ColumnCount - ColumnCount = m1.RowCount - RowPointers = m1.ColumnPointers - Columns = m1.Rows - Values = m1.Values } - - let csrT2 = - { Context = m2.Context - RowCount = m2.ColumnCount - ColumnCount = m2.RowCount - RowPointers = m2.ColumnPointers - Columns = m2.Rows - Values = m2.Values } - - CSRElementwise processor allocationMode csrT1 csrT2 - |> transposeCOOInplace processor - |> ClMatrix.COO - | _ -> failwith "Matrix formats are not matching" - let map2AtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let COOElementwise = - COOMatrix.map2AtLeastOne clContext opAdd workGroupSize + COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize let CSRElementwise = - CSRMatrix.map2AtLeastOne clContext opAdd workGroupSize + CSR.Matrix.map2AtLeastOne clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with @@ -347,43 +235,20 @@ module Matrix = CSRElementwise processor allocationMode m1 m2 |> ClMatrix.CSR | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - let csrT1 = - { Context = m1.Context - RowCount = m1.ColumnCount - ColumnCount = m1.RowCount - RowPointers = m1.ColumnPointers - Columns = m1.Rows - Values = m1.Values } - - let csrT2 = - { Context = m2.Context - RowCount = m2.ColumnCount - ColumnCount = m2.RowCount - RowPointers = m2.ColumnPointers - Columns = m2.Rows - Values = m2.Values } - - let resT = - CSRElementwise processor allocationMode csrT1 csrT2 - - { Context = resT.Context - RowCount = resT.ColumnCount - ColumnCount = resT.RowCount - Rows = resT.Columns - ColumnPointers = resT.RowPointers - Values = resT.Values } + (CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR) + .ToCSC |> ClMatrix.CSC | _ -> failwith "Matrix formats are not matching" let map2AtLeastOneToCOO (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let COOElementwise = - COOMatrix.map2AtLeastOne clContext opAdd workGroupSize + COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize let CSRElementwise = - CSRMatrix.map2AtLeastOneToCOO clContext opAdd workGroupSize + CSR.Matrix.map2AtLeastOneToCOO clContext opAdd workGroupSize let transposeCOOInplace = - COOMatrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with @@ -394,23 +259,7 @@ module Matrix = CSRElementwise processor allocationMode m1 m2 |> ClMatrix.COO | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - let csrT1 = - { Context = m1.Context - RowCount = m1.ColumnCount - ColumnCount = m1.RowCount - RowPointers = m1.ColumnPointers - Columns = m1.Rows - Values = m1.Values } - - let csrT2 = - { Context = m2.Context - RowCount = m2.ColumnCount - ColumnCount = m2.RowCount - RowPointers = m2.ColumnPointers - Columns = m2.Rows - Values = m2.Values } - - CSRElementwise processor allocationMode csrT1 csrT2 + CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR |> transposeCOOInplace processor |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" @@ -430,27 +279,13 @@ module Matrix = ///Should be a power of 2 and greater than 1. let transposeInplace (clContext: ClContext) workGroupSize = let COOtransposeInplace = - COOMatrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) matrix -> match matrix with | ClMatrix.COO m -> COOtransposeInplace processor m |> ClMatrix.COO - | ClMatrix.CSR m -> - { Context = m.Context - RowCount = m.ColumnCount - ColumnCount = m.RowCount - Rows = m.Columns - ColumnPointers = m.RowPointers - Values = m.Values } - |> ClMatrix.CSC - | ClMatrix.CSC m -> - { Context = m.Context - RowCount = m.ColumnCount - ColumnCount = m.RowCount - RowPointers = m.ColumnPointers - Columns = m.Rows - Values = m.Values } - |> ClMatrix.CSR + | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC + | ClMatrix.CSC m -> ClMatrix.CSR m.ToCSR /// /// Transposes the given matrix and returns result as a new matrix. @@ -466,7 +301,7 @@ module Matrix = ///Should be a power of 2 and greater than 1. let transpose (clContext: ClContext) workGroupSize = let COOtranspose = - COOMatrix.transpose clContext workGroupSize + COO.Matrix.transpose clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -502,7 +337,7 @@ module Matrix = = let runCSRnCSC = - CSRMatrix.spgemmCSC clContext workGroupSize opAdd opMul + CSR.Matrix.spgemmCSC clContext workGroupSize opAdd opMul fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> match matrix1, matrix2, mask with diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 6f37eb9d..957c5fe3 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -25,36 +25,52 @@ module ClMatrix = member this.NNZ = this.Values.Length - type COO<'elem when 'elem: struct> = + member this.ToCSC = + { Context = this.Context + RowCount = this.ColumnCount + ColumnCount = this.RowCount + Rows = this.Columns + ColumnPointers = this.RowPointers + Values = this.Values } + + and CSC<'elem when 'elem: struct> = { Context: ClContext RowCount: int ColumnCount: int Rows: ClArray - Columns: ClArray + ColumnPointers: ClArray Values: ClArray<'elem> } interface IDeviceMemObject with member this.Dispose q = q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Columns)) q.Post(Msg.CreateFreeMsg<_>(this.Rows)) + q.Post(Msg.CreateFreeMsg<_>(this.ColumnPointers)) q.PostAndReply(Msg.MsgNotifyMe) member this.NNZ = this.Values.Length - type CSC<'elem when 'elem: struct> = + member this.ToCSR = + { Context = this.Context + RowCount = this.ColumnCount + ColumnCount = this.RowCount + RowPointers = this.ColumnPointers + Columns = this.Rows + Values = this.Values } + + type COO<'elem when 'elem: struct> = { Context: ClContext RowCount: int ColumnCount: int Rows: ClArray - ColumnPointers: ClArray + Columns: ClArray Values: ClArray<'elem> } interface IDeviceMemObject with member this.Dispose q = q.Post(Msg.CreateFreeMsg<_>(this.Values)) + q.Post(Msg.CreateFreeMsg<_>(this.Columns)) q.Post(Msg.CreateFreeMsg<_>(this.Rows)) - q.Post(Msg.CreateFreeMsg<_>(this.ColumnPointers)) q.PostAndReply(Msg.MsgNotifyMe) member this.NNZ = this.Values.Length diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs new file mode 100644 index 00000000..b69f2029 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs @@ -0,0 +1,37 @@ +namespace GraphBLAS.FSharp.Backend.Vector.Sparse + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Control +open GraphBLAS.FSharp.Backend.Predefined +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ClCell + +module internal Common = + let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let sum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let valuesScatter = + Scatter.runInplace clContext workGroupSize + + let indicesScatter = + Scatter.runInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> + + let resultLength = + (sum processor positions).ToHostAndFree(processor) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(allocationMode, resultLength) + + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + valuesScatter processor positions allValues resultValues + + indicesScatter processor positions allIndices resultIndices + + resultValues, resultIndices diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs index d1d2e315..2fab4517 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs @@ -1,10 +1,13 @@ namespace GraphBLAS.FSharp.Backend.Vector.Sparse open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Quotes open FSharp.Quotations +open Microsoft.FSharp.Control +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Objects.ClContext -module Map2 = +module internal Map2 = let binSearch<'a> = <@ fun lenght sourceIndex (indices: ClArray) (values: ClArray<'a>) -> @@ -28,175 +31,197 @@ module Map2 = result @> - let preparePositionsGeneral (op: Expr<'a option -> 'b option -> 'c option>) = - <@ fun (ndRange: Range1D) length leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> + let private preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = - let gid = ndRange.GlobalID0 + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) length leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> - if gid < length then + let gid = ndRange.GlobalID0 - let (leftValue: 'a option) = - (%binSearch) leftValuesLength gid leftIndices leftValues + if gid < length then - let (rightValue: 'b option) = - (%binSearch) rightValuesLength gid rightIndices rightValues + let (leftValue: 'a option) = + (%binSearch) leftValuesLength gid leftIndices leftValues - match (%op) leftValue rightValue with - | Some value -> - resultValues.[gid] <- value - resultIndices.[gid] <- gid + let (rightValue: 'b option) = + (%binSearch) rightValuesLength gid rightIndices rightValues - resultBitmap.[gid] <- 1 - | None -> resultBitmap.[gid] <- 0 @> + match (%op) leftValue rightValue with + | Some value -> + resultValues.[gid] <- value + resultIndices.[gid] <- gid - let prepareAssign op = - <@ fun (ndRange: Range1D) length leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> - let gid = ndRange.GlobalID0 + let kernel = clContext.Compile <| preparePositions opAdd - let value = value.Value + fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) -> - if gid < length then + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - let (leftValue: 'a option) = - (%binSearch) leftValuesLength gid leftIndices leftValues + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - let (rightValue: 'b option) = - (%binSearch) rightValuesLength gid rightIndices rightValues + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vectorLenght) - match (%op) leftValue rightValue value with - | Some value -> - resultValues.[gid] <- value - resultIndices.[gid] <- gid + let ndRange = + Range1D.CreateValid(vectorLenght, workGroupSize) - resultBitmap.[gid] <- 1 - | None -> resultBitmap.[gid] <- 0 @> + let kernel = kernel.GetKernel() - let merge workGroupSize = - <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allIndicesBuffer: ClArray) (firstResultValues: ClArray<'a>) (secondResultValues: ClArray<'b>) (isLeftBitMap: ClArray) -> + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + vectorLenght + leftValues.Length + rightValues.Length + leftValues + leftIndices + rightValues + rightIndices + resultBitmap + resultValues + resultIndices) + ) - let i = ndRange.GlobalID0 + processor.Post(Msg.CreateRunMsg<_, _> kernel) - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 + resultBitmap, resultValues, resultIndices - if localID < 2 then - let x = localID * (workGroupSize - 1) + i - 1 + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = - let diagonalNumber = min (sumOfSides - 1) x + let prepare = + preparePositions<'a, 'b, 'c> clContext workGroupSize op - let mutable leftEdge = diagonalNumber + 1 - secondSide - leftEdge <- max 0 leftEdge + let setPositions = Common.setPositions clContext workGroupSize - let mutable rightEdge = firstSide - 1 + fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> - rightEdge <- min rightEdge diagonalNumber + let bitmap, allValues, allIndices = + prepare + processor + leftVector.Size + leftVector.Values + leftVector.Indices + rightVector.Values + rightVector.Indices - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] + let resultValues, resultIndices = + setPositions processor allocationMode allValues allIndices bitmap - let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] + processor.Post(Msg.CreateFreeMsg<_>(allIndices)) + processor.Post(Msg.CreateFreeMsg<_>(allValues)) + processor.Post(Msg.CreateFreeMsg<_>(bitmap)) - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = max leftVector.Size rightVector.Size } - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge + let private preparePositionsAssignByMask<'a, 'b when 'a: struct and 'b: struct> + (clContext: ClContext) + op + workGroupSize + = - barrierLocal () + let assign op = + <@ fun (ndRange: Range1D) length leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength + let gid = ndRange.GlobalID0 - if endIdx = firstSide then - x <- secondSide - i + localID + beginIdx + let value = value.Value - let secondLocalLength = x + if gid < length then - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize + let (leftValue: 'a option) = + (%binSearch) leftValuesLength gid leftIndices leftValues - if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] + let (rightValue: 'b option) = + (%binSearch) rightValuesLength gid rightIndices rightValues - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] + match (%op) leftValue rightValue value with + | Some value -> + resultValues.[gid] <- value + resultIndices.[gid] <- gid - barrierLocal () + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 + let kernel = clContext.Compile <| assign op - let mutable rightEdge = firstLocalLength - 1 + fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) -> - rightEdge <- min rightEdge localID + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, vectorLenght) - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 + let ndRange = + Range1D.CreateValid(vectorLenght, workGroupSize) - let boundaryX = rightEdge - let boundaryY = localID - leftEdge + let kernel = kernel.GetKernel() - // 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 + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + vectorLenght + leftValues.Length + rightValues.Length + leftValues + leftIndices + rightValues + rightIndices + value + resultBitmap + resultValues + resultIndices) + ) - let mutable fstIdx = 0 + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - if isValidX then - fstIdx <- localIndices.[boundaryX] + resultBitmap, resultValues, resultIndices - let mutable sndIdx = 0 + ///. + ///. + ///Should be a power of 2 and greater than 1. + let assignByMask<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] + let prepare = + preparePositionsAssignByMask clContext op workGroupSize - if not isValidX || isValidY && fstIdx <= sndIdx then - allIndicesBuffer.[i] <- sndIdx - secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - isLeftBitMap.[i] <- 0 - else - allIndicesBuffer.[i] <- fstIdx - firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - isLeftBitMap.[i] <- 1 @> + let setPositions = Common.setPositions clContext workGroupSize - let preparePositions opAdd = - <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> + fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: ClCell<'a>) -> - let gid = ndRange.GlobalID0 + let bitmap, values, indices = + prepare + processor + leftVector.Size + leftVector.Values + leftVector.Indices + rightVector.Values + rightVector.Indices + value - if gid < length - 1 - && allIndices.[gid] = allIndices.[gid + 1] then - let result = - (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) + let resultValues, resultIndices = + setPositions processor allocationMode values indices bitmap - (%PreparePositions.both) gid result positions allValues - elif (gid < length - && gid > 0 - && allIndices.[gid - 1] <> allIndices.[gid]) - || gid = 0 then - let leftResult = (%opAdd) (Some leftValues.[gid]) None - let rightResult = (%opAdd) None (Some rightValues.[gid]) + processor.Post(Msg.CreateFreeMsg<_>(indices)) + processor.Post(Msg.CreateFreeMsg<_>(values)) + processor.Post(Msg.CreateFreeMsg<_>(bitmap)) - (%PreparePositions.leftRight) gid leftResult rightResult isLeft allValues positions @> + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = rightVector.Size } diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs new file mode 100644 index 00000000..a65e70b5 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs @@ -0,0 +1,261 @@ +namespace GraphBLAS.FSharp.Backend.Vector.Sparse + +open Brahma.FSharp +open Microsoft.FSharp.Control +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Quotes + +module internal Map2AtLeastOne = + let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = + + let merge = + <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allIndicesBuffer: ClArray) (firstResultValues: ClArray<'a>) (secondResultValues: ClArray<'b>) (isLeftBitMap: ClArray) -> + + let i = ndRange.GlobalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 + + if localID < 2 then + let x = localID * (workGroupSize - 1) + i - 1 + + let diagonalNumber = min (sumOfSides - 1) x + + let mutable leftEdge = diagonalNumber + 1 - secondSide + leftEdge <- max 0 leftEdge + + let mutable rightEdge = firstSide - 1 + + rightEdge <- min 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 + + barrierLocal () + + 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] + + barrierLocal () + + if i < sumOfSides then + let mutable leftEdge = localID + 1 - secondLocalLength + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstLocalLength - 1 + + rightEdge <- min 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 + secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + isLeftBitMap.[i] <- 0 + else + allIndicesBuffer.[i] <- fstIdx + firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitMap.[i] <- 1 @> + + let kernel = clContext.Compile merge + + fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (secondValues: ClArray<'b>) -> + + let firstSide = firstIndices.Length + + let secondSide = secondIndices.Length + + let sumOfSides = + firstIndices.Length + secondIndices.Length + + let allIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let firstResultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) + + let secondResultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) + + let isLeftBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let ndRange = + Range1D.CreateValid(sumOfSides, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + firstIndices + firstValues + secondIndices + secondValues + allIndices + firstResultValues + secondResultValues + isLeftBitmap) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allIndices, firstResultValues, secondResultValues, isLeftBitmap + + let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + op + workGroupSize + = + + let preparePositions opAdd = + <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < length - 1 + && allIndices.[gid] = allIndices.[gid + 1] then + let result = + (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) + + (%PreparePositions.both) gid result positions allValues + elif (gid < length + && gid > 0 + && allIndices.[gid - 1] <> allIndices.[gid]) + || gid = 0 then + let leftResult = (%opAdd) (Some leftValues.[gid]) None + let rightResult = (%opAdd) None (Some rightValues.[gid]) + + (%PreparePositions.leftRight) gid leftResult rightResult isLeft allValues positions @> + + let kernel = + clContext.Compile <| preparePositions op + + fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + + let length = allIndices.Length + + let allValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) + + let positions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allValues, positions + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = + + let merge = merge clContext workGroupSize + + let prepare = + preparePositions<'a, 'b, 'c> clContext op workGroupSize + + let setPositions = Common.setPositions clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> + + let allIndices, leftValues, rightValues, isLeft = + merge processor leftVector.Indices leftVector.Values rightVector.Indices rightVector.Values + + let allValues, positions = + prepare processor allIndices leftValues rightValues isLeft + + processor.Post(Msg.CreateFreeMsg<_>(leftValues)) + processor.Post(Msg.CreateFreeMsg<_>(rightValues)) + processor.Post(Msg.CreateFreeMsg<_>(isLeft)) + + let resultValues, resultIndices = + setPositions processor allocationMode allValues allIndices positions + + processor.Post(Msg.CreateFreeMsg<_>(allIndices)) + processor.Post(Msg.CreateFreeMsg<_>(allValues)) + processor.Post(Msg.CreateFreeMsg<_>(positions)) + + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = max leftVector.Size rightVector.Size } + diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index bb3bdbf4..2e597e1f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -5,321 +5,16 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations -open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClVector -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Backend.Objects.ClCell module SparseVector = - - let private setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = - - let sum = - PrefixSum.standardExcludeInplace clContext workGroupSize - - let valuesScatter = - Scatter.runInplace clContext workGroupSize - - let indicesScatter = - Scatter.runInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> - - let resultLength = - (sum processor positions).ToHostAndFree(processor) - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'a>(allocationMode, resultLength) - - let resultIndices = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - - valuesScatter processor positions allValues resultValues - - indicesScatter processor positions allIndices resultIndices - - resultValues, resultIndices - - - let preparePositionsGeneral<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = - - let kernel = - clContext.Compile - <| Map2.preparePositionsGeneral opAdd - - fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) -> - - let resultBitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - - let resultIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vectorLenght) - - let ndRange = - Range1D.CreateValid(vectorLenght, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues.Length - rightValues.Length - leftValues - leftIndices - rightValues - rightIndices - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - resultBitmap, resultValues, resultIndices - - let map2General<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = - - let prepare = - preparePositionsGeneral<'a, 'b, 'c> clContext workGroupSize op - - let setPositions = setPositions clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> - - let bitmap, allValues, allIndices = - prepare - processor - leftVector.Size - leftVector.Values - leftVector.Indices - rightVector.Values - rightVector.Indices - - let resultValues, resultIndices = - setPositions processor allocationMode allValues allIndices bitmap - - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) - processor.Post(Msg.CreateFreeMsg<_>(allValues)) - processor.Post(Msg.CreateFreeMsg<_>(bitmap)) - - { Context = clContext - Values = resultValues - Indices = resultIndices - Size = max leftVector.Size rightVector.Size } - - let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = - - let kernel = - clContext.Compile(Map2.merge workGroupSize) - - fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (secondValues: ClArray<'b>) -> - - let firstSide = firstIndices.Length - - let secondSide = secondIndices.Length - - let sumOfSides = - firstIndices.Length + secondIndices.Length - - let allIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let firstResultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) - - let secondResultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) - - let isLeftBitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let ndRange = - Range1D.CreateValid(sumOfSides, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - firstIndices - firstValues - secondIndices - secondValues - allIndices - firstResultValues - secondResultValues - isLeftBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - allIndices, firstResultValues, secondResultValues, isLeftBitmap - - let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) - op - workGroupSize - = - - let kernel = - clContext.Compile(Map2.preparePositions op) - - fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> - - let length = allIndices.Length - - let allValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) - - let positions = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - let ndRange = - Range1D.CreateValid(length, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - allValues, positions - - ///. - ///. - ///Should be a power of 2 and greater than 1. - let map2<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = - - let merge = merge clContext workGroupSize - - let prepare = - preparePositions<'a, 'b, 'c> clContext op workGroupSize - - let setPositions = setPositions clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> - - let allIndices, leftValues, rightValues, isLeft = - merge processor leftVector.Indices leftVector.Values rightVector.Indices rightVector.Values - - let allValues, positions = - prepare processor allIndices leftValues rightValues isLeft - - processor.Post(Msg.CreateFreeMsg<_>(leftValues)) - processor.Post(Msg.CreateFreeMsg<_>(rightValues)) - processor.Post(Msg.CreateFreeMsg<_>(isLeft)) - - let resultValues, resultIndices = - setPositions processor allocationMode allValues allIndices positions - - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) - processor.Post(Msg.CreateFreeMsg<_>(allValues)) - processor.Post(Msg.CreateFreeMsg<_>(positions)) - - { Context = clContext - Values = resultValues - Indices = resultIndices - Size = max leftVector.Size rightVector.Size } + let map2 = Map2.run let map2AtLeastOne (clContext: ClContext) opAdd workGroupSize allocationMode = - map2 clContext (Convert.atLeastOneToOption opAdd) workGroupSize allocationMode - - let private preparePositionsAssignByMask<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) - op - workGroupSize - = - - let kernel = clContext.Compile(Map2.prepareAssign op) - - fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) -> - - let resultBitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - - let resultIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, vectorLenght) - - let ndRange = - Range1D.CreateValid(vectorLenght, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues.Length - rightValues.Length - leftValues - leftIndices - rightValues - rightIndices - value - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - resultBitmap, resultValues, resultIndices - - ///. - ///. - ///Should be a power of 2 and greater than 1. - let assignByMask<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = - - let prepare = - preparePositionsAssignByMask clContext op workGroupSize - - let setPositions = setPositions clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: ClCell<'a>) -> - - let bitmap, values, indices = - prepare - processor - leftVector.Size - leftVector.Values - leftVector.Indices - rightVector.Values - rightVector.Indices - value - - let resultValues, resultIndices = - setPositions processor allocationMode values indices bitmap - - processor.Post(Msg.CreateFreeMsg<_>(indices)) - processor.Post(Msg.CreateFreeMsg<_>(values)) - processor.Post(Msg.CreateFreeMsg<_>(bitmap)) + Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize allocationMode - { Context = clContext - Values = resultValues - Indices = resultIndices - Size = rightVector.Size } + let assignByMask = Map2.assignByMask let toDense (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 70e4c821..0746d515 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -27,7 +27,7 @@ module Vector = clContext.CreateClArrayWithSpecificAllocationMode( allocationMode, [| Unchecked.defaultof<'a> |] - ) + ) // TODO empty vector Size = size } | Dense -> ClVector.Dense @@ -128,59 +128,37 @@ module Vector = <| toDense processor allocationMode vector let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = - let addDense = + let map2Dense = DenseVector.map2 clContext opAdd workGroupSize - let addSparse = + let map2Sparse = SparseVector.map2 clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Dense left, ClVector.Dense right -> ClVector.Dense - <| addDense processor allocationMode left right + <| map2Dense processor allocationMode left right | ClVector.Sparse left, ClVector.Sparse right -> ClVector.Sparse - <| addSparse processor allocationMode left right + <| map2Sparse processor allocationMode left right | _ -> failwith "Vector formats are not matching." let map2AtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = - let addSparse = + let map2Sparse = SparseVector.map2AtLeastOne clContext opAdd workGroupSize - let addDense = + let map2Dense = DenseVector.map2AtLeastOne clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Sparse left, ClVector.Sparse right -> ClVector.Sparse - <| addSparse processor allocationMode left right + <| map2Sparse processor allocationMode left right | ClVector.Dense left, ClVector.Dense right -> ClVector.Dense - <| addDense processor allocationMode left right - | _ -> failwith "Vector formats are not matching." - - let map2General<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupsSize - = - - let sparseEWise = - SparseVector.map2General clContext opAdd workGroupsSize - - let denseEWise = - DenseVector.map2 clContext opAdd workGroupsSize - - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> - match leftVector, rightVector with - | ClVector.Sparse left, ClVector.Sparse right -> - ClVector.Sparse - <| sparseEWise processor allocationMode left right - | ClVector.Dense left, ClVector.Dense right -> - ClVector.Dense - <| denseEWise processor allocationMode left right + <| map2Dense processor allocationMode left right | _ -> failwith "Vector formats are not matching." let private assignByMaskGeneral<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = @@ -191,32 +169,15 @@ module Vector = let denseFillVector = DenseVector.assignByMask clContext op workGroupSize - let toSparseVector = - DenseVector.toSparse clContext workGroupSize - - let toSparseMask = - DenseVector.toSparse clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: ClCell<'a>) -> match vector, mask with | ClVector.Sparse vector, ClVector.Sparse mask -> - ClVector.Sparse - <| sparseFillVector processor allocationMode vector mask value - | ClVector.Sparse vector, ClVector.Dense mask -> - let mask = - toSparseMask processor allocationMode mask - - ClVector.Sparse - <| sparseFillVector processor allocationMode vector mask value - | ClVector.Dense vector, ClVector.Sparse mask -> - let vector = - toSparseVector processor allocationMode vector - ClVector.Sparse <| sparseFillVector processor allocationMode vector mask value | ClVector.Dense vector, ClVector.Dense mask -> ClVector.Dense <| denseFillVector processor allocationMode vector mask value + | _ -> failwith "Vector formats are not matching." let assignByMask<'a, 'b when 'a: struct and 'b: struct> clContext op workGroupSize = assignByMaskGeneral<'a, 'b> clContext (Convert.assignToOption op) workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index bfbe4450..de3b71e6 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -99,6 +99,17 @@ module Utils = Actual value is %A{actual.[i]}, expected %A{expected.[i]}" |> failtestf "%s" + let compare2DArrays areEqual (actual: 'a [,]) (expected: 'a [,]) message = + $"%s{message}. Lengths should be equal. Actual is %A{actual}, expected %A{expected}" + |> Expect.equal actual.Length expected.Length + + for i in 0 .. Array2D.length1 actual - 1 do + for j in 0 .. Array2D.length2 actual - 1 do + if not (areEqual actual.[i, j] expected.[i, j]) then + $"%s{message}. Arrays differ at position [%d{i}, %d{j}] of [%A{Array2D.length1 actual}, %A{Array2D.length2 actual}]. + Actual value is %A{actual.[i, j]}, expected %A{expected.[i, j]}" + |> failtestf "%s" + let listOfUnionCases<'a> = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index 3c3db762..eeb1546f 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -46,11 +46,8 @@ let checkResult isEqual op zero (baseMtx1: 'a [,]) (baseMtx2: 'a [,]) (actual: M actual2D.[actual.Rows.[i], actual.Columns.[i]] <- actual.Values.[i] | _ -> failwith "Resulting matrix should be converted to COO format." - for i in 0 .. rows - 1 do - for j in 0 .. columns - 1 do - Expect.isTrue - (isEqual actual2D.[i, j] expected2D.[i, j]) - $"Values should be the same. Actual is {actual2D.[i, j]}, expected {expected2D.[i, j]}." + "Arrays must be the same" + |> Utils.compare2DArrays isEqual actual2D expected2D let correctnessGenericTest zero diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 719aad6f..f5b7af4f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,73 +1,68 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Mxm.tests - Matrix.Transpose.tests ] - |> testSequenced - -let commonTests = - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.PrefixSum.tests - Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests ] +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Mxm.tests +// Matrix.Transpose.tests ] +// |> testSequenced +// +// let commonTests = +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.PrefixSum.tests +// Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.tests ] +// +// testList +// "Common tests" +// [ clArrayTests +// Common.BitonicSort.tests +// Common.Scatter.tests +// Common.Reduce.tests +// Common.Sum.tests ] +// |> testSequenced - testList - "Common tests" - [ clArrayTests - Common.BitonicSort.tests - Common.Scatter.tests - Common.Reduce.tests - Common.Sum.tests ] - |> testSequenced +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.addGeneralTests - Vector.Map2.mulGeneralTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced [] let allTests = testList "All tests" - [ commonTests - matrixTests - vectorTests - algorithmsTests ] + [ Matrix.Map2.addTests ] |> testSequenced [] diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index f5327daf..33f4a693 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -158,33 +158,6 @@ let mulAtLeastOneTestFixtures case = let mulAtLeastOneTests = operationGPUTests "Backend.Vector.Map2AtLeasOne mul tests" mulTestFixtures -let addGeneralTestFixtures (case: OperationCase) = - let context = case.TestContext.ClContext - - [ createTest case (=) 0 (+) ArithmeticOperations.intSum Vector.map2General - - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSum Vector.map2General - - createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32Sum Vector.map2General - createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2General - createTest case (=) 0uy (+) ArithmeticOperations.byteSum Vector.map2General ] - -let addGeneralTests = - operationGPUTests "Backend.Vector.Map2Gen add tests" addGeneralTestFixtures - -let mulGeneralTestFixtures case = - let context = case.TestContext.ClContext - - [ createTest case (=) 0 (*) ArithmeticOperations.intMul Vector.map2General - - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMul Vector.map2General - - createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32Mul Vector.map2General - createTest case (=) false (&&) ArithmeticOperations.boolMul Vector.map2General - createTest case (=) 0uy (*) ArithmeticOperations.byteMul Vector.map2General ] - let fillSubVectorComplementedQ<'a, 'b> value = <@ fun (left: 'a option) (right: 'b option) -> match left with @@ -198,13 +171,10 @@ let fillSubVectorFun value zero isEqual = else right -let mulGeneralTests = - operationGPUTests "Backend.Vector.SparseVector.map2Gen mul tests" mulGeneralTestFixtures - let complementedGeneralTestFixtures case = let context = case.TestContext.ClContext - [ createTest case (=) 0 (fillSubVectorFun 1 0 (=)) (fillSubVectorComplementedQ 1) Vector.map2General + [ createTest case (=) 0 (fillSubVectorFun 1 0 (=)) (fillSubVectorComplementedQ 1) Vector.map2 if Utils.isFloat64Available context.ClDevice then createTest @@ -213,7 +183,7 @@ let complementedGeneralTestFixtures case = 0.0 (fillSubVectorFun 1.0 0.0 Utils.floatIsEqual) (fillSubVectorComplementedQ 1.0) - Vector.map2General + Vector.map2 createTest case @@ -221,11 +191,11 @@ let complementedGeneralTestFixtures case = 0.0f (fillSubVectorFun 1.0f 0.0f Utils.float32IsEqual) (fillSubVectorComplementedQ 1.0f) - Vector.map2General + Vector.map2 - createTest case (=) false (fillSubVectorFun true false (=)) (fillSubVectorComplementedQ true) Vector.map2General + createTest case (=) false (fillSubVectorFun true false (=)) (fillSubVectorComplementedQ true) Vector.map2 - createTest case (=) 0uy (fillSubVectorFun 1uy 0uy (=)) (fillSubVectorComplementedQ 1uy) Vector.map2General ] + createTest case (=) 0uy (fillSubVectorFun 1uy 0uy (=)) (fillSubVectorComplementedQ 1uy) Vector.map2 ] let complementedGeneralTests = From 39e8c0ea39badb8bb9d1c825d6d77180a369eeee Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 7 Mar 2023 12:49:43 +0300 Subject: [PATCH 003/143] add: Matrix.map2 --- .../GraphBLAS-sharp.Backend.fsproj | 14 +-- .../Matrix/COOMatrix/Map2.fs | 7 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 10 +- tests/GraphBLAS-sharp.Tests/Program.fs | 113 +++++++++--------- 4 files changed, 70 insertions(+), 74 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index b24ea69c..affc7f5a 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,16 +35,16 @@ - - - - + + + + - + - + - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs index d4376a1d..a08b6c87 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -38,7 +38,7 @@ 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 length (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> + <@ fun (ndRange: Range1D) rowCount columnCount leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> let gid = ndRange.GlobalID0 @@ -50,10 +50,10 @@ module internal Map2 = let index = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) let leftValue = - (%binSearch) length index leftRows leftColumns leftValues + (%binSearch) leftValuesLength index leftRows leftColumns leftValues let rightValue = - (%binSearch) length index rightRows rightColumn rightValues + (%binSearch) rightValuesLength index rightRows rightColumn rightValues match (%op) leftValue rightValue with | Some value -> @@ -95,6 +95,7 @@ module internal Map2 = rowCount columnCount leftValues.Length + rightValues.Length leftValues leftRows leftColumns diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index bd7ba337..12bc8c66 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -207,15 +207,7 @@ module Matrix = map2CSR processor allocationMode m1 m2 |> ClMatrix.CSR | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - let resT = - map2CSR processor allocationMode m1.ToCSR m2.ToCSR - - { Context = resT.Context - RowCount = resT.ColumnCount - ColumnCount = resT.RowCount - Rows = resT.Columns - ColumnPointers = resT.RowPointers - Values = resT.Values } + (map2CSR processor allocationMode m1.ToCSR m2.ToCSR).ToCSC |> ClMatrix.CSC | _ -> failwith "Matrix formats are not matching" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f5b7af4f..2514a8ff 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,68 +1,71 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Mxm.tests -// Matrix.Transpose.tests ] -// |> testSequenced -// -// let commonTests = -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.PrefixSum.tests -// Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.tests ] -// -// testList -// "Common tests" -// [ clArrayTests -// Common.BitonicSort.tests -// Common.Scatter.tests -// Common.Reduce.tests -// Common.Sum.tests ] -// |> testSequenced +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Mxm.tests + Matrix.Transpose.tests ] + |> testSequenced + +let commonTests = + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.PrefixSum.tests + Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.tests ] -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced + testList + "Common tests" + [ clArrayTests + Common.BitonicSort.tests + Common.Scatter.tests + Common.Reduce.tests + Common.Sum.tests ] + |> testSequenced -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced [] let allTests = testList "All tests" - [ Matrix.Map2.addTests ] + [ matrixTests + commonTests + vectorTests + algorithmsTests ] |> testSequenced [] From fe2edc30ced43d816b86c1f6122dceba9c1da83d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 7 Mar 2023 12:54:51 +0300 Subject: [PATCH 004/143] refactor: formattig --- .../Matrix/COOMatrix/Map2.fs | 100 ++++++++++-------- .../Matrix/COOMatrix/Map2AtLeastOne.fs | 6 +- .../Matrix/CSRMatrix/Matrix.fs | 17 +-- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 3 +- .../Vector/SparseVector/Map2.fs | 99 ++++++++--------- .../Vector/SparseVector/Map2AtLeastOne.fs | 7 +- 6 files changed, 127 insertions(+), 105 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs index a08b6c87..d3d2e0d1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -40,32 +40,33 @@ module internal Map2 = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = <@ fun (ndRange: Range1D) rowCount columnCount leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < rowCount * columnCount then + if gid < rowCount * columnCount then - let columnIndex = gid % columnCount - let rowIndex = gid / columnCount + let columnIndex = gid % columnCount + let rowIndex = gid / columnCount - let index = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) + let index = + (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) - let leftValue = - (%binSearch) leftValuesLength index leftRows leftColumns leftValues + let leftValue = + (%binSearch) leftValuesLength index leftRows leftColumns leftValues - let rightValue = - (%binSearch) rightValuesLength index rightRows rightColumn rightValues + let rightValue = + (%binSearch) rightValuesLength index rightRows rightColumn rightValues - match (%op) leftValue rightValue with - | Some value -> - resultValues.[gid] <- value - resultRows.[gid] <- rowIndex - resultColumns.[gid] <- columnIndex + match (%op) leftValue rightValue with + | Some value -> + resultValues.[gid] <- value + resultRows.[gid] <- rowIndex + resultColumns.[gid] <- columnIndex - resultBitmap.[gid] <- 1 - | None -> - resultBitmap.[gid] <- 0 @> + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> - let kernel = clContext.Compile <| preparePositions opAdd + 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) -> @@ -83,51 +84,64 @@ module internal Map2 = let resultValues = clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, resultLength) - let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - leftValues.Length - rightValues.Length - leftValues - leftRows - leftColumns - rightValues - rightRows - rightColumns - resultBitmap - resultValues - resultRows - resultColumns)) + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + rowCount + columnCount + leftValues.Length + rightValues.Length + leftValues + leftRows + leftColumns + rightValues + rightRows + rightColumns + resultBitmap + resultValues + resultRows + resultColumns) + ) processor.Post(Msg.CreateRunMsg<_, _> kernel) resultBitmap, resultValues, resultRows, resultColumns - ///. - ///. - ///Should be a power of 2 and greater than 1. + ///. + ///. + ///Should be a power of 2 and greater than 1. let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = - let map2 = preparePositions clContext workGroupSize opAdd + let map2 = + preparePositions clContext workGroupSize opAdd - let setPositions = Common.setPositions<'c> clContext workGroupSize + let setPositions = + Common.setPositions<'c> clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> let bitmap, values, rows, columns = - map2 queue matrixLeft.RowCount matrixLeft.ColumnCount matrixLeft.Values matrixLeft.Rows matrixLeft.Columns matrixRight.Values matrixRight.Rows matrixRight.Columns + map2 + queue + matrixLeft.RowCount + matrixLeft.ColumnCount + matrixLeft.Values + matrixLeft.Rows + matrixLeft.Columns + matrixRight.Values + matrixRight.Rows + matrixRight.Columns let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs index 2acff06f..0c776f10 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs @@ -260,9 +260,9 @@ module internal Map2AtLeastOne = allRows, allColumns, leftMergedValues, rightMergedValues, isLeft - ///. - ///. - ///Should be a power of 2 and greater than 1. + ///. + ///. + ///Should be a power of 2 and greater than 1. let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index ff1cabae..c639135b 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -25,7 +25,8 @@ module Matrix = let program = clContext.Compile(expandRowPointers) - let create = ClArray.zeroCreate clContext workGroupSize + let create = + ClArray.zeroCreate clContext workGroupSize let scan = ClArray.prefixSumIncludeInplace <@ max @> clContext workGroupSize @@ -99,14 +100,18 @@ module Matrix = let secondToCOO = toCOO clContext workGroupSize - let COOMap2 = COO.Matrix.map2 clContext opAdd workGroupSize + let COOMap2 = + COO.Matrix.map2 clContext opAdd workGroupSize - let toCSR = COO.Matrix.toCSRInplace clContext 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 leftCOOMatrix = + firstToCOO processor DeviceOnly leftMatrix - let rightCOOMatrix = secondToCOO processor DeviceOnly rightMatrix + let rightCOOMatrix = + secondToCOO processor DeviceOnly rightMatrix COOMap2 processor DeviceOnly leftCOOMatrix rightCOOMatrix |> toCSR processor allocationMode @@ -117,7 +122,7 @@ module Matrix = workGroupSize = - Map2AtLeastOne.runToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2AtLeastOne.runToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 12bc8c66..5adc3cd1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -207,7 +207,8 @@ module Matrix = map2CSR processor allocationMode m1 m2 |> ClMatrix.CSR | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - (map2CSR processor allocationMode m1.ToCSR m2.ToCSR).ToCSC + (map2CSR processor allocationMode m1.ToCSR m2.ToCSR) + .ToCSC |> ClMatrix.CSC | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs index 2fab4517..8e5eb381 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs @@ -54,74 +54,76 @@ module internal Map2 = resultBitmap.[gid] <- 1 | None -> resultBitmap.[gid] <- 0 @> - let kernel = clContext.Compile <| preparePositions opAdd + let kernel = + clContext.Compile <| preparePositions opAdd fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) -> - let resultBitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - let resultIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vectorLenght) + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vectorLenght) - let ndRange = - Range1D.CreateValid(vectorLenght, workGroupSize) + let ndRange = + Range1D.CreateValid(vectorLenght, workGroupSize) - let kernel = kernel.GetKernel() + let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues.Length - rightValues.Length - leftValues - leftIndices - rightValues - rightIndices - resultBitmap - resultValues - resultIndices) - ) + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + vectorLenght + leftValues.Length + rightValues.Length + leftValues + leftIndices + rightValues + rightIndices + resultBitmap + resultValues + resultIndices) + ) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.Post(Msg.CreateRunMsg<_, _> kernel) - resultBitmap, resultValues, resultIndices + resultBitmap, resultValues, resultIndices let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = let prepare = - preparePositions<'a, 'b, 'c> clContext workGroupSize op + preparePositions<'a, 'b, 'c> clContext workGroupSize op - let setPositions = Common.setPositions clContext workGroupSize + let setPositions = + Common.setPositions clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> - let bitmap, allValues, allIndices = - prepare - processor - leftVector.Size - leftVector.Values - leftVector.Indices - rightVector.Values - rightVector.Indices + let bitmap, allValues, allIndices = + prepare + processor + leftVector.Size + leftVector.Values + leftVector.Indices + rightVector.Values + rightVector.Indices - let resultValues, resultIndices = - setPositions processor allocationMode allValues allIndices bitmap + let resultValues, resultIndices = + setPositions processor allocationMode allValues allIndices bitmap - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) - processor.Post(Msg.CreateFreeMsg<_>(allValues)) - processor.Post(Msg.CreateFreeMsg<_>(bitmap)) + processor.Post(Msg.CreateFreeMsg<_>(allIndices)) + processor.Post(Msg.CreateFreeMsg<_>(allValues)) + processor.Post(Msg.CreateFreeMsg<_>(bitmap)) - { Context = clContext - Values = resultValues - Indices = resultIndices - Size = max leftVector.Size rightVector.Size } + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = max leftVector.Size rightVector.Size } let private preparePositionsAssignByMask<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) @@ -200,7 +202,8 @@ module internal Map2 = let prepare = preparePositionsAssignByMask clContext op workGroupSize - let setPositions = Common.setPositions clContext workGroupSize + let setPositions = + Common.setPositions clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: ClCell<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs index a65e70b5..8c346b87 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs @@ -195,8 +195,7 @@ module internal Map2AtLeastOne = (%PreparePositions.leftRight) gid leftResult rightResult isLeft allValues positions @> - let kernel = - clContext.Compile <| preparePositions op + let kernel = clContext.Compile <| preparePositions op fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> @@ -233,7 +232,8 @@ module internal Map2AtLeastOne = let prepare = preparePositions<'a, 'b, 'c> clContext op workGroupSize - let setPositions = Common.setPositions clContext workGroupSize + let setPositions = + Common.setPositions clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> @@ -258,4 +258,3 @@ module internal Map2AtLeastOne = Values = resultValues Indices = resultIndices Size = max leftVector.Size rightVector.Size } - From d55d34f7b6b5685a84245b48d1cc648560520e97 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 12 Mar 2023 16:15:05 +0300 Subject: [PATCH 005/143] add: Gather --- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 41 +++++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 1 + 2 files changed, 42 insertions(+) create mode 100644 src/GraphBLAS-sharp.Backend/Common/Gather.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs new file mode 100644 index 00000000..3d70bd3c --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -0,0 +1,41 @@ +namespace GraphBLAS.FSharp.Backend.Common.Gather + +open Brahma.FSharp + +module internal Gather = + /// + /// Creates a new array obtained from positions replaced with values from the given array at these positions (indices). + /// + /// + /// + /// let positions = [| 2; 0; 2; 1 |] + /// let array = [| 1.4; 2.5; 3.6 |] + /// ... + /// > val result = [| 3.6; 1.4; 3.6; 2.5 |] + /// + /// + let run (clContext: ClContext) workGroupSize = + + let gather = + <@ fun (ndRange: Range1D) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> + + let i = ndRange.GlobalID0 + + if i < size then + outputArray.[i] <- inputArray.[positions.[i]] @> + + let program = clContext.Compile(gather) + + fun (processor: MailboxProcessor<_>) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) -> + + let size = outputArray.Length + + let kernel = program.GetKernel() + + let ndRange = Range1D.CreateValid(size, workGroupSize) + + processor.Post( + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions inputArray outputArray size) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 35d7e632..9d6cd576 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -32,6 +32,7 @@ + From a136bd3f8ffadc73b71427d627fa7de602f196b3 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 09:54:42 +0300 Subject: [PATCH 006/143] add: Expand module --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 26 +- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 2 +- .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 260 ++++++++++++++++++ src/GraphBLAS-sharp.Backend/Objects/ClCell.fs | 3 + 5 files changed, 290 insertions(+), 2 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 23dbb71a..93dca1c0 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -33,6 +33,30 @@ module ClArray = outputArray + let assignManyInit (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = + + let init = + <@ fun (range: Range1D) indicesLength (indices: ClArray) (outputBuffer: ClArray<'a>) -> + + let gid = range.GlobalID0 + + if gid < indicesLength then + let targetIndex = indices.[gid] + + outputBuffer.[targetIndex] <- (%initializer) gid @> + + let program = clContext.Compile(init) + + fun (processor: MailboxProcessor<_>) (indices: ClArray) (result: ClArray<'a>) -> + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(indices.Length, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange indices.Length indices result)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) + let create (clContext: ClContext) workGroupSize = let create = @@ -62,7 +86,7 @@ module ClArray = outputArray - let zeroCreate (clContext: ClContext) workGroupSize = + let zeroCreate<'a> (clContext: ClContext) workGroupSize = let create = create clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 3d70bd3c..9898acee 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Common.Gather +namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 9d6cd576..e7c11824 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -40,6 +40,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs new file mode 100644 index 00000000..121a8ec0 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -0,0 +1,260 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.CSRMatrix.SpGEMM + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Predefined +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClCell + +type Indices = ClArray + +type Values<'a> = ClArray<'a> + +module Expand = + /// + /// Get the number of non-zero elements for each row of the right matrix for non-zero item in left matrix. + /// + let requiredRawsLengths = + <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> + let columnIndex = leftMatrixColumnsIndices.[gid] + let startRawIndex = rightMatrixRawPointers.[columnIndex] + let exclusiveRawEndIndex = rightMatrixRawPointers.[columnIndex + 1] + + exclusiveRawEndIndex - startRawIndex @> + + /// + /// Get the pointer to right matrix raw for each non-zero in left matrix. + /// + let requiredRawPointers = + <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> + let columnIndex = leftMatrixColumnsIndices.[gid] + let startRawIndex = rightMatrixRawPointers.[columnIndex] + + startRawIndex @> + + let processLeftMatrixColumnsAndRightMatrixRawPointers (clContext: ClContext) workGroupSize writeOperation = + + let kernel = + <@ fun (ndRange: Range1D) columnsLength (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < columnsLength then + result.[gid] <- (%writeOperation) gid leftMatrixColumnsIndices rightMatrixRawPointers @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> + let resultLength = leftMatrixColumnsIndices.Length + + let requiredRawsLengths = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + leftMatrixColumnsIndices + rightMatrixRawPointers + requiredRawsLengths) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + requiredRawsLengths + + let getGlobalPositions (clContext: ClContext) workGroupSize = + + let zeroCreate = ClArray.zeroCreate clContext workGroupSize + + let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> + + let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> + + /// We get an array of zeros + let globalPositions = zeroCreate processor DeviceOnly resultLength + + // Insert units at the beginning of new lines (source positions) + assignUnits processor globalRightMatrixValuesPositions globalPositions + + // Apply the prefix sum, + // get an array where different sub-arrays of pointers to elements of the same row differ in values + (prefixSum processor globalPositions).Free processor + + globalPositions + + let getRightMatrixPointers (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + // index corresponding to the position of pointers + let positionIndex = globalPositions.[gid] - 1 + + // the position of the beginning of a new line of pointers + let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] + + // offset from the source pointer + let offsetFromSourcePosition = gid - sourcePosition + + // pointer to the first element in the row of the right matrix from which + // the offset will be counted to get pointers to subsequent elements in this row + let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] + + // adding up the mix with the source pointer, + // we get a pointer to a specific element in the raw + result.[gid] <- sourcePointer + offsetFromSourcePosition @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> + + let globalRightMatrixValuesPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + globalRightMatrixValuesPositions + requiredRightMatrixValuesPointers + globalPositions + globalRightMatrixValuesPointers) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + processor.Post <| Msg.CreateFreeMsg globalPositions + + globalRightMatrixValuesPointers + + let getLeftMatrixValuesCorrespondinglyToPositionsPattern<'a> (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) globalLength (globalPositions: Indices) (rightMatrixValues: ClArray<'a>) (result: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < globalLength then + let valuePosition = globalPositions.[gid] - 1 + + result.[gid] <- rightMatrixValues.[valuePosition]@> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>)-> + + // globalLength == globalPositions.Length + let resultLeftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(globalLength, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + globalLength + globalPositions + rightMatrixValues + resultLeftMatrixValues) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + processor.Post <| Msg.CreateFreeMsg globalPositions + + resultLeftMatrixValues + + let run (clContext: ClContext) workGroupSize multiplication = + + let getRequiredRawsLengths = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let getRequiredRightMatrixValuesPointers = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + + let getRightMatrixValuesPointers = + getRightMatrixPointers clContext workGroupSize + + let getGlobalPositions = getGlobalPositions clContext workGroupSize + + let gatherRightMatrixData = Gather.run clContext workGroupSize + + let gatherIndices = Gather.run clContext workGroupSize + + let getLeftMatrixValues = + getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext workGroupSize + + let map2 = ClArray.map2 clContext workGroupSize multiplication + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let requiredRawsLengths = + getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers + + // global expanded array length + let globalLength = + (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor + + // since prefix sum include + // positions in global array for right matrix + let globalRightMatrixValuesRawsStartPositions = requiredRawsLengths + + // pointers to required raws in right matrix values + let requiredRightMatrixValuesPointers = + getRequiredRightMatrixValuesPointers processor leftMatrix.Columns rightMatrix.RowPointers + + // bitmap to distinguish different raws in a general array + let globalPositions = + getGlobalPositions processor globalLength globalRightMatrixValuesRawsStartPositions + + // extended pointers to all required right matrix numbers + let globalRightMatrixValuesPointers = + getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixValuesRawsStartPositions requiredRightMatrixValuesPointers + + // gather all required right matrix values + let extendedRightMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + + gatherRightMatrixData processor globalRightMatrixValuesPointers rightMatrix.Values extendedRightMatrixValues + + // gather all required right matrix column indices + let extendedRightMatrixColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + + gatherIndices processor globalRightMatrixValuesPointers rightMatrix.Columns extendedRightMatrixColumns + + // left matrix values correspondingly to right matrix values + let extendedLeftMatrixValues = + getLeftMatrixValues processor globalLength globalPositions rightMatrix.Values + + let multiplicationResult = + map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues + + multiplicationResult, extendedRightMatrixColumns diff --git a/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs b/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs index 5d6d1dc6..05b36efd 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs @@ -11,3 +11,6 @@ module ClCell = processor.Post(Msg.CreateFreeMsg<_>(this)) res.[0] + + member this.Free(processor: MailboxProcessor<_>) = + processor.Post(Msg.CreateFreeMsg<_>(this)) From f77b4d2487db0ac18dfcc293b1391264cc40a502 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 11:13:15 +0300 Subject: [PATCH 007/143] add: requiredRawsLengths test --- .../GraphBLAS-sharp.Backend.fsproj | 2 +- .../Matrix/CSRMatrix/CSRMatrix.fs | 2 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 63 +++++++-- .../CSRMatrix/{SpGEMM.fs => SpGEMMMasked.fs} | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 1 + .../Matrix/SpGEMM/Expand.fs | 66 ++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 121 +++++++++--------- 7 files changed, 183 insertions(+), 74 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/{SpGEMM.fs => SpGEMMMasked.fs} (99%) create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index e7c11824..c88a73ff 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -38,7 +38,7 @@ - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs index 21882051..f11d9fff 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs @@ -250,7 +250,7 @@ module CSRMatrix = = let run = - SpGEMM.run clContext workGroupSize opAdd opMul + SpGEMMMasked.run clContext workGroupSize opAdd opMul fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 121a8ec0..32298577 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSRMatrix.SpGEMM +namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common @@ -6,6 +6,7 @@ open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell +open FSharp.Quotations type Indices = ClArray @@ -143,7 +144,6 @@ module Expand = ) processor.Post <| Msg.CreateRunMsg<_, _> kernel - processor.Post <| Msg.CreateFreeMsg globalPositions globalRightMatrixValuesPointers @@ -157,7 +157,7 @@ module Expand = if gid < globalLength then let valuePosition = globalPositions.[gid] - 1 - result.[gid] <- rightMatrixValues.[valuePosition]@> + result.[gid] <- rightMatrixValues.[valuePosition] @> let kernel = clContext.Compile kernel @@ -184,11 +184,51 @@ module Expand = ) processor.Post <| Msg.CreateRunMsg<_, _> kernel - processor.Post <| Msg.CreateFreeMsg globalPositions resultLeftMatrixValues - let run (clContext: ClContext) workGroupSize multiplication = + let getResultRowPointers (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + let rowPointer = leftMatrixRowPointers.[gid] + let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] + + result.[gid] <- globalPointer + @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) -> + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRowPointers.Length) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid( leftMatrixRowPointers.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + leftMatrixRowPointers.Length + leftMatrixRowPointers + globalArrayRightMatrixRawPointers + result) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + + result + + let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = let getRequiredRawsLengths = processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths @@ -199,11 +239,11 @@ module Expand = let getRequiredRightMatrixValuesPointers = processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + let getGlobalPositions = getGlobalPositions clContext workGroupSize + let getRightMatrixValuesPointers = getRightMatrixPointers clContext workGroupSize - let getGlobalPositions = getGlobalPositions clContext workGroupSize - let gatherRightMatrixData = Gather.run clContext workGroupSize let gatherIndices = Gather.run clContext workGroupSize @@ -213,6 +253,8 @@ module Expand = let map2 = ClArray.map2 clContext workGroupSize multiplication + let getRawPointers = getResultRowPointers clContext workGroupSize + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let requiredRawsLengths = @@ -252,9 +294,12 @@ module Expand = // left matrix values correspondingly to right matrix values let extendedLeftMatrixValues = - getLeftMatrixValues processor globalLength globalPositions rightMatrix.Values + getLeftMatrixValues processor globalLength globalPositions leftMatrix.Values let multiplicationResult = map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues - multiplicationResult, extendedRightMatrixColumns + let rowPointers = + getRawPointers processor leftMatrix.RowPointers globalRightMatrixValuesRawsStartPositions + + multiplicationResult, extendedRightMatrixColumns, rowPointers diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs similarity index 99% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs index cbcfbeb4..b2575e73 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs @@ -9,7 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell -module internal SpGEMM = +module internal SpGEMMMasked = let private calculate (context: ClContext) workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 14bbf3ff..81d96de0 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -45,6 +45,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs new file mode 100644 index 00000000..21639fee --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -0,0 +1,66 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Expand + +open GraphBLAS.FSharp.Objects.Matrix +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Expecto + +let context = Context.defaultContext + +/// +/// Left matrix +/// +/// +/// [ 0 0 2 3 0 +/// 0 0 0 0 0 +/// 0 8 0 5 4 +/// 0 0 2 0 0 +/// 1 7 0 0 0 ] +/// +let leftMatrix = + { RowCount = 5 + ColumnCount = 5 + RowPointers = [| 0; 2; 2; 5; 6; 8 |] + ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1|] + Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } + +/// +/// Right matrix +/// +/// +/// [ 0 0 0 0 0 0 0 +/// 0 3 0 0 4 0 4 +/// 0 0 2 0 0 2 0 +/// 0 5 0 0 0 9 1 +/// 0 0 0 0 1 0 8 ] +/// +let rightMatrix = + { RowCount = 5 + ColumnCount = 7 + RowPointers = [| 0; 0; 3; 5; 8; 10 |] + ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] + Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } + +let requiredRowLength = + testCase "requiredRowLength" + <| fun () -> + let clContext = context.ClContext + let processor = context.Queue + + let deviceLeftMatrix = leftMatrix.ToDevice clContext + let deviceRightMatrix = rightMatrix.ToDevice clContext + + let getRequiredRawsLengths = + Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths + + let requiredRawsLengths = + getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers + + let requiredRawsLengthsHost = requiredRawsLengths.ToHost processor + + "Results must be the same" + |> Expect.equal requiredRawsLengthsHost [| 2; 3; 3; 3; 2; 2; 0; 3 |] + + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 719aad6f..45e68ee1 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,73 +1,70 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Mxm.tests - Matrix.Transpose.tests ] - |> testSequenced - -let commonTests = - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.PrefixSum.tests - Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests ] - - testList - "Common tests" - [ clArrayTests - Common.BitonicSort.tests - Common.Scatter.tests - Common.Reduce.tests - Common.Sum.tests ] - |> testSequenced - -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.addGeneralTests - Vector.Map2.mulGeneralTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Mxm.tests +// Matrix.Transpose.tests ] +// |> testSequenced +// +// let commonTests = +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.PrefixSum.tests +// Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.tests ] +// +// testList +// "Common tests" +// [ clArrayTests +// Common.BitonicSort.tests +// Common.Scatter.tests +// Common.Reduce.tests +// Common.Sum.tests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.addGeneralTests +// Vector.Map2.mulGeneralTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced [] let allTests = testList "All tests" - [ commonTests - matrixTests - vectorTests - algorithmsTests ] + [ Matrix.SpGEMM.Expand.requiredRowLength ] |> testSequenced [] From d22621e6bcc782720e5c066e7670ac6a3a792882 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 12:03:01 +0300 Subject: [PATCH 008/143] wip: module Expand test --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 8 +- .../Objects/ArraysExtentions.fs | 6 ++ .../Matrix/SpGEMM/Expand.fs | 97 ++++++++++++++++--- tests/GraphBLAS-sharp.Tests/Program.fs | 7 +- 4 files changed, 102 insertions(+), 16 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 32298577..d61e0d28 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -266,7 +266,7 @@ module Expand = // since prefix sum include // positions in global array for right matrix - let globalRightMatrixValuesRawsStartPositions = requiredRawsLengths + let globalRightMatrixRawsStartPositions = requiredRawsLengths // pointers to required raws in right matrix values let requiredRightMatrixValuesPointers = @@ -274,11 +274,11 @@ module Expand = // bitmap to distinguish different raws in a general array let globalPositions = - getGlobalPositions processor globalLength globalRightMatrixValuesRawsStartPositions + getGlobalPositions processor globalLength globalRightMatrixRawsStartPositions // extended pointers to all required right matrix numbers let globalRightMatrixValuesPointers = - getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixValuesRawsStartPositions requiredRightMatrixValuesPointers + getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers // gather all required right matrix values let extendedRightMatrixValues = @@ -300,6 +300,6 @@ module Expand = map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues let rowPointers = - getRawPointers processor leftMatrix.RowPointers globalRightMatrixValuesRawsStartPositions + getRawPointers processor leftMatrix.RowPointers globalRightMatrixRawsStartPositions multiplicationResult, extendedRightMatrixColumns, rowPointers diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index d76b90b9..10cdd56b 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -13,6 +13,12 @@ module ArraysExtensions = let dst = Array.zeroCreate this.Length q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) + member this.ToHostAndFree(q: MailboxProcessor) = + let result = this.ToHost q + this.Dispose q + + result + member this.Size = this.Length type 'a ``[]`` with diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index 21639fee..b8695f4f 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -5,9 +5,15 @@ open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Expecto +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Predefined +open GraphBLAS.FSharp.Backend.Objects.ClCell let context = Context.defaultContext +let clContext = context.ClContext +let processor = context.Queue + /// /// Left matrix /// @@ -42,25 +48,94 @@ let rightMatrix = ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } -let requiredRowLength = +let deviceLeftMatrix = leftMatrix.ToDevice clContext +let deviceRightMatrix = rightMatrix.ToDevice clContext + +let requiredRawsLengths () = + let getRequiredRawsLengths = + Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths + + getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers + +let requiredRowLengthTest = testCase "requiredRowLength" <| fun () -> - let clContext = context.ClContext - let processor = context.Queue + let actual = requiredRawsLengths().ToHostAndFree processor + + "Results must be the same" + |> Expect.equal actual [| 2; 3; 3; 3; 2; 2; 0; 3 |] + +let globalLength = + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize - let deviceLeftMatrix = leftMatrix.ToDevice clContext - let deviceRightMatrix = rightMatrix.ToDevice clContext + let requiredRawsLengths = requiredRawsLengths () - let getRequiredRawsLengths = - Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths + (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor - let requiredRawsLengths = - getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers +let globalLengthTest = + testCase "global length test" + <| fun () -> Expect.equal globalLength 18 "Results must be the same" - let requiredRawsLengthsHost = requiredRawsLengths.ToHost processor +let getGlobalRightMatrixRawsStartPositions () = + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize + + let requiredRawsLengths = requiredRawsLengths () + + (prefixSumExclude processor requiredRawsLengths).Free processor + + requiredRawsLengths + +let globalRightMatrixRawsStartPositionsTest = + testCase "global right matrix raws start positions" + <| fun () -> + let result = (getGlobalRightMatrixRawsStartPositions ()).ToHostAndFree processor "Results must be the same" - |> Expect.equal requiredRawsLengthsHost [| 2; 3; 3; 3; 2; 2; 0; 3 |] + |> Expect.equal result [| 0; 2; 5; 8; 11; 13; 15; 15; |] + +let getRequiredRightMatrixValuesPointers () = + let getRequiredRightMatrixValuesPointers = + Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawPointers + getRequiredRightMatrixValuesPointers processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers +let getRequiredRightMatrixValuesPointersTest = + testCase "get required right matrix values pointers" + <| fun () -> + let result = (getRequiredRightMatrixValuesPointers ()).ToHostAndFree processor + + "Result must be the same" + |> Expect.equal result [| 3; 5; 0; 5; 8; 3; 0; 0; |] + +let getGlobalPositions () = + let getGlobalPositions = Expand.getGlobalPositions clContext Utils.defaultWorkGroupSize + + getGlobalPositions processor globalLength (getGlobalRightMatrixRawsStartPositions ()) + +let getGlobalPositionsTest = + testCase "getGlobalPositions test" + <| fun () -> + let result = (getGlobalPositions ()).ToHostAndFree processor + + "Result must be the same" + |> Expect.equal result [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + +let getRightMatrixValuesPointers () = + let getRightMatrixValuesPointers = + Expand.getRightMatrixPointers clContext Utils.defaultWorkGroupSize + + let globalPositions = getGlobalPositions () + let globalRightMatrixRawsStartPositions = getGlobalRightMatrixRawsStartPositions () + let requiredRightMatrixValuesPointers = getRequiredRightMatrixValuesPointers () + + getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers + +let rightMatrixValuesPointersTest = + testCase "RightMatrixValuesPointers" + <| fun () -> + let result = (getRightMatrixValuesPointers ()).ToHostAndFree processor + "Result must be the same" + |> Expect.equal result [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 45e68ee1..8c812f56 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -64,7 +64,12 @@ open GraphBLAS.FSharp.Tests.Backend let allTests = testList "All tests" - [ Matrix.SpGEMM.Expand.requiredRowLength ] + [ Matrix.SpGEMM.Expand.requiredRowLengthTest + Matrix.SpGEMM.Expand.globalLengthTest + Matrix.SpGEMM.Expand.globalRightMatrixRawsStartPositionsTest + Matrix.SpGEMM.Expand.getRequiredRightMatrixValuesPointersTest + Matrix.SpGEMM.Expand.getGlobalPositionsTest + Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest ] |> testSequenced [] From 9d25601e8b314ab8d81bf06c8ae5df263a50de6a Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 20:32:48 +0300 Subject: [PATCH 009/143] refactor: globalMap --- .../BenchmarksBFS.fs | 2 +- src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs | 2 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 283 +++++++++++------- .../Objects/ArraysExtentions.fs | 4 +- src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 2 +- .../Matrix/SpGEMM/Expand.fs | 48 ++- tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 4 +- 8 files changed, 237 insertions(+), 112 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index 618b99ca..c9e2d233 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs @@ -83,7 +83,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : (matrix :> IDeviceMemObject).Dispose this.Processor member this.ClearResult() = - this.ResultVector.Dispose this.Processor + this.ResultVector.Free this.Processor member this.ReadMatrix() = let matrixReader = this.InputMatrixReader diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs index 570688cc..4dbb9ba4 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs @@ -67,7 +67,7 @@ module BFS = not <| (containsNonZero queue front).ToHostAndFree queue - front.Dispose queue + front.Free queue levels | _ -> failwith "Not implemented" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index d61e0d28..f7d0d2f0 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell open FSharp.Quotations +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions type Indices = ClArray @@ -72,29 +73,7 @@ module Expand = requiredRawsLengths - let getGlobalPositions (clContext: ClContext) workGroupSize = - - let zeroCreate = ClArray.zeroCreate clContext workGroupSize - - let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> - - let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> - - /// We get an array of zeros - let globalPositions = zeroCreate processor DeviceOnly resultLength - - // Insert units at the beginning of new lines (source positions) - assignUnits processor globalRightMatrixValuesPositions globalPositions - - // Apply the prefix sum, - // get an array where different sub-arrays of pointers to elements of the same row differ in values - (prefixSum processor globalPositions).Free processor - - globalPositions - - let getRightMatrixPointers (clContext: ClContext) workGroupSize = + let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> @@ -121,7 +100,7 @@ module Expand = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> + fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> let globalRightMatrixValuesPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) @@ -137,7 +116,7 @@ module Expand = kernel.KernelFunc ndRange resultLength - globalRightMatrixValuesPositions + globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers globalPositions globalRightMatrixValuesPointers) @@ -147,46 +126,6 @@ module Expand = globalRightMatrixValuesPointers - let getLeftMatrixValuesCorrespondinglyToPositionsPattern<'a> (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) globalLength (globalPositions: Indices) (rightMatrixValues: ClArray<'a>) (result: ClArray<'a>) -> - - let gid = ndRange.GlobalID0 - - if gid < globalLength then - let valuePosition = globalPositions.[gid] - 1 - - result.[gid] <- rightMatrixValues.[valuePosition] @> - - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>)-> - - // globalLength == globalPositions.Length - let resultLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) - - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(globalLength, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - globalLength - globalPositions - rightMatrixValues - resultLeftMatrixValues) - ) - - processor.Post <| Msg.CreateRunMsg<_, _> kernel - - resultLeftMatrixValues - let getResultRowPointers (clContext: ClContext) workGroupSize = let kernel = @@ -228,78 +167,222 @@ module Expand = result - let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = + let getGlobalMap (clContext: ClContext) workGroupSize = - let getRequiredRawsLengths = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + let zeroCreate = ClArray.zeroCreate clContext workGroupSize + + let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> + + let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> + + /// We get an array of zeros + let globalPositions = zeroCreate processor DeviceOnly resultLength + + // Insert units at the beginning of new lines (source positions) + assignUnits processor globalRightMatrixValuesPositions globalPositions + + // Apply the prefix sum, + // get an array where different sub-arrays of pointers to elements of the same row differ in values + (prefixSum processor globalPositions).Free processor + + globalPositions + + let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = + + let getUniqueBitmap = + ClArray.getUniqueBitmap clContext workGroupSize let prefixSumExclude = PrefixSum.standardExcludeInplace clContext workGroupSize - let getRequiredRightMatrixValuesPointers = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + let indicesScatter = + Scatter.runInplace clContext workGroupSize - let getGlobalPositions = getGlobalPositions clContext workGroupSize + let dataScatter = + Scatter.runInplace clContext workGroupSize - let getRightMatrixValuesPointers = - getRightMatrixPointers clContext workGroupSize + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> - let gatherRightMatrixData = Gather.run clContext workGroupSize + let leftMatrixRequiredPositions, resultLength = + let bitmap = + getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions - let gatherIndices = Gather.run clContext workGroupSize + let length = (prefixSumExclude processor bitmap).ToHostAndFree processor - let getLeftMatrixValues = - getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext workGroupSize + bitmap, length - let map2 = ClArray.map2 clContext workGroupSize multiplication + let requiredLeftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let getRawPointers = getResultRowPointers clContext workGroupSize + indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let requiredLeftMatrixColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns + + leftMatrixRequiredPositions.Free processor + + requiredLeftMatrixColumns, requiredLeftMatrixValues + + let processPositions (clContext: ClContext) workGroupSize = + + let getRequiredRawsLengths = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + let removeDuplications = ClArray.removeDuplications clContext workGroupSize + + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let extractLeftMatrixRequiredValuesAndColumns = + extractLeftMatrixRequiredValuesAndColumns clContext workGroupSize + + let getGlobalPositions = getGlobalMap clContext workGroupSize + + let getRequiredRightMatrixValuesPointers = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + // array of required right matrix rows length obtained by left matrix columns let requiredRawsLengths = getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers - // global expanded array length + // global expanded array length (sum of previous length) let globalLength = (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor - // since prefix sum include - // positions in global array for right matrix - let globalRightMatrixRawsStartPositions = requiredRawsLengths + // rename array after side effect of prefix sum include + // positions in global array for right matrix raws with duplicates + let globalRightMatrixRowsStartPositions = requiredRawsLengths + + + /// Extract required left matrix columns and values by global right matrix pointers. + /// Then get required right matrix rows (pointers to rows) by required left matrix columns. + + // extract required left matrix columns and rows by right matrix rows positions + let requiredLeftMatrixColumns, requiredLeftMatrixValues = + extractLeftMatrixRequiredValuesAndColumns processor leftMatrix globalRightMatrixRowsStartPositions // pointers to required raws in right matrix values - let requiredRightMatrixValuesPointers = - getRequiredRightMatrixValuesPointers processor leftMatrix.Columns rightMatrix.RowPointers + // rows to be placed by globalRightMatrixRowsStartPositionsWithoutDuplicates + let requiredRightMatrixRawPointers = + getRequiredRightMatrixValuesPointers processor requiredLeftMatrixColumns rightMatrix.RowPointers - // bitmap to distinguish different raws in a general array - let globalPositions = - getGlobalPositions processor globalLength globalRightMatrixRawsStartPositions + requiredLeftMatrixColumns.Free processor - // extended pointers to all required right matrix numbers - let globalRightMatrixValuesPointers = - getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers + // remove duplications in right matrix rows positions in global extended array + let globalRightMatrixRawsPointersWithoutDuplicates = + removeDuplications processor globalRightMatrixRowsStartPositions + + globalRightMatrixRowsStartPositions.Free processor + + // int map to distinguish different raws in a general array. 1 for first, 2 for second and so forth... + let globalMap = + getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates + + globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers + + let expandLeftMatrixValues (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) resultLength (globalBitmap: Indices) (leftMatrixValues: Values<'a>) (resultValues: Values<'a>) -> + + let gid = ndRange.GlobalID0 + + // globalBitmap.Length == resultValues.Length + if gid < resultLength then + let valueIndex = globalBitmap.[gid] - 1 + + resultValues.[gid] <- leftMatrixValues.[valueIndex] @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (globalMap: Indices) (leftMatrixValues: Values<'a>) -> + + let expandedLeftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(globalMap.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + globalMap.Length + globalMap + leftMatrixValues + expandedLeftMatrixValues) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + + expandedLeftMatrixValues + + let getRightMatrixColumnsAndValues (clContext: ClContext) workGroupSize = + let gatherRightMatrixData = Gather.run clContext workGroupSize + + let gatherIndices = Gather.run clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>) (rightMatrixColumns: Indices) -> // gather all required right matrix values let extendedRightMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) - gatherRightMatrixData processor globalRightMatrixValuesPointers rightMatrix.Values extendedRightMatrixValues + gatherRightMatrixData processor globalPositions rightMatrixValues extendedRightMatrixValues // gather all required right matrix column indices let extendedRightMatrixColumns = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) - gatherIndices processor globalRightMatrixValuesPointers rightMatrix.Columns extendedRightMatrixColumns + gatherIndices processor globalPositions rightMatrixColumns extendedRightMatrixColumns - // left matrix values correspondingly to right matrix values + extendedRightMatrixValues, extendedRightMatrixColumns + + let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = + + let processPositions = processPositions clContext workGroupSize + + let getRightMatrixValuesPointers = + expandRightMatrixValuesIndices clContext workGroupSize + + let getRightMatrixColumnsAndValues = + getRightMatrixColumnsAndValues clContext workGroupSize + + let expandLeftMatrixValues = + expandLeftMatrixValues clContext workGroupSize + + let map2 = ClArray.map2 clContext workGroupSize multiplication + + let getRawPointers = getResultRowPointers clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers + = processPositions processor leftMatrix rightMatrix + + // left matrix values correspondingly to right matrix values // TODO() let extendedLeftMatrixValues = - getLeftMatrixValues processor globalLength globalPositions leftMatrix.Values + expandLeftMatrixValues processor globalMap leftMatrix.Values + let resultRowPointers = + getRawPointers processor leftMatrix.RowPointers globalRightMatrixRowsPointers + + // extended pointers to all required right matrix numbers + let globalRightMatrixValuesPointers = + getRightMatrixValuesPointers processor globalMap.Length globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + + let extendedRightMatrixValues, extendedRightMatrixColumns = + getRightMatrixColumnsAndValues processor globalMap.Length globalRightMatrixValuesPointers rightMatrix.Values rightMatrix.Columns + + /// Multiplication let multiplicationResult = map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues - let rowPointers = - getRawPointers processor leftMatrix.RowPointers globalRightMatrixRawsStartPositions - - multiplicationResult, extendedRightMatrixColumns, rowPointers + multiplicationResult, extendedRightMatrixColumns, resultRowPointers diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index 10cdd56b..d9f7a545 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -5,7 +5,7 @@ open Brahma.FSharp module ArraysExtensions = type ClArray<'a> with - member this.Dispose(q: MailboxProcessor) = + member this.Free(q: MailboxProcessor) = q.Post(Msg.CreateFreeMsg this) q.PostAndReply(Msg.MsgNotifyMe) @@ -15,7 +15,7 @@ module ArraysExtensions = member this.ToHostAndFree(q: MailboxProcessor) = let result = this.ToHost q - this.Dispose q + this.Free q result diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index 4e9f3b33..c1d75282 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -34,4 +34,4 @@ type ClVector<'a when 'a: struct> = member this.Dispose(q) = match this with | Sparse vector -> vector.Dispose(q) - | Dense vector -> vector.Dispose(q) + | Dense vector -> vector.Free(q) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index b8695f4f..7c0e3a55 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -8,6 +8,7 @@ open Expecto open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ClContext let context = Context.defaultContext @@ -28,7 +29,7 @@ let leftMatrix = { RowCount = 5 ColumnCount = 5 RowPointers = [| 0; 2; 2; 5; 6; 8 |] - ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1|] + ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } /// @@ -110,7 +111,7 @@ let getRequiredRightMatrixValuesPointersTest = |> Expect.equal result [| 3; 5; 0; 5; 8; 3; 0; 0; |] let getGlobalPositions () = - let getGlobalPositions = Expand.getGlobalPositions clContext Utils.defaultWorkGroupSize + let getGlobalPositions = Expand.getGlobalMap clContext Utils.defaultWorkGroupSize getGlobalPositions processor globalLength (getGlobalRightMatrixRawsStartPositions ()) @@ -124,13 +125,13 @@ let getGlobalPositionsTest = let getRightMatrixValuesPointers () = let getRightMatrixValuesPointers = - Expand.getRightMatrixPointers clContext Utils.defaultWorkGroupSize + Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize let globalPositions = getGlobalPositions () let globalRightMatrixRawsStartPositions = getGlobalRightMatrixRawsStartPositions () let requiredRightMatrixValuesPointers = getRequiredRightMatrixValuesPointers () - getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers + getRightMatrixValuesPointers processor globalLength globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers globalPositions let rightMatrixValuesPointersTest = testCase "RightMatrixValuesPointers" @@ -139,3 +140,42 @@ let rightMatrixValuesPointersTest = "Result must be the same" |> Expect.equal result [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + +let gatherRightMatrixData () = + let getRightMatrixColumnsAndValues = + Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + + let rightMatrixValuesPointers = getRightMatrixValuesPointers () + + getRightMatrixColumnsAndValues processor globalLength rightMatrixValuesPointers deviceRightMatrix.Values deviceRightMatrix.Columns + +let checkGatherRightMatrixData = + testCase "gather right matrix data test" + <| fun () -> + let values, columns = gatherRightMatrixData () + + let hostValues = values.ToHostAndFree processor + + "Result must be the same" + |> Expect.equal hostValues [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + + let hostColumns = columns.ToHostAndFree processor + + "Result must be the same" + |> Expect.equal hostColumns [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + +let getLeftMatrixValues () = + let getLeftMatrixValues = + Expand.getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext Utils.defaultWorkGroupSize + + let globalPositions = getGlobalPositions () + + getLeftMatrixValues processor globalLength globalPositions deviceLeftMatrix.Values + +let getLeftMatrixValuesTest = + testCase "get left matrix values" + <| fun () -> + let result = (getLeftMatrixValues ()).ToHostAndFree processor + + "Left matrix values must be the same" + |> Expect.equal result [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 8c812f56..1264d30b 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -69,7 +69,9 @@ let allTests = Matrix.SpGEMM.Expand.globalRightMatrixRawsStartPositionsTest Matrix.SpGEMM.Expand.getRequiredRightMatrixValuesPointersTest Matrix.SpGEMM.Expand.getGlobalPositionsTest - Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest ] + Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest + Matrix.SpGEMM.Expand.checkGatherRightMatrixData + Matrix.SpGEMM.Expand.getLeftMatrixValuesTest ] |> testSequenced [] diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 90d90ef4..1ce37add 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -76,9 +76,9 @@ let correctnessGenericTest let res = spMV testContext.Queue HostInterop m v (ClMatrix.CSR m).Dispose q - v.Dispose q + v.Free q let hostRes = res.ToHost q - res.Dispose q + res.Free q checkResult isEqual sumOp mulOp zero matrix vector hostRes | _ -> failwith "Impossible" From 54798164668146d43f29ee5d136de4ad4a883202 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 14 Mar 2023 00:01:19 +0300 Subject: [PATCH 010/143] add: Expand stage --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 254 +++++++++--------- .../Matrix/SpGEMM/Expand.fs | 178 ++++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 14 +- 3 files changed, 226 insertions(+), 220 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index f7d0d2f0..6f8681ae 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -73,99 +73,43 @@ module Expand = requiredRawsLengths - let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> + let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = - let gid = ndRange.GlobalID0 + let getUniqueBitmap = + ClArray.getUniqueBitmap clContext workGroupSize - if gid < length then - // index corresponding to the position of pointers - let positionIndex = globalPositions.[gid] - 1 + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext workGroupSize - // the position of the beginning of a new line of pointers - let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] + let indicesScatter = + Scatter.runInplace clContext workGroupSize - // offset from the source pointer - let offsetFromSourcePosition = gid - sourcePosition + let dataScatter = + Scatter.runInplace clContext workGroupSize - // pointer to the first element in the row of the right matrix from which - // the offset will be counted to get pointers to subsequent elements in this row - let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> - // adding up the mix with the source pointer, - // we get a pointer to a specific element in the raw - result.[gid] <- sourcePointer + offsetFromSourcePosition @> + let leftMatrixRequiredPositions, resultLength = + let bitmap = + getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions - let kernel = clContext.Compile kernel + let length = (prefixSumExclude processor bitmap).ToHostAndFree processor - fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> + bitmap, length - let globalRightMatrixValuesPointers = + let requiredLeftMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - globalRightMatrixRawsStartPositions - requiredRightMatrixValuesPointers - globalPositions - globalRightMatrixValuesPointers) - ) - - processor.Post <| Msg.CreateRunMsg<_, _> kernel - - globalRightMatrixValuesPointers - - let getResultRowPointers (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - if gid < length then - let rowPointer = leftMatrixRowPointers.[gid] - let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] - - result.[gid] <- globalPointer - @> - - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) -> - - let result = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRowPointers.Length) - - let kernel = kernel.GetKernel() + indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues - let ndRange = - Range1D.CreateValid( leftMatrixRowPointers.Length, workGroupSize) + let requiredLeftMatrixColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftMatrixRowPointers.Length - leftMatrixRowPointers - globalArrayRightMatrixRawPointers - result) - ) + dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns - processor.Post <| Msg.CreateRunMsg<_, _> kernel + leftMatrixRequiredPositions.Free processor - result + requiredLeftMatrixColumns, requiredLeftMatrixValues let getGlobalMap (clContext: ClContext) workGroupSize = @@ -183,49 +127,56 @@ module Expand = // Insert units at the beginning of new lines (source positions) assignUnits processor globalRightMatrixValuesPositions globalPositions - // Apply the prefix sum, + // Apply the prefix sum, SIDE EFFECT!!! // get an array where different sub-arrays of pointers to elements of the same row differ in values (prefixSum processor globalPositions).Free processor globalPositions - let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = - - let getUniqueBitmap = - ClArray.getUniqueBitmap clContext workGroupSize + let getResultRowPointers (clContext: ClContext) workGroupSize = - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext workGroupSize + let kernel = + <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> - let indicesScatter = - Scatter.runInplace clContext workGroupSize + let gid = ndRange.GlobalID0 - let dataScatter = - Scatter.runInplace clContext workGroupSize + // do not touch the last element + if gid < length - 1 then + let rowPointer = leftMatrixRowPointers.[gid] + let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> + result.[gid] <- globalPointer @> - let leftMatrixRequiredPositions, resultLength = - let bitmap = - getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions + let kernel = clContext.Compile kernel - let length = (prefixSumExclude processor bitmap).ToHostAndFree processor + let createResultPointersBuffer = ClArray.create clContext workGroupSize - bitmap, length + fun (processor: MailboxProcessor<_>) (globalLength: int) (leftMatrixRowPointers: Indices) (globalRightMatrixRowPointers: Indices) -> - let requiredLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + // The last element must be equal to the length of the global array. + let result = + createResultPointersBuffer processor DeviceOnly leftMatrixRowPointers.Length globalLength - indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues + let kernel = kernel.GetKernel() - let requiredLeftMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + // do not touch the last element + let ndRange = + Range1D.CreateValid(leftMatrixRowPointers.Length - 1, workGroupSize) - dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + leftMatrixRowPointers.Length + leftMatrixRowPointers + globalRightMatrixRowPointers + result) + ) - leftMatrixRequiredPositions.Free processor + processor.Post <| Msg.CreateRunMsg<_, _> kernel - requiredLeftMatrixColumns, requiredLeftMatrixValues + result let processPositions (clContext: ClContext) workGroupSize = @@ -242,6 +193,8 @@ module Expand = let getGlobalPositions = getGlobalMap clContext workGroupSize + let getRowPointers = getResultRowPointers clContext workGroupSize + let getRequiredRightMatrixValuesPointers = processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers @@ -250,7 +203,7 @@ module Expand = let requiredRawsLengths = getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers - // global expanded array length (sum of previous length) + // global expanded array length (sum of previous length) SIDE EFFECT!!! let globalLength = (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor @@ -258,7 +211,6 @@ module Expand = // positions in global array for right matrix raws with duplicates let globalRightMatrixRowsStartPositions = requiredRawsLengths - /// Extract required left matrix columns and values by global right matrix pointers. /// Then get required right matrix rows (pointers to rows) by required left matrix columns. @@ -277,13 +229,70 @@ module Expand = let globalRightMatrixRawsPointersWithoutDuplicates = removeDuplications processor globalRightMatrixRowsStartPositions + // RESULT row pointers into result expanded (obtained by multiplication) array + let resultRowPointers = + getRowPointers processor globalLength leftMatrix.RowPointers globalRightMatrixRowsStartPositions + globalRightMatrixRowsStartPositions.Free processor // int map to distinguish different raws in a general array. 1 for first, 2 for second and so forth... let globalMap = getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates - globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers + globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers, resultRowPointers + + let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + // index corresponding to the position of pointers + let positionIndex = globalPositions.[gid] - 1 + + // the position of the beginning of a new line of pointers + let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] + + // offset from the source pointer + let offsetFromSourcePosition = gid - sourcePosition + + // pointer to the first element in the row of the right matrix from which + // the offset will be counted to get pointers to subsequent elements in this row + let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] + + // adding up the mix with the source pointer, + // we get a pointer to a specific element in the raw + result.[gid] <- sourcePointer + offsetFromSourcePosition @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalMap: Indices) -> + + let globalRightMatrixValuesPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(globalMap.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + globalMap.Length + globalRightMatrixRawsStartPositions + requiredRightMatrixValuesPointers + globalMap + globalRightMatrixValuesPointers) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + + globalRightMatrixValuesPointers let expandLeftMatrixValues (clContext: ClContext) workGroupSize = @@ -330,18 +339,18 @@ module Expand = let gatherIndices = Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>) (rightMatrixColumns: Indices) -> + fun (processor: MailboxProcessor<_>) (globalPositions: Indices) (rightMatrix: ClMatrix.CSR<'a>) -> // gather all required right matrix values let extendedRightMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - gatherRightMatrixData processor globalPositions rightMatrixValues extendedRightMatrixValues + gatherRightMatrixData processor globalPositions rightMatrix.Values extendedRightMatrixValues // gather all required right matrix column indices let extendedRightMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - gatherIndices processor globalPositions rightMatrixColumns extendedRightMatrixColumns + gatherIndices processor globalPositions rightMatrix.Columns extendedRightMatrixColumns extendedRightMatrixValues, extendedRightMatrixColumns @@ -349,37 +358,32 @@ module Expand = let processPositions = processPositions clContext workGroupSize - let getRightMatrixValuesPointers = + let expandLeftMatrixValues = + expandLeftMatrixValues clContext workGroupSize + + let expandRightMatrixValuesPointers = expandRightMatrixValuesIndices clContext workGroupSize let getRightMatrixColumnsAndValues = getRightMatrixColumnsAndValues clContext workGroupSize - let expandLeftMatrixValues = - expandLeftMatrixValues clContext workGroupSize - let map2 = ClArray.map2 clContext workGroupSize multiplication - let getRawPointers = getResultRowPointers clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPositions processor leftMatrix rightMatrix - // left matrix values correspondingly to right matrix values // TODO() + // left matrix values correspondingly to right matrix values let extendedLeftMatrixValues = - expandLeftMatrixValues processor globalMap leftMatrix.Values - - let resultRowPointers = - getRawPointers processor leftMatrix.RowPointers globalRightMatrixRowsPointers + expandLeftMatrixValues processor globalMap requiredLeftMatrixValues // extended pointers to all required right matrix numbers let globalRightMatrixValuesPointers = - getRightMatrixValuesPointers processor globalMap.Length globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap let extendedRightMatrixValues, extendedRightMatrixColumns = - getRightMatrixColumnsAndValues processor globalMap.Length globalRightMatrixValuesPointers rightMatrix.Values rightMatrix.Columns + getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers rightMatrix /// Multiplication let multiplicationResult = diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index 7c0e3a55..0890b5d9 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -6,8 +6,6 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Expecto open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Predefined -open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ClContext let context = Context.defaultContext @@ -52,130 +50,136 @@ let rightMatrix = let deviceLeftMatrix = leftMatrix.ToDevice clContext let deviceRightMatrix = rightMatrix.ToDevice clContext -let requiredRawsLengths () = - let getRequiredRawsLengths = - Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths +let processPosition () = + let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize - getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers + processPositions processor deviceLeftMatrix deviceRightMatrix -let requiredRowLengthTest = - testCase "requiredRowLength" +let processPositionsTest = + testCase "ProcessPositions test" <| fun () -> - let actual = requiredRawsLengths().ToHostAndFree processor + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () - "Results must be the same" - |> Expect.equal actual [| 2; 3; 3; 3; 2; 2; 0; 3 |] + "Global map must be the same" + |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] -let globalLength = - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize + "global right matrix rows pointers must be the same" + |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] - let requiredRawsLengths = requiredRawsLengths () + "required left matrix values must be the same" + |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] - (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor + "required right matrix row pointers" + |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] -let globalLengthTest = - testCase "global length test" - <| fun () -> Expect.equal globalLength 18 "Results must be the same" + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] -let getGlobalRightMatrixRawsStartPositions () = - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize +let expandLeftMatrixValues () = + let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize - let requiredRawsLengths = requiredRawsLengths () + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () - (prefixSumExclude processor requiredRawsLengths).Free processor + let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues - requiredRawsLengths + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor -let globalRightMatrixRawsStartPositionsTest = - testCase "global right matrix raws start positions" - <| fun () -> - let result = (getGlobalRightMatrixRawsStartPositions ()).ToHostAndFree processor + result - "Results must be the same" - |> Expect.equal result [| 0; 2; 5; 8; 11; 13; 15; 15; |] +let expandLeftMatrixValuesTest = + testCase "expandLeftMatrixValues test" + <| fun () -> + let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor -let getRequiredRightMatrixValuesPointers () = - let getRequiredRightMatrixValuesPointers = - Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawPointers + "Expand left matrix values must be the same" + |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] - getRequiredRightMatrixValuesPointers processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers +let expandGlobalRightMatrixPointers () = + let expandRightMatrixValuesPointers = + Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize -let getRequiredRightMatrixValuesPointersTest = - testCase "get required right matrix values pointers" - <| fun () -> - let result = (getRequiredRightMatrixValuesPointers ()).ToHostAndFree processor + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () - "Result must be the same" - |> Expect.equal result [| 3; 5; 0; 5; 8; 3; 0; 0; |] + let globalRightMatrixValuesPointers = + expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap -let getGlobalPositions () = - let getGlobalPositions = Expand.getGlobalMap clContext Utils.defaultWorkGroupSize + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor - getGlobalPositions processor globalLength (getGlobalRightMatrixRawsStartPositions ()) + globalRightMatrixValuesPointers -let getGlobalPositionsTest = - testCase "getGlobalPositions test" +let extendGlobalRightMatrixPointersTest = + testCase "expandRightMatrixRowPointers test " <| fun () -> - let result = (getGlobalPositions ()).ToHostAndFree processor + let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor - "Result must be the same" - |> Expect.equal result [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + "row pointers must be the same" + |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] -let getRightMatrixValuesPointers () = - let getRightMatrixValuesPointers = - Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize +let getRightMatrixValuesAndColumns () = + let getRightMatrixColumnsAndValues = + Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize - let globalPositions = getGlobalPositions () - let globalRightMatrixRawsStartPositions = getGlobalRightMatrixRawsStartPositions () - let requiredRightMatrixValuesPointers = getRequiredRightMatrixValuesPointers () + let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () - getRightMatrixValuesPointers processor globalLength globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers globalPositions + getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix -let rightMatrixValuesPointersTest = - testCase "RightMatrixValuesPointers" +let getRightMatrixValuesAndPointersTest = + testCase "expandRightMatrixValuesAndColumns" <| fun () -> - let result = (getRightMatrixValuesPointers ()).ToHostAndFree processor + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - "Result must be the same" - |> Expect.equal result [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + "extendedRightMatrixValues must be the same" + |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] -let gatherRightMatrixData () = - let getRightMatrixColumnsAndValues = - Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] - let rightMatrixValuesPointers = getRightMatrixValuesPointers () +let multiplication () = + let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> - getRightMatrixColumnsAndValues processor globalLength rightMatrixValuesPointers deviceRightMatrix.Values deviceRightMatrix.Columns + let expandedLeftMatrixValues = expandLeftMatrixValues () -let checkGatherRightMatrixData = - testCase "gather right matrix data test" - <| fun () -> - let values, columns = gatherRightMatrixData () + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () + extendedRightMatrixColumns.Free processor - let hostValues = values.ToHostAndFree processor + let multiplicationResult = + map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues - "Result must be the same" - |> Expect.equal hostValues [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + expandedLeftMatrixValues.Free processor + extendedRightMatrixValues.Free processor - let hostColumns = columns.ToHostAndFree processor + multiplicationResult - "Result must be the same" - |> Expect.equal hostColumns [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] +let multiplicationTest = + testCase "multiplication test" <| fun () -> + let result = (multiplication ()).ToHostAndFree processor -let getLeftMatrixValues () = - let getLeftMatrixValues = - Expand.getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext Utils.defaultWorkGroupSize + "Results must be the same" + |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] - let globalPositions = getGlobalPositions () +let runExtendTest = + testCase "Expand.run test" <| fun () -> + let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> - getLeftMatrixValues processor globalLength globalPositions deviceLeftMatrix.Values + let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = + run processor deviceLeftMatrix deviceRightMatrix -let getLeftMatrixValuesTest = - testCase "get left matrix values" - <| fun () -> - let result = (getLeftMatrixValues ()).ToHostAndFree processor + "Results must be the same" + |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] - "Left matrix values must be the same" - |> Expect.equal result [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 1264d30b..523f9612 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -64,14 +64,12 @@ open GraphBLAS.FSharp.Tests.Backend let allTests = testList "All tests" - [ Matrix.SpGEMM.Expand.requiredRowLengthTest - Matrix.SpGEMM.Expand.globalLengthTest - Matrix.SpGEMM.Expand.globalRightMatrixRawsStartPositionsTest - Matrix.SpGEMM.Expand.getRequiredRightMatrixValuesPointersTest - Matrix.SpGEMM.Expand.getGlobalPositionsTest - Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest - Matrix.SpGEMM.Expand.checkGatherRightMatrixData - Matrix.SpGEMM.Expand.getLeftMatrixValuesTest ] + [ Matrix.SpGEMM.Expand.processPositionsTest + Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest + Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest + Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest + Matrix.SpGEMM.Expand.multiplicationTest + Matrix.SpGEMM.Expand.runExtendTest ] |> testSequenced [] From be13d6eafac24c2df20b955141ff00448118094d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 16 Mar 2023 14:29:24 +0300 Subject: [PATCH 011/143] add: Expand test --- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 7 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 14 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 8 +- src/GraphBLAS-sharp/Objects/Matrix.fs | 12 +- tests/GraphBLAS-sharp.Tests/Generators.fs | 13 +- .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 57 ++++ .../Matrix/SpGEMM/Example.fs | 185 ++++++++++++ .../Matrix/SpGEMM/Expand.fs | 273 +++++++++++------- tests/GraphBLAS-sharp.Tests/Program.fs | 29 +- 10 files changed, 466 insertions(+), 133 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 9898acee..65d5968d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -17,12 +17,15 @@ module internal Gather = let run (clContext: ClContext) workGroupSize = let gather = - <@ fun (ndRange: Range1D) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> + <@ fun (ndRange: Range1D) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> let i = ndRange.GlobalID0 if i < size then - outputArray.[i] <- inputArray.[positions.[i]] @> + let position = positions.[i] + let value = values.[position] + + outputArray.[i] <- value @> let program = clContext.Compile(gather) diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index a3d54dec..840f024f 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -27,17 +27,17 @@ module internal Scatter = let run = <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (values: ClArray<'a>) (result: ClArray<'a>) (resultLength: int) -> - let i = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if i < positionsLength then - let index = positions.[i] + if gid < positionsLength then + let index = positions.[gid] if 0 <= index && index < resultLength then - if i < positionsLength - 1 then - if index <> positions.[i + 1] then - result.[index] <- values.[i] + if gid < positionsLength - 1 then + if index <> positions.[gid + 1] then + result.[index] <- values.[gid] else - result.[index] <- values.[i] @> + result.[index] <- values.[gid] @> let program = clContext.Compile(run) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 6f8681ae..93fe923c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -230,6 +230,8 @@ module Expand = removeDuplications processor globalRightMatrixRowsStartPositions // RESULT row pointers into result expanded (obtained by multiplication) array + // printfn "GLOBAL LENGTH: %A" globalLength + let resultRowPointers = getRowPointers processor globalLength leftMatrix.RowPointers globalRightMatrixRowsStartPositions @@ -239,6 +241,8 @@ module Expand = let globalMap = getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates + // printfn "global clmap: %A" <| globalMap.ToHost processor + globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers, resultRowPointers let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = @@ -250,7 +254,7 @@ module Expand = if gid < length then // index corresponding to the position of pointers - let positionIndex = globalPositions.[gid] - 1 + let positionIndex = globalPositions.[gid] - 1 // TODO() // the position of the beginning of a new line of pointers let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] @@ -303,7 +307,7 @@ module Expand = // globalBitmap.Length == resultValues.Length if gid < resultLength then - let valueIndex = globalBitmap.[gid] - 1 + let valueIndex = globalBitmap.[gid] - 1 //TODO() resultValues.[gid] <- leftMatrixValues.[valueIndex] @> diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index 5dda085b..5213e750 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -19,6 +19,8 @@ module Matrix = sprintf "Values: %A \n" this.Values ] |> String.concat "" + member this.NNZ = this.Values.Length + static member FromTuples(rowCount: int, columnCount: int, rows: int [], columns: int [], values: 'a []) = { RowCount = rowCount ColumnCount = columnCount @@ -79,6 +81,8 @@ module Matrix = RowCount = rowsCount ColumnCount = columnsCount } + member this.NNZ = this.Values.Length + member this.ToDevice(context: ClContext) = { Context = context RowCount = this.RowCount @@ -121,6 +125,8 @@ module Matrix = RowCount = rowsCount ColumnCount = columnsCount } + member this.NNZ = this.Values.Length + member this.ToDevice(context: ClContext) = { Context = context RowCount = this.RowCount @@ -154,9 +160,9 @@ type Matrix<'a when 'a: struct> = member this.NNZ = match this with - | COO m -> m.Values.Length - | CSR m -> m.Values.Length - | CSC m -> m.Values.Length + | COO m -> m.NNZ + | CSR m -> m.NNZ + | CSC m -> m.NNZ member this.ToDevice(context: ClContext) = match this with diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 2183d0b9..b473f345 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -38,12 +38,14 @@ module Generators = /// Generates empty matrices as well. /// let dimension2DGenerator = - Gen.sized - <| fun size -> Gen.choose (1, size) |> Gen.two + fun size -> Gen.choose (1, size) + |> Gen.sized + |> Gen.two let dimension3DGenerator = - Gen.sized - <| fun size -> Gen.choose (1, size) |> Gen.three + fun size -> Gen.choose (1, size) + |> Gen.sized + |> Gen.three let rec normalFloat32Generator (random: System.Random) = gen { @@ -384,6 +386,9 @@ module Generators = valuesGenerator |> Gen.array2DOfDim (nColsA, nColsB) + printf $"left matrix column count: %A{Array2D.length1 matrixA}" + printf $"right matrix row count: %A{Array2D.length2 matrixA}" + return (matrixA, matrixB) } diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 81d96de0..a0fa7f90 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -45,6 +45,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index bfbe4450..765b40c1 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -129,6 +129,63 @@ module Utils = result + let prefixSumExclude (array: 'a []) zero plus = + let mutable sum = zero + + for i in 0 .. array.Length - 1 do + let currentItem = array.[i] + array.[i] <- sum + + sum <- plus currentItem sum + + sum + + let prefixSumInclude (array: 'a []) zero plus = + let mutable sum = zero + + for i in 0 .. array.Length - 1 do + sum <- plus array.[i] sum + + array.[i] <- sum + + sum + + let getUniqueBitmap<'a when 'a: equality> (array: 'a []) = + let bitmap = Array.zeroCreate array.Length + + for i in 0 .. array.Length - 2 do + if array.[i] <> array.[i + 1] then bitmap.[i] <- 1 + + // set last 1 + bitmap.[bitmap.Length - 1] <- 1 + + bitmap + + let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = + for i in 0 .. positions.Length - 2 do + if positions.[i] <> positions.[i + 1] then + let valuePosition = positions.[i] + let value = values.[i] + + resultValues.[valuePosition] <- value + + // set last value + let lastPosition = positions.[positions.Length - 1] + let lastValue = values.[values.Length - 1] + + resultValues.[lastPosition] <- lastValue + + let gather (positions: int []) (values: 'a []) (result: 'a []) = + for i in 0 .. positions.Length do + let position = positions.[i] + let value = values.[position] + + result.[position] <- value + + let castMatrixToCSR = function + | Matrix.CSR matrix -> matrix + | _ -> failwith "matrix format must be CSR" + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs new file mode 100644 index 00000000..332c2c82 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs @@ -0,0 +1,185 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Example + +open GraphBLAS.FSharp.Objects.Matrix +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Expecto +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext + +let clContext = context.ClContext +let processor = context.Queue + +/// +/// Left matrix +/// +/// +/// [ 0 0 2 3 0 +/// 0 0 0 0 0 +/// 0 8 0 5 4 +/// 0 0 2 0 0 +/// 1 7 0 0 0 ] +/// +let leftMatrix = + { RowCount = 5 + ColumnCount = 5 + RowPointers = [| 0; 2; 2; 5; 6; 8 |] + ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] + Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } + +/// +/// Right matrix +/// +/// +/// [ 0 0 0 0 0 0 0 +/// 0 3 0 0 4 0 4 +/// 0 0 2 0 0 2 0 +/// 0 5 0 0 0 9 1 +/// 0 0 0 0 1 0 8 ] +/// +let rightMatrix = + { RowCount = 5 + ColumnCount = 7 + RowPointers = [| 0; 0; 3; 5; 8; 10 |] + ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] + Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } + +let deviceLeftMatrix = leftMatrix.ToDevice clContext +let deviceRightMatrix = rightMatrix.ToDevice clContext + +let processPosition () = + let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize + + processPositions processor deviceLeftMatrix deviceRightMatrix + +let processPositionsTest = + testCase "ProcessPositions test" + <| fun () -> + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () + + "Global map must be the same" + |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + + "global right matrix rows pointers must be the same" + |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] + + "required left matrix values must be the same" + |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] + + "required right matrix row pointers" + |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] + + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + +let expandLeftMatrixValues () = + let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize + + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () + + let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues + + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor + + result + +let expandLeftMatrixValuesTest = + testCase "expandLeftMatrixValues test" + <| fun () -> + let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor + + "Expand left matrix values must be the same" + |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] + +let expandGlobalRightMatrixPointers () = + let expandRightMatrixValuesPointers = + Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize + + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () + + let globalRightMatrixValuesPointers = + expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor + + globalRightMatrixValuesPointers + +let extendGlobalRightMatrixPointersTest = + testCase "expandRightMatrixRowPointers test " + <| fun () -> + let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor + + "row pointers must be the same" + |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + +let getRightMatrixValuesAndColumns () = + let getRightMatrixColumnsAndValues = + Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + + let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () + + getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix + +let getRightMatrixValuesAndPointersTest = + testCase "expandRightMatrixValuesAndColumns" + <| fun () -> + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () + + "extendedRightMatrixValues must be the same" + |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + +let multiplication () = + let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> + + let expandedLeftMatrixValues = expandLeftMatrixValues () + + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () + extendedRightMatrixColumns.Free processor + + let multiplicationResult = + map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues + + expandedLeftMatrixValues.Free processor + extendedRightMatrixValues.Free processor + + multiplicationResult + +let multiplicationTest = + testCase "multiplication test" <| fun () -> + let result = (multiplication ()).ToHostAndFree processor + + "Results must be the same" + |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + +let runExtendTest = + testCase "Expand.run test" <| fun () -> + let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> + + let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = + run processor deviceLeftMatrix deviceRightMatrix + + "Results must be the same" + |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index 0890b5d9..8defec14 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -1,17 +1,14 @@ module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Expand -open GraphBLAS.FSharp.Objects.Matrix open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.Matrix open Expecto -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Objects.ClContext - -let context = Context.defaultContext - -let clContext = context.ClContext -let processor = context.Queue +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp /// /// Left matrix @@ -47,139 +44,209 @@ let rightMatrix = ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } -let deviceLeftMatrix = leftMatrix.ToDevice clContext -let deviceRightMatrix = rightMatrix.ToDevice clContext +type ExpandedResult<'a> = + { Values: 'a [] + Columns: int [] + RowPointers: int [] } + +let config = { Utils.defaultConfig with arbitrary = [ typeof ] } + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let hostExpand multiplication (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'a>) = + // Pointers to start positions for right matrix rows in global array + // With duplicates which means that there is no string in the global array + let rowsPointersToGlobalArray, globalLength = + let requiredRightMatrixRowsLength = + (fun index -> + let columnIndex = leftMatrix.ColumnIndices.[index] + + let startPointer = rightMatrix.RowPointers.[columnIndex] + let endPointer = rightMatrix.RowPointers.[columnIndex + 1] + + endPointer - startPointer) + |> Array.init leftMatrix.ColumnIndices.Length + + //printfn "requiredRightMatrixRowsLength: %A" requiredRightMatrixRowsLength + + // Get right matrix row positions in global array by side effect + let globalLength = + Utils.prefixSumExclude requiredRightMatrixRowsLength 0 (+) + + //printfn "requiredRightMatrixRowsLength after prefix sum: %A" requiredRightMatrixRowsLength + + requiredRightMatrixRowsLength, globalLength + + //printfn "global length: %A" globalLength + + let resultGlobalRowPointers = + (fun index -> + if index < leftMatrix.RowPointers.Length - 1 then + let rowPointer = leftMatrix.RowPointers.[index] + + // printfn "index: %A; lenght: %A" rowPointer rowsPointersToGlobalArray.Length + + rowsPointersToGlobalArray.[rowPointer] + else + globalLength) + |> Array.init leftMatrix.RowPointers.Length + + // Right matrix row positions in global array without duplicates + let globalRightMatrixRowPositions = Array.distinct rowsPointersToGlobalArray + + //printfn "global right matrix row positions without pointers: %A" globalRightMatrixRowPositions + + // Create global map + let globalMap = + let array = + (fun index -> if Array.contains index globalRightMatrixRowPositions then 1 else 0) + |> Array.init globalLength + + Utils.prefixSumInclude array 0 (+) |> ignore + + array + + //printfn "%A" globalMap + + // get required left matrix columns and values + let requiredLeftMatrixColumns, requireLeftMatrixValues = + let positions = + Utils.getUniqueBitmap rowsPointersToGlobalArray + + let length = Utils.prefixSumExclude positions 0 (+) -let processPosition () = - let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize + let requiredLeftMatrixColumns = Array.zeroCreate length - processPositions processor deviceLeftMatrix deviceRightMatrix + Utils.scatter positions leftMatrix.ColumnIndices requiredLeftMatrixColumns -let processPositionsTest = - testCase "ProcessPositions test" - <| fun () -> - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () + // printfn "required left matrix columns: %A" requiredLeftMatrixColumns - "Global map must be the same" - |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + let requiredLeftMatrixValues = Array.zeroCreate length - "global right matrix rows pointers must be the same" - |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] + Utils.scatter positions leftMatrix.Values requiredLeftMatrixValues - "required left matrix values must be the same" - |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] + // printfn "required left matrix values: %A" requiredLeftMatrixValues - "required right matrix row pointers" - |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] + requiredLeftMatrixColumns, requiredLeftMatrixValues - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + // right matrix required row pointers + let rightMatrixRequiredRowsPointers = + (fun index -> + let requiredLeftMatrixColumn = requiredLeftMatrixColumns.[index] -let expandLeftMatrixValues () = - let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize + rightMatrix.RowPointers.[requiredLeftMatrixColumn]) + |> Array.init globalRightMatrixRowPositions.Length - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () + //printfn "right matrix required row pointers: %A" rightMatrixRequiredRowsPointers - let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues + let globalRequiredRightMatrixValuesIndices = + (fun index -> + let rowID = globalMap.[index] - 1 + let sourcePosition = globalRightMatrixRowPositions.[rowID] + let offset = index - sourcePosition - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor + rightMatrixRequiredRowsPointers.[rowID] + offset) + |> Array.init globalLength - result + //printfn "global required right matrix values: %A" globalRequiredRightMatrixValuesIndices -let expandLeftMatrixValuesTest = - testCase "expandLeftMatrixValues test" - <| fun () -> - let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor + let globalRightMatrixRequiredValues = + (fun index -> + let valueIndex = globalRequiredRightMatrixValuesIndices.[index] + rightMatrix.Values.[valueIndex]) + |> Array.init globalLength - "Expand left matrix values must be the same" - |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] + let globalRightMatrixRequiredColumnIndices = + (fun index -> + let valueIndex = globalRequiredRightMatrixValuesIndices.[index] + rightMatrix.ColumnIndices.[valueIndex]) + |> Array.init globalLength -let expandGlobalRightMatrixPointers () = - let expandRightMatrixValuesPointers = - Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize + //printfn "global required right matrix columns: %A" globalRightMatrixRequiredColumnIndices - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () + let globalLeftMatrixRequiredValues = + (fun index -> + let valueIndex = globalMap.[index] - 1 - let globalRightMatrixValuesPointers = - expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + requireLeftMatrixValues.[valueIndex]) + |> Array.init globalLength - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor + let resultValues = + Array.map2 multiplication globalRightMatrixRequiredValues globalLeftMatrixRequiredValues - globalRightMatrixValuesPointers + { Values = resultValues + Columns = globalRightMatrixRequiredColumnIndices + RowPointers = resultGlobalRowPointers } -let extendGlobalRightMatrixPointersTest = - testCase "expandRightMatrixRowPointers test " - <| fun () -> - let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor +let checkResult multiplication leftMatrix rightMatrix actualResult = + let expected = + hostExpand multiplication leftMatrix rightMatrix - "row pointers must be the same" - |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + "Values must be the same" + |> Expect.sequenceEqual expected.Values actualResult.Values -let getRightMatrixValuesAndColumns () = - let getRightMatrixColumnsAndValues = - Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + "Columns must be the same" + |> Expect.sequenceEqual expected.Columns actualResult.Columns - let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () + "Row pointers must be the same" + |> Expect.sequenceEqual expected.RowPointers actualResult.RowPointers - getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix + printfn "SUCCESS" -let getRightMatrixValuesAndPointersTest = - testCase "expandRightMatrixValuesAndColumns" - <| fun () -> - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () +let makeTest isZero multiplication expand (leftArray: 'a [,], rightArray: 'a [,]) = - "extendedRightMatrixValues must be the same" - |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray isZero + |> Utils.castMatrixToCSR - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray isZero + |> Utils.castMatrixToCSR -let multiplication () = - let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - let expandedLeftMatrixValues = expandLeftMatrixValues () + try + //printfn $"left matrix: %A{leftArray}" + //printfn $"right matrix: %A{rightArray}" - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - extendedRightMatrixColumns.Free processor + if leftMatrix.ColumnCount <> rightMatrix.RowCount then + failwith "LOLO" - let multiplicationResult = - map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues + hostExpand multiplication leftMatrix rightMatrix |> ignore - expandedLeftMatrixValues.Free processor - extendedRightMatrixValues.Free processor + let deviceLeftMatrix = + leftMatrix.ToDevice context - multiplicationResult + let deviceRightMatrix = + rightMatrix.ToDevice context -let multiplicationTest = - testCase "multiplication test" <| fun () -> - let result = (multiplication ()).ToHostAndFree processor + let (multiplicationResult: ClArray<'a>), + (extendedRightMatrixColumns: ClArray), + (resultRowPointers: ClArray) = + expand processor deviceLeftMatrix deviceRightMatrix - "Results must be the same" - |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + { Values = multiplicationResult.ToHostAndFree processor + Columns = extendedRightMatrixColumns.ToHostAndFree processor + RowPointers = resultRowPointers.ToHostAndFree processor } + |> checkResult multiplication leftMatrix rightMatrix + with + | ex when ex.Message = "InvalidBufferSize" -> () + | _ -> reraise () -let runExtendTest = - testCase "Expand.run test" <| fun () -> - let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> +let creatTest<'a when 'a : struct and 'a : equality> (isZero: 'a -> bool) multiplicationQ multiplication = + Expand.run context Utils.defaultWorkGroupSize multiplicationQ + |> makeTest isZero multiplication + |> testPropertyWithConfig config $"Expand.run on %A{typeof<'a>}" - let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = - run processor deviceLeftMatrix deviceRightMatrix +let testFixtures = + creatTest ((=) 0) <@ (*) @> (*) - "Results must be the same" - |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] +let check = + let leftMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[-2; 3; -1; -3]; [2; -1; 3; -1]] - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + let rightMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[3; 0; 3; 4]; [1; -4; 1; 0]] - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + () diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 523f9612..d77e9b5b 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,5 +1,6 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM // let matrixTests = // testList @@ -60,17 +61,21 @@ open GraphBLAS.FSharp.Tests.Backend // testList "Algorithms tests" [ Algorithms.BFS.tests ] // |> testSequenced -[] -let allTests = - testList - "All tests" - [ Matrix.SpGEMM.Expand.processPositionsTest - Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest - Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest - Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest - Matrix.SpGEMM.Expand.multiplicationTest - Matrix.SpGEMM.Expand.runExtendTest ] - |> testSequenced +// [] +// let allTests = +// testList +// "All tests" +// [ Matrix.SpGEMM.Expand.processPositionsTest +// Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest +// Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest +// Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest +// Matrix.SpGEMM.Expand.multiplicationTest +// Matrix.SpGEMM.Expand.runExtendTest ] + // |> testSequenced + + [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = Expand.testFixtures |> runTestsWithCLIArgs [] argv + + From 146b17fa885906a1128244dbfa9fd575e63f80d2 Mon Sep 17 00:00:00 2001 From: ArtiomPatov Date: Tue, 21 Mar 2023 23:01:37 +0300 Subject: [PATCH 012/143] add: Matrix.map --- .../GraphBLAS-sharp.Backend.fsproj | 2 + .../Matrix/COOMatrix/Map.fs | 117 ++++++++++ .../Matrix/COOMatrix/Matrix.fs | 2 + .../Matrix/CSRMatrix/Map.fs | 155 +++++++++++++ .../Matrix/CSRMatrix/Matrix.fs | 2 + src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 15 ++ .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 206 ++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 3 + 9 files changed, 503 insertions(+) create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index affc7f5a..b3d7f503 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -37,9 +37,11 @@ + + 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..4ff9a1e5 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs @@ -0,0 +1,117 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.COO + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Matrix +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 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>) (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 index = + (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) + + let value = + (%Map2.binSearch) valuesLength index rowPointers 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/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..bbd5098a --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs @@ -0,0 +1,155 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.CSR + +open Brahma.FSharp +open FSharp.Quotations +open GraphBLAS.FSharp.Backend +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 Map = + let binSearch<'a> = + <@ fun startIndex nnzInRow sourceColumn (columnIndices: ClArray) (values: ClArray<'a>) -> + + let mutable leftEdge = startIndex + let mutable rightEdge = startIndex + nnzInRow - 1 + + let mutable result = None + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentColumn = columnIndices.[middleIdx] + + if sourceColumn = currentColumn then + result <- Some values.[middleIdx] + + rightEdge <- -1 // TODO() break + elif sourceColumn < currentColumn then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + + let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = + + 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 nnzInRow = + rowPointers.[rowIndex + 1] + - rowPointers.[rowIndex] + + let value = + (%binSearch) rowPointers.[rowIndex] nnzInRow 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 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 + 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 elementwiseToCOO = runToCOO clContext opAdd workGroupSize + + let toCSRInplace = + Matrix.toCSRInplace clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + elementwiseToCOO queue allocationMode matrix + |> 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..a5bf0cb2 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -90,6 +90,8 @@ module Matrix = Columns = matrix.Columns Values = matrix.Values } + let map = CSR.Map.run + 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>) 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/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 14bbf3ff..d5c43eaa 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -45,6 +45,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..64a478cc --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -0,0 +1,206 @@ +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.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) op isEqual opQ map = + let getCorrectnessTestName = getCorrectnessTestName case + + let context = case.TestContext.ClContext + let q = case.TestContext.Queue + + let map = map context opQ wgSize + + let toCOO = Matrix.toCOO context wgSize + + case + |> correctnessGenericTest zero op map toCOO isEqual q + |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") + +let testFixturesMapNot case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + let notQ = + <@ fun x -> + match x with + | Some true -> None + | _ -> Some true @> + + createTestMap case false not (=) notQ Matrix.map ] + +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) + + let addFloat64Q = + <@ fun x -> + let mutable res = 0.0 + + match x with + | Some v -> res <- (v + 10.0) + | None -> res <- 10.0 + + if res = 0.0 then None else Some res @> + + let addFloat32Q = + <@ fun x -> + let mutable res = 0.0f + + match x with + | Some v -> res <- (v + 10.0f) + | None -> res <- 10.0f + + if res = 0.0f then None else Some res @> + + let addByte = + <@ fun x -> + let mutable res = 0uy + + match x with + | Some v -> res <- (v + 10uy) + | None -> res <- 10uy + + if res = 0uy then None else Some res @> + + if Utils.isFloat64Available context.ClDevice then + createTestMap case 0.0 ((+) 10.0) Utils.floatIsEqual addFloat64Q Matrix.map + + createTestMap case 0.0f ((+) 10.0f) Utils.float32IsEqual addFloat32Q Matrix.map + createTestMap case 0uy ((+) 10uy) (=) addByte Matrix.map ] + +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) + + let mulFloat64Q = + <@ fun x -> + let mutable res = 0.0 + + match x with + | Some v -> res <- (v * 10.0) + | _ -> () + + if res = 0.0 then None else Some res @> + + let mulFloat32Q = + <@ fun x -> + let mutable res = 0.0f + + match x with + | Some v -> res <- (v * 10.0f) + | _ -> () + + if res = 0.0f then None else Some res @> + + + let mulByte = + <@ fun x -> + let mutable res = 0uy + + match x with + | Some v -> res <- (v * 10uy) + | _ -> () + + if res = 0uy then None else Some res @> + + if Utils.isFloat64Available context.ClDevice then + createTestMap case 0.0 ((*) 10.0) Utils.floatIsEqual mulFloat64Q Matrix.map + + createTestMap case 0.0f ((*) 10.0f) Utils.float32IsEqual mulFloat32Q Matrix.map + createTestMap case 0uy ((*) 10uy) (=) mulByte Matrix.map ] + +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 2514a8ff..94a4787d 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 From 5571002e3008abfc8356b7a985139bb972f4ca81 Mon Sep 17 00:00:00 2001 From: ArtiomPatov Date: Thu, 23 Mar 2023 07:02:43 +0300 Subject: [PATCH 013/143] refactor: tests, binSearch --- .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Matrix/COOMatrix/Map.fs | 9 +-- .../Matrix/COOMatrix/Map2.fs | 31 +------- .../Matrix/CSRMatrix/Map.fs | 39 ++-------- .../Quotes/Arithmetic.fs | 16 ++++ .../Quotes/BinSearch.fs | 55 ++++++++++++++ tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 74 ++----------------- 7 files changed, 94 insertions(+), 131 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index b3d7f503..76c665c3 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -26,6 +26,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs index 4ff9a1e5..7352785d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs @@ -2,6 +2,7 @@ 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 @@ -9,11 +10,11 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext -module Map = +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>) (rowPointers: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultRows: ClArray) (resultColumns: ClArray) -> + <@ 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 @@ -26,7 +27,7 @@ module Map = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) let value = - (%Map2.binSearch) valuesLength index rowPointers columns values + (%BinSearch.searchCOO) valuesLength index rows columns values match (%op) value with | Some resultValue -> @@ -37,7 +38,6 @@ module Map = resultBitmap.[gid] <- 1 | None -> resultBitmap.[gid] <- 0 @> - let kernel = clContext.Compile <| preparePositions opAdd @@ -83,7 +83,6 @@ module Map = resultBitmap, resultValues, resultRows, resultColumns - let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs index d3d2e0d1..cccef30a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -5,36 +5,11 @@ 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 module internal Map2 = - let binSearch<'a> = - <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> - - let mutable leftEdge = 0 - let mutable rightEdge = lenght - 1 - - let mutable result = None - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - - let currentIndex: uint64 = - ((uint64 rowIndices.[middleIdx]) <<< 32) - ||| (uint64 columnIndices.[middleIdx]) - - if sourceIndex = currentIndex then - result <- Some values.[middleIdx] - - rightEdge <- -1 // TODO() break - elif sourceIndex < currentIndex then - rightEdge <- middleIdx - 1 - else - leftEdge <- middleIdx + 1 - - result @> - let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = @@ -51,10 +26,10 @@ module internal Map2 = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) let leftValue = - (%binSearch) leftValuesLength index leftRows leftColumns leftValues + (%BinSearch.searchCOO) leftValuesLength index leftRows leftColumns leftValues let rightValue = - (%binSearch) rightValuesLength index rightRows rightColumn rightValues + (%BinSearch.searchCOO) rightValuesLength index rightRows rightColumn rightValues match (%op) leftValue rightValue with | Some value -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs index bbd5098a..1ce83e79 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs @@ -3,37 +3,14 @@ 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 Map = - let binSearch<'a> = - <@ fun startIndex nnzInRow sourceColumn (columnIndices: ClArray) (values: ClArray<'a>) -> - - let mutable leftEdge = startIndex - let mutable rightEdge = startIndex + nnzInRow - 1 - - let mutable result = None - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - - let currentColumn = columnIndices.[middleIdx] - - if sourceColumn = currentColumn then - result <- Some values.[middleIdx] - - rightEdge <- -1 // TODO() break - elif sourceColumn < currentColumn then - rightEdge <- middleIdx - 1 - else - leftEdge <- middleIdx + 1 - - result @> - +module internal Map = let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = let preparePositions (op: Expr<'a option -> 'b option>) = @@ -46,12 +23,11 @@ module Map = let columnIndex = gid % columnCount let rowIndex = gid / columnCount - let nnzInRow = - rowPointers.[rowIndex + 1] - - rowPointers.[rowIndex] + let startIndex = rowPointers.[rowIndex] + let lastIndex = rowPointers.[rowIndex + 1] - 1 let value = - (%binSearch) rowPointers.[rowIndex] nnzInRow columnIndex columns values + (%BinSearch.searchInRange) startIndex lastIndex columnIndex columns values match (%op) value with | Some resultValue -> @@ -106,7 +82,6 @@ module Map = 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>) @@ -145,11 +120,11 @@ module Map = workGroupSize = - let elementwiseToCOO = runToCOO clContext opAdd workGroupSize + let mapToCOO = runToCOO clContext opAdd workGroupSize let toCSRInplace = Matrix.toCSRInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - elementwiseToCOO queue allocationMode matrix + mapToCOO queue allocationMode matrix |> toCSRInplace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 1432510f..e5c2d7a9 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 mkOpWithConst zero op constant = + <@ fun x -> + let mutable res = zero + + match x with + | Some v -> res <- (op v constant) + | None -> res <- constant + + if res = zero then None else Some res @> + let inline mkNumericSum zero = <@ fun (x: 't option) (y: 't option) -> let mutable res = zero @@ -98,3 +108,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/BinSearch.fs b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs new file mode 100644 index 00000000..422fd48e --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs @@ -0,0 +1,55 @@ +namespace GraphBLAS.FSharp.Backend.Quotes + +open Brahma.FSharp + +module BinSearch = + let searchInRange<'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 @> + + let searchCOO<'a> = + <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> + + let mutable leftEdge = 0 + let mutable rightEdge = lenght - 1 + + let mutable result = None + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentIndex: uint64 = + ((uint64 rowIndices.[middleIdx]) <<< 32) + ||| (uint64 columnIndices.[middleIdx]) + + if sourceIndex = currentIndex then + result <- Some values.[middleIdx] + + rightEdge <- -1 // TODO() break + elif sourceIndex < currentIndex then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index 64a478cc..b8b8578c 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -5,6 +5,7 @@ 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 @@ -105,13 +106,7 @@ let testFixturesMapNot case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let notQ = - <@ fun x -> - match x with - | Some true -> None - | _ -> Some true @> - - createTestMap case false not (=) notQ Matrix.map ] + createTestMap case false not (=) ArithmeticOperations.notQ Matrix.map ] let notTests = operationGPUTests "Backend.Matrix.map not tests" testFixturesMapNot @@ -121,35 +116,9 @@ let testFixturesMapAdd case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let addFloat64Q = - <@ fun x -> - let mutable res = 0.0 - - match x with - | Some v -> res <- (v + 10.0) - | None -> res <- 10.0 - - if res = 0.0 then None else Some res @> - - let addFloat32Q = - <@ fun x -> - let mutable res = 0.0f - - match x with - | Some v -> res <- (v + 10.0f) - | None -> res <- 10.0f - - if res = 0.0f then None else Some res @> - - let addByte = - <@ fun x -> - let mutable res = 0uy - - match x with - | Some v -> res <- (v + 10uy) - | None -> res <- 10uy - - if res = 0uy then None else Some res @> + let addFloat64Q = ArithmeticOperations.mkOpWithConst 0.0 (+) 10.0 + let addFloat32Q = ArithmeticOperations.mkOpWithConst 0.0f (+) 10.0f + let addByte = ArithmeticOperations.mkOpWithConst 0uy (+) 10uy if Utils.isFloat64Available context.ClDevice then createTestMap case 0.0 ((+) 10.0) Utils.floatIsEqual addFloat64Q Matrix.map @@ -165,36 +134,9 @@ let testFixturesMapMul case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let mulFloat64Q = - <@ fun x -> - let mutable res = 0.0 - - match x with - | Some v -> res <- (v * 10.0) - | _ -> () - - if res = 0.0 then None else Some res @> - - let mulFloat32Q = - <@ fun x -> - let mutable res = 0.0f - - match x with - | Some v -> res <- (v * 10.0f) - | _ -> () - - if res = 0.0f then None else Some res @> - - - let mulByte = - <@ fun x -> - let mutable res = 0uy - - match x with - | Some v -> res <- (v * 10uy) - | _ -> () - - if res = 0uy then None else Some res @> + let mulFloat64Q = ArithmeticOperations.mkOpWithConst 0.0 (*) 10.0 + let mulFloat32Q = ArithmeticOperations.mkOpWithConst 0.0f (*) 10.0f + let mulByte = ArithmeticOperations.mkOpWithConst 0uy (*) 10uy if Utils.isFloat64Available context.ClDevice then createTestMap case 0.0 ((*) 10.0) Utils.floatIsEqual mulFloat64Q Matrix.map From 7349c1dcdba14a61f481e9bdcfc7ddd9a6ba7c9c Mon Sep 17 00:00:00 2001 From: ArtiomPatov Date: Thu, 23 Mar 2023 07:12:15 +0300 Subject: [PATCH 014/143] refactor: formatting --- .../Quotes/Arithmetic.fs | 10 ++++----- .../Quotes/BinSearch.fs | 1 - tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 22 ++++++++++++++----- 3 files changed, 21 insertions(+), 12 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index e5c2d7a9..da8730d7 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -5,13 +5,13 @@ open GraphBLAS.FSharp.Backend.Objects module ArithmeticOperations = let inline mkOpWithConst zero op constant = <@ fun x -> - let mutable res = zero + let mutable res = zero - match x with - | Some v -> res <- (op v constant) - | None -> res <- constant + match x with + | Some v -> res <- (op v constant) + | None -> res <- constant - if res = zero then None else Some res @> + if res = zero then None else Some res @> let inline mkNumericSum zero = <@ fun (x: 't option) (y: 't option) -> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs index 422fd48e..4bde7c67 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs @@ -52,4 +52,3 @@ module BinSearch = leftEdge <- middleIdx + 1 result @> - diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index b8b8578c..0b45b6dd 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -116,9 +116,14 @@ let testFixturesMapAdd case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let addFloat64Q = ArithmeticOperations.mkOpWithConst 0.0 (+) 10.0 - let addFloat32Q = ArithmeticOperations.mkOpWithConst 0.0f (+) 10.0f - let addByte = ArithmeticOperations.mkOpWithConst 0uy (+) 10uy + let addFloat64Q = + ArithmeticOperations.mkOpWithConst 0.0 (+) 10.0 + + let addFloat32Q = + ArithmeticOperations.mkOpWithConst 0.0f (+) 10.0f + + let addByte = + ArithmeticOperations.mkOpWithConst 0uy (+) 10uy if Utils.isFloat64Available context.ClDevice then createTestMap case 0.0 ((+) 10.0) Utils.floatIsEqual addFloat64Q Matrix.map @@ -134,9 +139,14 @@ let testFixturesMapMul case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let mulFloat64Q = ArithmeticOperations.mkOpWithConst 0.0 (*) 10.0 - let mulFloat32Q = ArithmeticOperations.mkOpWithConst 0.0f (*) 10.0f - let mulByte = ArithmeticOperations.mkOpWithConst 0uy (*) 10uy + let mulFloat64Q = + ArithmeticOperations.mkOpWithConst 0.0 (*) 10.0 + + let mulFloat32Q = + ArithmeticOperations.mkOpWithConst 0.0f (*) 10.0f + + let mulByte = + ArithmeticOperations.mkOpWithConst 0uy (*) 10uy if Utils.isFloat64Available context.ClDevice then createTestMap case 0.0 ((*) 10.0) Utils.floatIsEqual mulFloat64Q Matrix.map From 3fc1b440bdb665206adbff80c4b0adf796e9a54f Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 23 Mar 2023 19:55:03 +0300 Subject: [PATCH 015/143] add: Search module --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 165 ++++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 3 +- .../Matrix/COOMatrix/Map2.fs | 30 +--- .../Objects/ArraysExtentions.fs | 8 + .../Quotes/PreparePositions.fs | 9 + src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 80 +++++++++ src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs | 20 ++- .../Vector/SparseVector/Map2.fs | 32 +--- .../Common/{ => Reduce}/Reduce.fs | 0 .../Common/Reduce/ReduceByKey.fs | 35 ++++ .../Common/{ => Reduce}/Sum.fs | 0 .../GraphBLAS-sharp.Tests.fsproj | 5 +- 12 files changed, 329 insertions(+), 58 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Quotes/Search.fs rename tests/GraphBLAS-sharp.Tests/Common/{ => Reduce}/Reduce.fs (100%) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs rename tests/GraphBLAS-sharp.Tests/Common/{ => Reduce}/Sum.fs (100%) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index ed80ee40..40ab0e44 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -5,6 +5,8 @@ open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Reduce = let private runGeneral (clContext: ClContext) workGroupSize scan scanToCell = @@ -235,3 +237,166 @@ module Reduce = runGeneral clContext workGroupSize scan scanToCell fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array + + module ByKey = + let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + + let kernel = + <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + let mutable currentKey = keys.[gid] + let mutable segmentResult = values.[gid] + let mutable segmentCount = 0 + + for i in 1 .. length - 1 do + if currentKey = keys.[i] then + segmentResult <- (%reduceOp) segmentResult values.[i] + else + reducedValues.[segmentCount] <- segmentResult + reducedKeys.[segmentCount] <- currentKey + + segmentCount <- segmentCount + 1 + currentKey <- keys.[i] + segmentResult <- values.[i] + + reducedKeys.[segmentCount] <- currentKey + reducedValues.[segmentCount] <- segmentResult @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let reducedKeys = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength keys values reducedValues reducedKeys)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let segmentSequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] + let sourceKey = keys.[startPosition] + + let mutable nextPosition = startPosition + 1 // TODO() + let mutable nextKey = keys.[nextPosition] + let mutable sum = values.[startPosition] + + while nextKey = sourceKey do + sum <- (%reduceOp) sum values.[nextPosition] + + nextPosition <- nextPosition + 1 + nextKey <- keys.[nextPosition] + + reducedValues.[gid] <- sum + reducedKeys.[gid] <- sourceKey @> + + let kernel = clContext.Compile kernel + + let getUniqueBitmap = ClArray.getUniqueBitmap clContext workGroupSize + + let prefixSum = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize + + let removeDuplicates = ClArray.removeDuplications clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a>) -> + + let bitmap = getUniqueBitmap processor DeviceOnly keys + + let resultLength = (prefixSum processor bitmap 0).ToHostAndFree processor + + let offsets = removeDuplicates processor bitmap + + bitmap.Free processor + + let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let reducedKeys = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength offsets keys values reducedValues reducedKeys)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let oneWorkGroupSegments (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + + let kernel = + <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> + + let lid = ndRange.GlobalID0 + + // load values to local memory (may be without it) + let localValues = localArray<'a> length + if lid < length then localValues.[lid] <- values.[lid] + + // load keys to local memory (mb without it) + let localKeys = localArray length + if lid < length then localKeys.[lid] <- keys.[lid] + + // get unique keys bitmap + let localBitmap = localArray length + (%PreparePositions.getUniqueBitmapLocal) localKeys length lid localBitmap + + // get positions from bitmap by prefix sum + // ??? get bitmap by prefix sum in another kernel ??? + (%SubSum.localIntPrefixSum) lid workGroupSize localBitmap + let localPositions = localBitmap + + let uniqueKeysCount = localPositions.[length - 1] + + if lid < uniqueKeysCount then + let itemKeyId = lid + 1 + // we can count start position by itemKeyId + // but loose coalesced memory read pattern + + let startKeyIndex = + (%Search.Bin.lowerPosition) length itemKeyId localPositions + + match startKeyIndex with + | Some startPosition -> + let sourcePosition = localPositions.[startPosition] + let mutable currentSum = localValues.[startPosition] + let mutable currentIndex = startPosition + 1 + + while currentIndex < length + && localPositions.[currentIndex] = sourcePosition do + + currentSum <- (%reduceOp) currentSum localValues.[currentIndex] + currentIndex <- currentIndex + 1 + + reducedKeys.[lid] <- localKeys.[startPosition] + reducedValues.[lid] <- currentSum + | None -> () @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let reducedKeys = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength keys values reducedValues reducedKeys)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index affc7f5a..01654c1d 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -26,11 +26,12 @@ + - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs index d3d2e0d1..9cd4433d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -7,33 +7,9 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Quotes module internal Map2 = - let binSearch<'a> = - <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> - - let mutable leftEdge = 0 - let mutable rightEdge = lenght - 1 - - let mutable result = None - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - - let currentIndex: uint64 = - ((uint64 rowIndices.[middleIdx]) <<< 32) - ||| (uint64 columnIndices.[middleIdx]) - - if sourceIndex = currentIndex then - result <- Some values.[middleIdx] - - rightEdge <- -1 // TODO() break - elif sourceIndex < currentIndex then - rightEdge <- middleIdx - 1 - else - leftEdge <- middleIdx + 1 - - result @> let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = @@ -51,10 +27,10 @@ module internal Map2 = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) let leftValue = - (%binSearch) leftValuesLength index leftRows leftColumns leftValues + (%Search.Bin.byKey2) leftValuesLength index leftRows leftColumns leftValues let rightValue = - (%binSearch) rightValuesLength index rightRows rightColumn rightValues + (%Search.Bin.byKey2) rightValuesLength index rightRows rightColumn rightValues match (%op) leftValue rightValue with | Some value -> diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index d76b90b9..51bbf4a7 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -13,6 +13,14 @@ module ArraysExtensions = let dst = Array.zeroCreate this.Length q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) + member this.Free(q: MailboxProcessor<_>) = q.Post <| Msg.CreateFreeMsg this + + member this.ToHostAndFree(q: MailboxProcessor<_>) = + let result = this.ToHost q + this.Free q + + result + member this.Size = this.Length type 'a ``[]`` with diff --git a/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs b/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs index 29459997..9ddb90d7 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs @@ -27,3 +27,12 @@ module PreparePositions = allValuesBuffer.[index] <- v rawPositionsBuffer.[index] <- 1 | None -> rawPositionsBuffer.[index] <- 0 @> + + let getUniqueBitmapLocal<'a when 'a : equality> = + <@ fun (array: 'a []) length lid (result: int []) -> + if lid < length then + let isFirst = lid = 0 + let isUnique = lid > 0 && array.[lid] <> array.[lid - 1] + + if isFirst || isUnique then result.[lid] <- 1 else result.[lid] <- 0 @> + diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs new file mode 100644 index 00000000..a0d6f45b --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -0,0 +1,80 @@ +namespace GraphBLAS.FSharp.Backend.Quotes + +open Brahma.FSharp + +module Search = + module Bin = + let byKey<'a> = + <@ fun lenght sourceIndex (indices: ClArray) (values: ClArray<'a>) -> + + let mutable leftEdge = 0 + let mutable rightEdge = lenght - 1 + + let mutable result = None + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let currentIndex = indices.[middleIdx] + + if sourceIndex = currentIndex then + result <- Some values.[middleIdx] + + rightEdge <- -1 // TODO() break + elif sourceIndex < currentIndex then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + + let byKey2<'a> = + <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> + + let mutable leftEdge = 0 + let mutable rightEdge = lenght - 1 + + let mutable result = None + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentIndex: uint64 = + ((uint64 rowIndices.[middleIdx]) <<< 32) + ||| (uint64 columnIndices.[middleIdx]) + + if sourceIndex = currentIndex then + result <- Some values.[middleIdx] + + rightEdge <- -1 // TODO() break + elif sourceIndex < currentIndex then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + + /// + /// Find lower position of item in array. + /// + let lowerPosition<'a when 'a : equality and 'a: comparison> = + <@ fun lenght sourceItem (keys: 'a []) -> + + let mutable leftEdge = 0 + let mutable rightEdge = lenght - 1 + let mutable resultPosition = None + + while leftEdge <= rightEdge do + let currentPosition = (leftEdge + rightEdge) / 2 + let currentKey = keys.[currentPosition] + + if sourceItem = currentKey then + // remember positions and move left + resultPosition <- Some currentPosition + + rightEdge <- currentPosition - 1 + elif sourceItem < currentKey then + rightEdge <- currentPosition - 1 + else + leftEdge <- currentPosition + 1 + + resultPosition @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs index c4ed9ec2..3aa5c894 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs @@ -4,7 +4,7 @@ open Brahma.FSharp module SubSum = let private treeAccess<'a> opAdd = - <@ fun step lid wgSize (localBuffer: 'a []) -> + <@ fun step lid _ (localBuffer: 'a []) -> let i = step * (lid + 1) - 1 let firstValue = localBuffer.[i - (step >>> 1)] @@ -35,3 +35,21 @@ module SubSum = sumGeneral<'a> <| sequentialAccess<'a> opAdd let treeSum<'a> opAdd = sumGeneral<'a> <| treeAccess<'a> opAdd + + let localPrefixSum opAdd = + <@ fun (lid: int) (workGroupSize: int) (array: 'a []) -> + let mutable offset = 1 + + while offset < workGroupSize do + barrierLocal () + let mutable value = array.[lid] + + if lid >= offset then + value <- (%opAdd) value array.[lid - offset] + + offset <- offset * 2 + + barrierLocal () + array.[lid] <- value @> + + let localIntPrefixSum = localPrefixSum <@ (+) @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs index 8e5eb381..851b28c1 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs @@ -6,31 +6,9 @@ open Microsoft.FSharp.Control open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Quotes module internal Map2 = - let binSearch<'a> = - <@ fun lenght sourceIndex (indices: ClArray) (values: ClArray<'a>) -> - - let mutable leftEdge = 0 - let mutable rightEdge = lenght - 1 - - let mutable result = None - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let currentIndex = indices.[middleIdx] - - if sourceIndex = currentIndex then - result <- Some values.[middleIdx] - - rightEdge <- -1 // TODO() break - elif sourceIndex < currentIndex then - rightEdge <- middleIdx - 1 - else - leftEdge <- middleIdx + 1 - - result @> - let private preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = @@ -41,10 +19,10 @@ module internal Map2 = if gid < length then let (leftValue: 'a option) = - (%binSearch) leftValuesLength gid leftIndices leftValues + (%Search.Bin.byKey) leftValuesLength gid leftIndices leftValues let (rightValue: 'b option) = - (%binSearch) rightValuesLength gid rightIndices rightValues + (%Search.Bin.byKey) rightValuesLength gid rightIndices rightValues match (%op) leftValue rightValue with | Some value -> @@ -141,10 +119,10 @@ module internal Map2 = if gid < length then let (leftValue: 'a option) = - (%binSearch) leftValuesLength gid leftIndices leftValues + (%Search.Bin.byKey) leftValuesLength gid leftIndices leftValues let (rightValue: 'b option) = - (%binSearch) rightValuesLength gid rightIndices rightValues + (%Search.Bin.byKey) rightValuesLength gid rightIndices rightValues match (%op) leftValue rightValue value with | Some value -> diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Reduce.fs rename to tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs new file mode 100644 index 00000000..8cdcb251 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -0,0 +1,35 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.ReduceByKey + +open GraphBLAS.FSharp.Tests +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let checkResult (arrayAndKeys: (int * 'a) []) = + let keys, values = + Array.sortBy fst arrayAndKeys + |> Array.unzip + + + () + +let makeTest reduce (arrayAndKeys: (int * 'a) []) = + let keys, values = + Array.sortBy fst arrayAndKeys + |> Array.unzip + + if keys.Length > 0 then + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + + reduce processor clKeys + + + () diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sum.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Sum.fs rename to tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 14bbf3ff..7d2534bd 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -18,8 +18,6 @@ - - @@ -28,6 +26,9 @@ + + + From c89e1b91037721aff7ee19a4b72e6cb5eb8fd191 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Thu, 23 Mar 2023 21:18:46 +0300 Subject: [PATCH 016/143] add: CSR.map2 --- .../GraphBLAS-sharp.Backend.fsproj | 3 +- .../Matrix/CSRMatrix/Map.fs | 5 +- .../Matrix/CSRMatrix/Map2.fs | 151 ++++++++++++++++++ .../Matrix/CSRMatrix/Matrix.fs | 26 +-- .../Quotes/Arithmetic.fs | 6 +- .../Quotes/BinSearch.fs | 16 ++ tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 15 +- 7 files changed, 182 insertions(+), 40 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 76c665c3..59c03eff 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -26,7 +26,7 @@ - + @@ -40,6 +40,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs index 1ce83e79..c61cf19f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext module internal Map = - let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = + let preparePositions<'a, 'b> (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) -> @@ -38,8 +38,7 @@ module internal Map = resultBitmap.[gid] <- 1 | None -> resultBitmap.[gid] <- 0 @> - let kernel = - clContext.Compile <| preparePositions opAdd + let kernel = clContext.Compile <| preparePositions op fun (processor: MailboxProcessor<_>) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> 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..cc0883d4 --- /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 = + (%BinSearch.searchInRange) leftStartIndex leftLastIndex columnIndex leftColumns leftValues + + let rightValue = + (%BinSearch.searchInRange) 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 a5bf0cb2..d9c96445 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -92,31 +92,7 @@ module Matrix = let map = CSR.Map.run - 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 - - 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/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index da8730d7..d71dd456 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -3,13 +3,13 @@ open GraphBLAS.FSharp.Backend.Objects module ArithmeticOperations = - let inline mkOpWithConst zero op constant = + let inline mkUnaryOp zero unaryOp = <@ fun x -> let mutable res = zero match x with - | Some v -> res <- (op v constant) - | None -> res <- constant + | Some v -> res <- (%unaryOp) v + | None -> res <- (%unaryOp) zero if res = zero then None else Some res @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs index 4bde7c67..2dcf421f 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs @@ -3,6 +3,15 @@ open Brahma.FSharp module BinSearch = + /// + /// 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 searchInRange<'a> = <@ fun leftEdge rightEdge sourceIndex (indices: ClArray) (values: ClArray<'a>) -> @@ -27,6 +36,13 @@ module BinSearch = result @> + /// + /// Searches matrix in COO format for a value, using a binary search algorithm. + /// In case there is a value at the given position, it is returned. + /// + /// + /// Position is uint64 and it should be written in such format: first 32 bits is row, second 32 bits is column. + /// let searchCOO<'a> = <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index 0b45b6dd..659bf888 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -102,8 +102,7 @@ let createTestMap case (zero: 'a) op isEqual opQ map = |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") let testFixturesMapNot case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue + [ let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) createTestMap case false not (=) ArithmeticOperations.notQ Matrix.map ] @@ -117,13 +116,13 @@ let testFixturesMapAdd case = q.Error.Add(fun e -> failwithf "%A" e) let addFloat64Q = - ArithmeticOperations.mkOpWithConst 0.0 (+) 10.0 + ArithmeticOperations.mkUnaryOp 0.0 <@ fun x -> x + 10.0 @> let addFloat32Q = - ArithmeticOperations.mkOpWithConst 0.0f (+) 10.0f + ArithmeticOperations.mkUnaryOp 0.0f <@ fun x -> x + 10.0f @> let addByte = - ArithmeticOperations.mkOpWithConst 0uy (+) 10uy + ArithmeticOperations.mkUnaryOp 0uy <@ fun x -> x + 10uy @> if Utils.isFloat64Available context.ClDevice then createTestMap case 0.0 ((+) 10.0) Utils.floatIsEqual addFloat64Q Matrix.map @@ -140,13 +139,13 @@ let testFixturesMapMul case = q.Error.Add(fun e -> failwithf "%A" e) let mulFloat64Q = - ArithmeticOperations.mkOpWithConst 0.0 (*) 10.0 + ArithmeticOperations.mkUnaryOp 0.0 <@ fun x -> x * 10.0 @> let mulFloat32Q = - ArithmeticOperations.mkOpWithConst 0.0f (*) 10.0f + ArithmeticOperations.mkUnaryOp 0.0f <@ fun x -> x * 10.0f @> let mulByte = - ArithmeticOperations.mkOpWithConst 0uy (*) 10uy + ArithmeticOperations.mkUnaryOp 0uy <@ fun x -> x * 10uy @> if Utils.isFloat64Available context.ClDevice then createTestMap case 0.0 ((*) 10.0) Utils.floatIsEqual mulFloat64Q Matrix.map From f223b97f5d8e6985977f954fa815ec5254c773c2 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Fri, 24 Mar 2023 14:48:00 +0300 Subject: [PATCH 017/143] refactor: Map.tests, float32 generator shift --- .../Quotes/Arithmetic.fs | 12 +++++++ tests/GraphBLAS-sharp.Tests/Generators.fs | 11 ++++--- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 32 +++++-------------- 3 files changed, 27 insertions(+), 28 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index d71dd456..8aa72db5 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -66,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 @@ -89,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 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/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index 659bf888..afa8d5f2 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -115,20 +115,12 @@ let testFixturesMapAdd case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let addFloat64Q = - ArithmeticOperations.mkUnaryOp 0.0 <@ fun x -> x + 10.0 @> - - let addFloat32Q = - ArithmeticOperations.mkUnaryOp 0.0f <@ fun x -> x + 10.0f @> - - let addByte = - ArithmeticOperations.mkUnaryOp 0uy <@ fun x -> x + 10uy @> - if Utils.isFloat64Available context.ClDevice then - createTestMap case 0.0 ((+) 10.0) Utils.floatIsEqual addFloat64Q Matrix.map + createTestMap case 0.0 ((+) 10.0) Utils.floatIsEqual (ArithmeticOperations.addLeftConst 0.0 10.0) Matrix.map + + createTestMap case 0.0f ((+) 10.0f) Utils.float32IsEqual (ArithmeticOperations.addLeftConst 0.0f 10.0f) Matrix.map - createTestMap case 0.0f ((+) 10.0f) Utils.float32IsEqual addFloat32Q Matrix.map - createTestMap case 0uy ((+) 10uy) (=) addByte Matrix.map ] + createTestMap case 0uy ((+) 10uy) (=) (ArithmeticOperations.addLeftConst 0uy 10uy) Matrix.map ] let addTests = operationGPUTests "Backend.Matrix.map add tests" testFixturesMapAdd @@ -138,20 +130,12 @@ let testFixturesMapMul case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let mulFloat64Q = - ArithmeticOperations.mkUnaryOp 0.0 <@ fun x -> x * 10.0 @> - - let mulFloat32Q = - ArithmeticOperations.mkUnaryOp 0.0f <@ fun x -> x * 10.0f @> - - let mulByte = - ArithmeticOperations.mkUnaryOp 0uy <@ fun x -> x * 10uy @> - if Utils.isFloat64Available context.ClDevice then - createTestMap case 0.0 ((*) 10.0) Utils.floatIsEqual mulFloat64Q Matrix.map + createTestMap case 0.0 ((*) 10.0) Utils.floatIsEqual (ArithmeticOperations.mulLeftConst 0.0 10.0) Matrix.map + + createTestMap case 0.0f ((*) 10.0f) Utils.float32IsEqual (ArithmeticOperations.mulLeftConst 0.0f 10.0f) Matrix.map - createTestMap case 0.0f ((*) 10.0f) Utils.float32IsEqual mulFloat32Q Matrix.map - createTestMap case 0uy ((*) 10uy) (=) mulByte Matrix.map ] + createTestMap case 0uy ((*) 10uy) (=) (ArithmeticOperations.mulLeftConst 0uy 10uy) Matrix.map ] let mulTests = operationGPUTests "Backend.Matrix.map mul tests" testFixturesMapMul From 3261d08dd6baac51b204473c117d161aaa109fdf Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 15:03:54 +0300 Subject: [PATCH 018/143] add: reduce by key strategies --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 71 ++++--- .../Quotes/PreparePositions.fs | 4 +- .../Common/Reduce/ReduceByKey.fs | 176 +++++++++++++++++- tests/GraphBLAS-sharp.Tests/Helpers.fs | 44 ++++- tests/GraphBLAS-sharp.Tests/Program.fs | 119 ++++++------ 5 files changed, 303 insertions(+), 111 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 40ab0e44..2a1130b7 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -247,8 +247,8 @@ module Reduce = let gid = ndRange.GlobalID0 if gid = 0 then - let mutable currentKey = keys.[gid] - let mutable segmentResult = values.[gid] + let mutable currentKey = keys.[0] + let mutable segmentResult = values.[0] let mutable segmentCount = 0 for i in 1 .. length - 1 do @@ -277,51 +277,39 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength keys values reducedValues reducedKeys)) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + reducedKeys, reducedValues + let segmentSequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = let kernel = - <@ fun (ndRange: Range1D) uniqueKeyCount (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> let gid = ndRange.GlobalID0 if gid < uniqueKeyCount then let startPosition = offsets.[gid] - let sourceKey = keys.[startPosition] - let mutable nextPosition = startPosition + 1 // TODO() - let mutable nextKey = keys.[nextPosition] + let sourceKey = keys.[startPosition] let mutable sum = values.[startPosition] - while nextKey = sourceKey do - sum <- (%reduceOp) sum values.[nextPosition] + let mutable currentPosition = startPosition + 1 + + while currentPosition < keysLength + && sourceKey = keys.[currentPosition] do - nextPosition <- nextPosition + 1 - nextKey <- keys.[nextPosition] + sum <- (%reduceOp) sum values.[currentPosition] + currentPosition <- currentPosition + 1 reducedValues.[gid] <- sum reducedKeys.[gid] <- sourceKey @> let kernel = clContext.Compile kernel - let getUniqueBitmap = ClArray.getUniqueBitmap clContext workGroupSize - - let prefixSum = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize - - let removeDuplicates = ClArray.removeDuplications clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a>) -> - - let bitmap = getUniqueBitmap processor DeviceOnly keys - - let resultLength = (prefixSum processor bitmap 0).ToHostAndFree processor - - let offsets = removeDuplicates processor bitmap - - bitmap.Free processor + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -331,10 +319,12 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength offsets keys values reducedValues reducedKeys)) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength keys.Length offsets keys values reducedValues reducedKeys)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + reducedKeys, reducedValues + let oneWorkGroupSegments (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = let kernel = @@ -343,40 +333,39 @@ module Reduce = let lid = ndRange.GlobalID0 // load values to local memory (may be without it) - let localValues = localArray<'a> length + let localValues = localArray<'a> workGroupSize if lid < length then localValues.[lid] <- values.[lid] // load keys to local memory (mb without it) - let localKeys = localArray length + let localKeys = localArray workGroupSize if lid < length then localKeys.[lid] <- keys.[lid] // get unique keys bitmap - let localBitmap = localArray length - (%PreparePositions.getUniqueBitmapLocal) localKeys length lid localBitmap + let localBitmap = localArray workGroupSize + localBitmap.[lid] <- 0 + (%PreparePositions.getUniqueBitmapLocal) localKeys workGroupSize lid localBitmap // get positions from bitmap by prefix sum // ??? get bitmap by prefix sum in another kernel ??? + // ??? we can restrict prefix sum for 0 .. length ??? (%SubSum.localIntPrefixSum) lid workGroupSize localBitmap - let localPositions = localBitmap - let uniqueKeysCount = localPositions.[length - 1] + let uniqueKeysCount = localBitmap.[length - 1] if lid < uniqueKeysCount then let itemKeyId = lid + 1 - // we can count start position by itemKeyId - // but loose coalesced memory read pattern let startKeyIndex = - (%Search.Bin.lowerPosition) length itemKeyId localPositions + (%Search.Bin.lowerPosition) length itemKeyId localBitmap match startKeyIndex with | Some startPosition -> - let sourcePosition = localPositions.[startPosition] + let sourceKeyPosition = localBitmap.[startPosition] let mutable currentSum = localValues.[startPosition] let mutable currentIndex = startPosition + 1 while currentIndex < length - && localPositions.[currentIndex] = sourcePosition do + && localBitmap.[currentIndex] = sourceKeyPosition do currentSum <- (%reduceOp) currentSum localValues.[currentIndex] currentIndex <- currentIndex + 1 @@ -388,6 +377,7 @@ module Reduce = let kernel = clContext.Compile kernel fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> + if keys.Length > workGroupSize then failwith "The length of the value should not exceed the size of the workgroup" let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -397,6 +387,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength keys values reducedValues reducedKeys)) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + reducedKeys, reducedValues + diff --git a/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs b/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs index 9ddb90d7..33bcec1d 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs @@ -32,7 +32,9 @@ module PreparePositions = <@ fun (array: 'a []) length lid (result: int []) -> if lid < length then let isFirst = lid = 0 - let isUnique = lid > 0 && array.[lid] <> array.[lid - 1] + + let isNotEqualToPrev = array.[lid] <> array.[lid - 1] + let isUnique = lid > 0 && isNotEqualToPrev if isFirst || isUnique then result.[lid] <- 1 else result.[lid] <- 0 @> diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 8cdcb251..e0d13aac 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -1,22 +1,29 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.ReduceByKey +module GraphBLAS.FSharp.Tests.Backend.Common.ReduceByKey +open Expecto +open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests -open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects.ClContext +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let checkResult (arrayAndKeys: (int * 'a) []) = - let keys, values = - Array.sortBy fst arrayAndKeys - |> Array.unzip +let config = Utils.defaultConfig + +let checkResult isEqual actualKeys actualValues keys values reduceOp = + let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp - () + "Keys must be the same" + |> Utils.compareArrays (=) actualKeys expectedKeys -let makeTest reduce (arrayAndKeys: (int * 'a) []) = + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + +let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let keys, values = Array.sortBy fst arrayAndKeys |> Array.unzip @@ -28,8 +35,157 @@ let makeTest reduce (arrayAndKeys: (int * 'a) []) = let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + let resultLength = Array.length <| Array.distinct keys + + let clActualKeys, clActualValues: ClArray * ClArray<'a> + = reduce processor HostInterop resultLength clKeys clValues + + clValues.Free processor + clKeys.Free processor + + let actualValues = clActualValues.ToHostAndFree processor + let actualKeys = clActualKeys.ToHostAndFree processor + + checkResult isEqual actualKeys actualValues keys values reduceOp + +let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + + let reduce = + Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ + + makeTest isEqual reduce reduceOp + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let sequentialTest = + let addTests = + testList + "add tests" + [ createTestSequential (=) (+) <@ (+) @> + createTestSequential (=) (+) <@ (+) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequential Utils.floatIsEqual (+) <@ (+) @> + + createTestSequential Utils.float32IsEqual (+) <@ (+) @> + createTestSequential (=) (||) <@ (||) @> ] + + let mulTests = + testList + "mul tests" + [ createTestSequential (=) (*) <@ (*) @> + createTestSequential (=) (*) <@ (*) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequential Utils.floatIsEqual (*) <@ (*) @> + + createTestSequential Utils.float32IsEqual (*) <@ (*) @> + createTestSequential (=) (&&) <@ (&&) @> ] + + testList "Sequential" [addTests; mulTests] + +let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ + + makeTest isEqual reduce reduceOp + |> testPropertyWithConfig { config with endSize = Utils.defaultWorkGroupSize } $"test on {typeof<'a>}" + +let oneWorkGroupTest = + let addTests = + testList + "add tests" + [ createTestOneWorkGroup (=) (+) <@ (+) @> + createTestOneWorkGroup (=) (+) <@ (+) @> + + if Utils.isFloat64Available context.ClDevice then + createTestOneWorkGroup Utils.floatIsEqual (+) <@ (+) @> + + createTestOneWorkGroup Utils.float32IsEqual (+) <@ (+) @> + createTestOneWorkGroup (=) (||) <@ (||) @> ] + + let mulTests = + testList + "mul tests" + [ createTestOneWorkGroup (=) (*) <@ (*) @> + createTestOneWorkGroup (=) (*) <@ (*) @> + + if Utils.isFloat64Available context.ClDevice then + createTestOneWorkGroup Utils.floatIsEqual (*) <@ (*) @> + + createTestOneWorkGroup Utils.float32IsEqual (*) <@ (*) @> + createTestOneWorkGroup (=) (&&) <@ (&&) @> ] + + testList "One work group" [addTests; mulTests] + +let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a) []) = + + let valuesAndKeys = Array.sortBy fst valuesAndKeys + + if valuesAndKeys.Length > 0 then + let offsets = + Array.map fst valuesAndKeys + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions + + let resultLength = offsets.Length + + let keys, values = Array.unzip valuesAndKeys + + let clOffsets = context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clReducedKeys, clReducedValues: ClArray * ClArray<'a> = + reduce processor DeviceOnly resultLength clOffsets clKeys clValues + + let reducedKeys = clReducedKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor + + checkResult isEqual reducedKeys reducedValues keys values reduceOp + + +let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + + makeTestSequentialSegments isEqual reduce reduceOp + |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" + +let sequentialSegmentTests = + let addTests = + testList + "add tests" + [ createTestSequentialSegments (=) (+) <@ (+) @> + createTestSequentialSegments (=) (+) <@ (+) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments Utils.floatIsEqual (+) <@ (+) @> + + createTestSequentialSegments Utils.float32IsEqual (+) <@ (+) @> + createTestSequentialSegments (=) (||) <@ (||) @> ] + + let mulTests = + testList + "mul tests" + [ createTestSequentialSegments (=) (*) <@ (*) @> + createTestSequentialSegments (=) (*) <@ (*) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments Utils.floatIsEqual (*) <@ (*) @> + + createTestSequentialSegments Utils.float32IsEqual (*) <@ (*) @> + createTestSequentialSegments (=) (&&) <@ (&&) @> ] + + testList "Sequential segments" [addTests; mulTests] + + + + + - reduce processor clKeys - () diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index de3b71e6..5d955de9 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -96,7 +96,7 @@ module Utils = for i in 0 .. actual.Length - 1 do if not (areEqual actual.[i] expected.[i]) then $"%s{message}. Arrays differ at position %A{i} of %A{actual.Length - 1}. - Actual value is %A{actual.[i]}, expected %A{expected.[i]}" + Actual value is %A{actual.[i]}, expected %A{expected.[i]}, \n actual: %A{actual} \n expected: %A{expected}" |> failtestf "%s" let compare2DArrays areEqual (actual: 'a [,]) (expected: 'a [,]) message = @@ -140,6 +140,48 @@ module Utils = result +module HostPrimitives = + let prefixSumInclude array = + Array.scan (+) 0 array + |> fun scanned -> scanned.[1 ..] + + let prefixSumExclude sourceArray = + prefixSumInclude sourceArray + |> Array.insertAt 0 0 + |> fun array -> + Array.take sourceArray.Length array, Array.last array + + let getUniqueBitmapLastOccurrence array = + Array.pairwise array + |> fun pairs -> + Array.init array.Length (fun index -> + if index = array.Length - 1 || fst pairs.[index] <> snd pairs.[index] then 1 else 0) + + let getUniqueBitmapFirstOccurrence (sourceArray: _ []) = + let resultArray = Array.zeroCreate sourceArray.Length + + for i in 0 .. sourceArray.Length - 1 do + if i = 0 || sourceArray.[i] <> sourceArray.[i - 1] then + resultArray.[i] <- 1 + + resultArray + + let getBitPositions bitmap = + bitmap + |> Array.mapi (fun index bit -> if bit = 1 then Some index else None ) + |> Array.choose id + + let reduceByKey keys value reduceOp = + let zipped = Array.zip keys value + + Array.distinct keys + |> Array.map (fun key -> + // extract elements corresponding to key + (key, Array.map snd <| Array.filter ((=) key << fst) zipped)) + // reduce elements + |> Array.map (fun (key, values) -> key, Array.reduce reduceOp values) + |> Array.unzip + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 2514a8ff..3b664920 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,71 +1,70 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Mxm.tests - Matrix.Transpose.tests ] - |> testSequenced - -let commonTests = - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.PrefixSum.tests - Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests ] - - testList - "Common tests" - [ clArrayTests - Common.BitonicSort.tests - Common.Scatter.tests - Common.Reduce.tests - Common.Sum.tests ] - |> testSequenced - -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Mxm.tests +// Matrix.Transpose.tests ] +// |> testSequenced +// +// let commonTests = +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.PrefixSum.tests +// Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.tests ] +// +// testList +// "Common tests" +// [ clArrayTests +// Common.BitonicSort.tests +// Common.Scatter.tests +// Common.Reduce.tests +// Common.Sum.tests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced [] let allTests = testList "All tests" - [ matrixTests - commonTests - vectorTests - algorithmsTests ] + [ Common.ReduceByKey.sequentialTest + Common.ReduceByKey.sequentialSegmentTests + Common.ReduceByKey.oneWorkGroupTest ] |> testSequenced [] From de5d998bf52c16aa8a443610ea6db51a96a7cf05 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 15:53:05 +0300 Subject: [PATCH 019/143] refactor: namespaces in tests --- tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs | 79 ++--- .../Common/BitonicSort.fs | 107 +++---- .../Common/ClArray/Choose.fs | 65 +++-- .../Common/ClArray/Copy.fs | 67 ++--- .../Common/ClArray/Exists.fs | 81 +++--- .../Common/ClArray/Map.fs | 75 ++--- .../Common/ClArray/Map2.fs | 90 +++--- .../Common/ClArray/PrefixSum.fs | 115 ++++---- .../Common/ClArray/RemoveDuplicates.fs | 95 +++--- .../Common/ClArray/Replicate.fs | 71 ++--- .../Common/Reduce/Reduce.fs | 103 +++---- .../Common/Reduce/ReduceByKey.fs | 243 ++++++++-------- .../Common/Reduce/Sum.fs | 97 ++++--- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 79 ++--- tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs | 193 +++++++------ tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 273 +++++++++--------- tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs | 147 +++++----- .../GraphBLAS-sharp.Tests/Matrix/Transpose.fs | 181 ++++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 127 ++++---- .../QuickGraph/Algorithms/BFS.fs | 2 +- .../Algorithms/ConnectedComponents.fs | 2 +- .../QuickGraph/CreateGraph.fs | 2 +- .../Vector/AssignByMask.fs | 181 ++++++------ tests/GraphBLAS-sharp.Tests/Vector/Convert.fs | 153 +++++----- tests/GraphBLAS-sharp.Tests/Vector/Copy.fs | 109 +++---- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 263 ++++++++--------- tests/GraphBLAS-sharp.Tests/Vector/OfList.fs | 127 ++++---- tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs | 115 ++++---- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 181 ++++++------ .../Vector/ZeroCreate.fs | 95 +++--- 30 files changed, 1776 insertions(+), 1742 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index fa7febfe..52107493 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Algorithms.BFS +namespace GraphBLAS.FSharp.Tests.Backend.Algorithms open Expecto open GraphBLAS.FSharp.Backend @@ -6,60 +6,61 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context -open GraphBLAS.FSharp.Tests.QuickGraph.Algorithms -open GraphBLAS.FSharp.Tests.QuickGraph.CreateGraph +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.CreateGraph open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects -let testFixtures (testContext: TestContext) = - [ let config = Utils.undirectedAlgoConfig - let context = testContext.ClContext - let queue = testContext.Queue - let workGroupSize = Utils.defaultWorkGroupSize +module BFS = + let testFixtures (testContext: TestContext) = + [ let config = Utils.undirectedAlgoConfig + let context = testContext.ClContext + let queue = testContext.Queue + let workGroupSize = Utils.defaultWorkGroupSize - let testName = - sprintf "Test on %A" testContext.ClContext + let testName = + sprintf "Test on %A" testContext.ClContext - let bfs = - Algorithms.BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul workGroupSize + let bfs = + Algorithms.BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul workGroupSize - testPropertyWithConfig config testName - <| fun (matrix: int [,]) -> + testPropertyWithConfig config testName + <| fun (matrix: int [,]) -> - let graph = undirectedFromArray2D matrix 0 + let graph = undirectedFromArray2D matrix 0 - let largestComponent = - ConnectedComponents.largestComponent graph + let largestComponent = + ConnectedComponents.largestComponent graph - if largestComponent.Length > 0 then - let source = largestComponent.[0] + if largestComponent.Length > 0 then + let source = largestComponent.[0] - let expected = - (snd (BFS.runUndirected graph source)) - |> Utils.createArrayFromDictionary (Array2D.length1 matrix) 0 + let expected = + (snd (BFS.runUndirected graph source)) + |> Utils.createArrayFromDictionary (Array2D.length1 matrix) 0 - let matrixHost = - Utils.createMatrixFromArray2D CSR matrix ((=) 0) + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0) - let matrix = matrixHost.ToDevice context + let matrix = matrixHost.ToDevice context - match matrix with - | ClMatrix.CSR mtx -> - let res = bfs queue mtx source |> ClVector.Dense + match matrix with + | ClMatrix.CSR mtx -> + let res = bfs queue mtx source |> ClVector.Dense - let resHost = res.ToHost queue + let resHost = res.ToHost queue - (mtx :> IDeviceMemObject).Dispose queue - res.Dispose queue + (mtx :> IDeviceMemObject).Dispose queue + res.Dispose queue - match resHost with - | Vector.Dense resHost -> - let actual = resHost |> Utils.unwrapOptionArray 0 + match resHost with + | Vector.Dense resHost -> + let actual = resHost |> Utils.unwrapOptionArray 0 - Expect.sequenceEqual actual expected "Sequences must be equal" - | _ -> failwith "Not implemented" - | _ -> failwith "Not implemented" ] + Expect.sequenceEqual actual expected "Sequences must be equal" + | _ -> failwith "Not implemented" + | _ -> failwith "Not implemented" ] -let tests = - TestCases.gpuTests "Bfs tests" testFixtures + let tests = + TestCases.gpuTests "Bfs tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs b/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs index 99f54495..f5e5c3a4 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.BitonicSort +namespace GraphBLAS.FSharp.Tests.Backend.Common open Expecto open Expecto.Logging @@ -8,78 +8,79 @@ open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context -let logger = Log.create "BitonicSort.Tests" +module BitonicSort = + let logger = Log.create "BitonicSort.Tests" -let context = defaultContext.ClContext + let context = defaultContext.ClContext -let config = - { Utils.defaultConfig with - endSize = 1000000 } + let config = + { Utils.defaultConfig with + endSize = 1000000 } -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let q = defaultContext.Queue + let q = defaultContext.Queue -let makeTest sort (array: ('n * 'n * 'a) []) = - if array.Length > 0 then - let projection (row: 'n) (col: 'n) (_: 'a) = row, col + let makeTest sort (array: ('n * 'n * 'a) []) = + if array.Length > 0 then + let projection (row: 'n) (col: 'n) (_: 'a) = row, col - logger.debug ( - eventX "Initial size is {size}" - >> setField "size" $"%A{array.Length}" - ) + logger.debug ( + eventX "Initial size is {size}" + >> setField "size" $"%A{array.Length}" + ) - let rows, cols, vals = Array.unzip3 array + let rows, cols, vals = Array.unzip3 array - use clRows = context.CreateClArray rows - use clColumns = context.CreateClArray cols - use clValues = context.CreateClArray vals + use clRows = context.CreateClArray rows + use clColumns = context.CreateClArray cols + use clValues = context.CreateClArray vals - let actualRows, actualCols, actualValues = - sort q clRows clColumns clValues + let actualRows, actualCols, actualValues = + sort q clRows clColumns clValues - let rows = Array.zeroCreate<'n> clRows.Length - let columns = Array.zeroCreate<'n> clColumns.Length - let values = Array.zeroCreate<'a> clValues.Length + let rows = Array.zeroCreate<'n> clRows.Length + let columns = Array.zeroCreate<'n> clColumns.Length + let values = Array.zeroCreate<'a> clValues.Length - q.Post(Msg.CreateToHostMsg(clRows, rows)) - q.Post(Msg.CreateToHostMsg(clColumns, columns)) + q.Post(Msg.CreateToHostMsg(clRows, rows)) + q.Post(Msg.CreateToHostMsg(clColumns, columns)) - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) + |> ignore - rows, columns, values + rows, columns, values - let expectedRows, expectedCols, expectedValues = - (rows, cols, vals) - |||> Array.zip3 - |> Array.sortBy ((<|||) projection) - |> Array.unzip3 + let expectedRows, expectedCols, expectedValues = + (rows, cols, vals) + |||> Array.zip3 + |> Array.sortBy ((<|||) projection) + |> Array.unzip3 - $"Row arrays should be equal. Actual is \n%A{actualRows}, expected \n%A{expectedRows}, input is \n%A{rows}" - |> Utils.compareArrays (=) actualRows expectedRows + $"Row arrays should be equal. Actual is \n%A{actualRows}, expected \n%A{expectedRows}, input is \n%A{rows}" + |> Utils.compareArrays (=) actualRows expectedRows - $"Column arrays should be equal. Actual is \n%A{actualCols}, expected \n%A{expectedCols}, input is \n%A{cols}" - |> Utils.compareArrays (=) actualCols expectedCols + $"Column arrays should be equal. Actual is \n%A{actualCols}, expected \n%A{expectedCols}, input is \n%A{cols}" + |> Utils.compareArrays (=) actualCols expectedCols - $"Value arrays should be equal. Actual is \n%A{actualValues}, expected \n%A{expectedValues}, input is \n%A{vals}" - |> Utils.compareArrays (=) actualValues expectedValues + $"Value arrays should be equal. Actual is \n%A{actualValues}, expected \n%A{expectedValues}, input is \n%A{vals}" + |> Utils.compareArrays (=) actualValues expectedValues -let testFixtures<'a when 'a: equality> = - BitonicSort.sortKeyValuesInplace context wgSize - |> makeTest - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" + let testFixtures<'a when 'a: equality> = + BitonicSort.sortKeyValuesInplace context wgSize + |> makeTest + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" -let tests = - q.Error.Add(fun e -> failwithf "%A" e) + let tests = + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures + [ testFixtures - if Utils.isFloat64Available context.ClDevice then - testFixtures + if Utils.isFloat64Available context.ClDevice then + testFixtures - testFixtures + testFixtures - testFixtures - testFixtures ] - |> testList "Backend.Common.BitonicSort tests" + testFixtures + testFixtures ] + |> testList "Backend.Common.BitonicSort tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index 628ff51a..c59e8154 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Choose +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open GraphBLAS.FSharp.Backend.Common open Expecto @@ -8,50 +8,51 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes -let workGroupSize = Utils.defaultWorkGroupSize +module Choose = + let workGroupSize = Utils.defaultWorkGroupSize -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = - if array.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue + let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = + if array.Length > 0 then + let context = testContext.ClContext + let q = testContext.Queue - let clArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) + let clArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) - let (clResult: ClArray<'b>) = choose q HostInterop clArray + let (clResult: ClArray<'b>) = choose q HostInterop clArray - let hostResult = Array.zeroCreate clResult.Length + let hostResult = Array.zeroCreate clResult.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, hostResult, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, hostResult, ch)) + |> ignore - let expectedResult = Array.choose mapFun array + let expectedResult = Array.choose mapFun array - "Result should be the same" - |> Utils.compareArrays isEqual hostResult expectedResult + "Result should be the same" + |> Utils.compareArrays isEqual hostResult expectedResult -let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = - let context = testContext.ClContext + let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = + let context = testContext.ClContext - let choose = - ClArray.choose context workGroupSize mapFunQ + let choose = + ClArray.choose context workGroupSize mapFunQ - makeTest<'a, 'b> testContext choose mapFun isEqual - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>} -> %A{typeof<'b>}" + makeTest<'a, 'b> testContext choose mapFun isEqual + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>} -> %A{typeof<'b>}" -let testFixtures testContext = - let device = testContext.ClContext.ClDevice + let testFixtures testContext = + let device = testContext.ClContext.ClDevice - [ createTest testContext id Map.id (=) - createTest testContext id Map.id (=) - createTest testContext id Map.id (=) + [ createTest testContext id Map.id (=) + createTest testContext id Map.id (=) + createTest testContext id Map.id (=) - if Utils.isFloat64Available device then - createTest testContext id Map.id Utils.floatIsEqual + if Utils.isFloat64Available device then + createTest testContext id Map.id Utils.floatIsEqual - createTest testContext id Map.id Utils.float32IsEqual ] + createTest testContext id Map.id Utils.float32IsEqual ] -let tests = - TestCases.gpuTests "ClArray.choose id tests" testFixtures + let tests = + TestCases.gpuTests "ClArray.choose id tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs index dcf4ed83..5abd811b 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Copy +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open Expecto open Expecto.Logging @@ -8,50 +8,51 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "ClArray.Copy.Tests" +module Copy = + let logger = Log.create "ClArray.Copy.Tests" -let context = Context.defaultContext.ClContext + let context = Context.defaultContext.ClContext -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let q = Context.defaultContext.Queue + let q = Context.defaultContext.Queue -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = - if array.Length > 0 then - use clArray = context.CreateClArray array + let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = + if array.Length > 0 then + use clArray = context.CreateClArray array - let actual = - use clActual: ClArray<'a> = copyFun q HostInterop clArray + let actual = + use clActual: ClArray<'a> = copyFun q HostInterop clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = Array.zeroCreate clActual.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - "Array should be equals to original" - |> Expect.sequenceEqual actual array + "Array should be equals to original" + |> Expect.sequenceEqual actual array -let creatTest<'a when 'a: equality> = - ClArray.copy context wgSize - |> makeTest<'a> - |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" + let creatTest<'a when 'a: equality> = + ClArray.copy context wgSize + |> makeTest<'a> + |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" -let testCases = - q.Error.Add(fun e -> failwithf "%A" e) + let testCases = + q.Error.Add(fun e -> failwithf "%A" e) - [ creatTest - creatTest + [ creatTest + creatTest - if Utils.isFloat64Available context.ClDevice then - creatTest + if Utils.isFloat64Available context.ClDevice then + creatTest - creatTest - creatTest ] + creatTest + creatTest ] -let tests = - testCases |> testList "ClArray.copy tests" + let tests = + testCases |> testList "ClArray.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs index dbbb3415..94355b78 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Exists +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open Expecto open Expecto.Logging @@ -9,61 +9,62 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Quotes -let logger = - Log.create "ClArray.containsNonZero.Tests" +module Exists = + let logger = + Log.create "ClArray.containsNonZero.Tests" -let context = defaultContext.ClContext + let context = defaultContext.ClContext -let q = defaultContext.Queue + let q = defaultContext.Queue -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (array: 'a []) = + let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (array: 'a []) = - if array.Length > 0 then - let vector = - Utils.createVectorFromArray Dense array isZero + if array.Length > 0 then + let vector = + Utils.createVectorFromArray Dense array isZero - let result = - match vector.ToDevice context with - | ClVector.Dense clArray -> - let resultCell = exists q clArray - let result = Array.zeroCreate 1 + let result = + match vector.ToDevice context with + | ClVector.Dense clArray -> + let resultCell = exists q clArray + let result = Array.zeroCreate 1 - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) + let res = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - q.Post(Msg.CreateFreeMsg<_>(resultCell)) + q.Post(Msg.CreateFreeMsg<_>(resultCell)) - res.[0] + res.[0] - | _ -> failwith "Unsupported vector format" + | _ -> failwith "Unsupported vector format" - $"The results should be the same, vector : {vector}" - |> Expect.equal result (Array.exists (not << isZero) array) + $"The results should be the same, vector : {vector}" + |> Expect.equal result (Array.exists (not << isZero) array) -let createTest<'a when 'a: struct and 'a: equality> isEqual zero = - let exists = - ClArray.exists context wgSize Predicates.isSome + let createTest<'a when 'a: struct and 'a: equality> isEqual zero = + let exists = + ClArray.exists context wgSize Predicates.isSome - [ correctnessGenericTest<'a> (isEqual zero) exists - |> testPropertyWithConfig config "FSCheck data" + [ correctnessGenericTest<'a> (isEqual zero) exists + |> testPropertyWithConfig config "FSCheck data" - correctnessGenericTest<'a> (isEqual zero) exists (Array.create 1000 zero) - |> testPropertyWithConfig config "Zeros" ] - |> testList $"Correctness on %A{typeof<'a>}" + correctnessGenericTest<'a> (isEqual zero) exists (Array.create 1000 zero) + |> testPropertyWithConfig config "Zeros" ] + |> testList $"Correctness on %A{typeof<'a>}" -let testFixtures = - [ createTest (=) 0 - createTest (=) 0uy + let testFixtures = + [ createTest (=) 0 + createTest (=) 0uy - if Utils.isFloat64Available context.ClDevice then - createTest Utils.floatIsEqual 0.0 + if Utils.isFloat64Available context.ClDevice then + createTest Utils.floatIsEqual 0.0 - createTest Utils.float32IsEqual 0.0f - createTest (=) false ] + createTest Utils.float32IsEqual 0.0f + createTest (=) false ] -let tests = - testList "Common.ClArray.exists tests" testFixtures + let tests = + testList "Common.ClArray.exists tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs index be501e41..766b1465 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Map +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open Brahma.FSharp open GraphBLAS.FSharp.Tests @@ -8,57 +8,58 @@ open GraphBLAS.FSharp.Backend.Quotes open Expecto open GraphBLAS.FSharp.Backend.Objects.ClContext -let context = defaultContext.Queue +module Map = + let context = defaultContext.Queue -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let mapOptionToValue zero = - function - | Some value -> value - | None -> zero + let mapOptionToValue zero = + function + | Some value -> value + | None -> zero -let makeTest (testContext: TestContext) mapFun zero isEqual (array: 'a option []) = - if array.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue + let makeTest (testContext: TestContext) mapFun zero isEqual (array: 'a option []) = + if array.Length > 0 then + let context = testContext.ClContext + let q = testContext.Queue - let clArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) + let clArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) - let (actualDevice: ClArray<_>) = mapFun q HostInterop clArray + let (actualDevice: ClArray<_>) = mapFun q HostInterop clArray - let actualHost = Array.zeroCreate actualDevice.Length + let actualHost = Array.zeroCreate actualDevice.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) + |> ignore - let expected = Array.map (mapOptionToValue zero) array + let expected = Array.map (mapOptionToValue zero) array - "Arrays must be the same" - |> Utils.compareArrays isEqual actualHost expected + "Arrays must be the same" + |> Utils.compareArrays isEqual actualHost expected -let createTest<'a when 'a: equality> (testContext: TestContext) (zero: 'a) isEqual = + let createTest<'a when 'a: equality> (testContext: TestContext) (zero: 'a) isEqual = - let context = testContext.ClContext + let context = testContext.ClContext - let map = - ClArray.map context wgSize - <| Map.optionToValueOrZero zero + let map = + ClArray.map context wgSize + <| Map.optionToValueOrZero zero - makeTest testContext map zero isEqual - |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" + makeTest testContext map zero isEqual + |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" -let testFixtures (testContext: TestContext) = - [ createTest testContext 0 (=) - createTest testContext false (=) + let testFixtures (testContext: TestContext) = + [ createTest testContext 0 (=) + createTest testContext false (=) - if Utils.isFloat64Available testContext.ClContext.ClDevice then - createTest testContext 0.0 Utils.floatIsEqual + if Utils.isFloat64Available testContext.ClContext.ClDevice then + createTest testContext 0.0 Utils.floatIsEqual - createTest testContext 0.0f Utils.float32IsEqual - createTest testContext 0uy (=) ] + createTest testContext 0.0f Utils.float32IsEqual + createTest testContext 0uy (=) ] -let tests = - TestCases.gpuTests "ClArray.map tests" testFixtures + let tests = + TestCases.gpuTests "ClArray.map tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs index 37c137a3..17ab89c8 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs @@ -1,75 +1,75 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Map2 +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Quotes open Expecto open GraphBLAS.FSharp.Backend.Objects.ClContext -let context = defaultContext.Queue +module Map2 = + let context = defaultContext.Queue -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let makeTest<'a when 'a: equality> testContext clMapFun hostMapFun isEqual (leftArray: 'a [], rightArray: 'a []) = - if leftArray.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue + let makeTest<'a when 'a: equality> testContext clMapFun hostMapFun isEqual (leftArray: 'a [], rightArray: 'a []) = + if leftArray.Length > 0 then + let context = testContext.ClContext + let q = testContext.Queue - let leftClArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftArray) + let leftClArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftArray) - let rightClArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, rightArray) + let rightClArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, rightArray) - let (actualDevice: ClArray<'a>) = - clMapFun q HostInterop leftClArray rightClArray + let (actualDevice: ClArray<'a>) = + clMapFun q HostInterop leftClArray rightClArray - let actualHost = Array.zeroCreate actualDevice.Length + let actualHost = Array.zeroCreate actualDevice.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) + |> ignore - let expected = - Array.map2 hostMapFun leftArray rightArray + let expected = + Array.map2 hostMapFun leftArray rightArray - "Arrays must be the same" - |> Utils.compareArrays isEqual actualHost expected + "Arrays must be the same" + |> Utils.compareArrays isEqual actualHost expected -let createTest<'a when 'a: equality> (testContext: TestContext) isEqual hostMapFun mapFunQ = + let createTest<'a when 'a: equality> (testContext: TestContext) isEqual hostMapFun mapFunQ = - let context = testContext.ClContext + let context = testContext.ClContext - let map = ClArray.map2 context wgSize mapFunQ + let map = ClArray.map2 context wgSize mapFunQ - makeTest<'a> testContext map hostMapFun isEqual - |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" + makeTest<'a> testContext map hostMapFun isEqual + |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" -let testFixturesAdd (testContext: TestContext) = - [ createTest testContext (=) (+) <@ (+) @> - createTest testContext (=) (||) <@ (||) @> + let testFixturesAdd (testContext: TestContext) = + [ createTest testContext (=) (+) <@ (+) @> + createTest testContext (=) (||) <@ (||) @> - if Utils.isFloat64Available testContext.ClContext.ClDevice then - createTest testContext Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available testContext.ClContext.ClDevice then + createTest testContext Utils.floatIsEqual (+) <@ (+) @> - createTest testContext Utils.float32IsEqual (+) <@ (+) @> - createTest testContext (=) (+) <@ (+) @> ] + createTest testContext Utils.float32IsEqual (+) <@ (+) @> + createTest testContext (=) (+) <@ (+) @> ] -let addTests = - TestCases.gpuTests "ClArray.map2 add tests" testFixturesAdd + let addTests = + TestCases.gpuTests "ClArray.map2 add tests" testFixturesAdd -let testFixturesMul (testContext: TestContext) = - [ createTest testContext (=) (*) <@ (*) @> - createTest testContext (=) (&&) <@ (&&) @> + let testFixturesMul (testContext: TestContext) = + [ createTest testContext (=) (*) <@ (*) @> + createTest testContext (=) (&&) <@ (&&) @> - if Utils.isFloat64Available testContext.ClContext.ClDevice then - createTest testContext Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available testContext.ClContext.ClDevice then + createTest testContext Utils.floatIsEqual (*) <@ (*) @> - createTest testContext Utils.float32IsEqual (*) <@ (*) @> - createTest testContext (=) (+) <@ (+) @> ] + createTest testContext Utils.float32IsEqual (*) <@ (*) @> + createTest testContext (=) (+) <@ (+) @> ] -let mulTests = - TestCases.gpuTests "ClArray.map2 multiplication tests" testFixturesMul + let mulTests = + TestCases.gpuTests "ClArray.map2 multiplication tests" testFixturesMul diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs index 18d61544..667c8de6 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.PrefixSum +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open Expecto open Expecto.Logging @@ -9,78 +9,79 @@ open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Objects.ClCell -let logger = Log.create "ClArray.PrefixSum.Tests" +module PrefixSum = + let logger = Log.create "ClArray.PrefixSum.Tests" -let context = defaultContext.ClContext + let context = defaultContext.ClContext -let config = Tests.Utils.defaultConfig + let config = Tests.Utils.defaultConfig -let wgSize = 128 + let wgSize = 128 -let q = defaultContext.Queue + let q = defaultContext.Queue -let makeTest plus zero isEqual scan (array: 'a []) = - if array.Length > 0 then + let makeTest plus zero isEqual scan (array: 'a []) = + if array.Length > 0 then - logger.debug ( - eventX $"Array is %A{array}\n" - >> setField "array" (sprintf "%A" array) - ) + logger.debug ( + eventX $"Array is %A{array}\n" + >> setField "array" (sprintf "%A" array) + ) - let actual, actualSum = - use clArray = context.CreateClArray array - let (total: ClCell<_>) = scan q clArray zero + let actual, actualSum = + use clArray = context.CreateClArray array + let (total: ClCell<_>) = scan q clArray zero - let actual = Array.zeroCreate<'a> clArray.Length - let actualSum = total.ToHostAndFree(q) - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clArray, actual, ch)), actualSum + let actual = Array.zeroCreate<'a> clArray.Length + let actualSum = total.ToHostAndFree(q) + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clArray, actual, ch)), actualSum - logger.debug ( - eventX "Actual is {actual}\n" - >> setField "actual" (sprintf "%A" actual) - ) + logger.debug ( + eventX "Actual is {actual}\n" + >> setField "actual" (sprintf "%A" actual) + ) - let expected, expectedSum = - array - |> Array.mapFold - (fun s t -> - let a = plus s t - a, a) - zero + let expected, expectedSum = + array + |> Array.mapFold + (fun s t -> + let a = plus s t + a, a) + zero - logger.debug ( - eventX "Expected is {expected}\n" - >> setField "expected" (sprintf "%A" expected) - ) + logger.debug ( + eventX "Expected is {expected}\n" + >> setField "expected" (sprintf "%A" expected) + ) - "Total sums should be equal" - |> Expect.equal actualSum expectedSum + "Total sums should be equal" + |> Expect.equal actualSum expectedSum - "Arrays should be the same" - |> Tests.Utils.compareArrays isEqual actual expected + "Arrays should be the same" + |> Tests.Utils.compareArrays isEqual actual expected -let testFixtures plus plusQ zero isEqual name = - ClArray.prefixSumIncludeInplace plusQ context wgSize - |> makeTest plus zero isEqual - |> testPropertyWithConfig config (sprintf "Correctness on %s" name) + let testFixtures plus plusQ zero isEqual name = + ClArray.prefixSumIncludeInplace plusQ context wgSize + |> makeTest plus zero isEqual + |> testPropertyWithConfig config (sprintf "Correctness on %s" name) -let tests = - q.Error.Add(fun e -> failwithf "%A" e) + let tests = + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 (=) "int add" - testFixtures (+) <@ (+) @> 0uy (=) "byte add" - testFixtures max <@ max @> 0 (=) "int max" - testFixtures max <@ max @> 0uy (=) "byte max" - testFixtures min <@ min @> System.Int32.MaxValue (=) "int min" + [ testFixtures (+) <@ (+) @> 0 (=) "int add" + testFixtures (+) <@ (+) @> 0uy (=) "byte add" + testFixtures max <@ max @> 0 (=) "int max" + testFixtures max <@ max @> 0uy (=) "byte max" + testFixtures min <@ min @> System.Int32.MaxValue (=) "int min" - if Tests.Utils.isFloat64Available context.ClDevice then - testFixtures min <@ min @> System.Double.MaxValue (=) "float min" - testFixtures max <@ max @> 0.0 (=) "float max" + if Tests.Utils.isFloat64Available context.ClDevice then + testFixtures min <@ min @> System.Double.MaxValue (=) "float min" + testFixtures max <@ max @> 0.0 (=) "float max" - testFixtures min <@ min @> System.Single.MaxValue (=) "float32 min" - testFixtures max <@ max @> 0.0f (=) "float32 max" + testFixtures min <@ min @> System.Single.MaxValue (=) "float32 min" + testFixtures max <@ max @> 0.0f (=) "float32 max" - testFixtures min <@ min @> System.Byte.MaxValue (=) "byte min" - testFixtures (||) <@ (||) @> false (=) "bool logic-or" - testFixtures (&&) <@ (&&) @> true (=) "bool logic-and" ] - |> testList "Backend.Common.PrefixSum tests" + testFixtures min <@ min @> System.Byte.MaxValue (=) "byte min" + testFixtures (||) <@ (||) @> false (=) "bool logic-or" + testFixtures (&&) <@ (&&) @> true (=) "bool logic-and" ] + |> testList "Backend.Common.PrefixSum tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs index 1f8e3f7d..876426f3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.RemoveDuplicates +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open Expecto open Expecto.Logging @@ -7,67 +7,68 @@ open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Common -let logger = Log.create "RemoveDuplicates.Tests" +module RemoveDuplicates = + let logger = Log.create "RemoveDuplicates.Tests" -let context = Context.defaultContext.ClContext + let context = Context.defaultContext.ClContext -let testCases = - let removeDuplicates_wg_2 = ClArray.removeDuplications context 2 - let removeDuplicates_wg_32 = ClArray.removeDuplications context 32 - let q = Context.defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + let testCases = + let removeDuplicates_wg_2 = ClArray.removeDuplications context 2 + let removeDuplicates_wg_32 = ClArray.removeDuplications context 32 + let q = Context.defaultContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - [ testCase "Simple correctness test" - <| fun () -> - let array = [| 1; 2; 2; 3; 3; 3 |] + [ testCase "Simple correctness test" + <| fun () -> + let array = [| 1; 2; 2; 3; 3; 3 |] - let clArray = context.CreateClArray array - - let actual = - let clActual = removeDuplicates_wg_2 q clArray - - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) - - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - let expected = [| 1; 2; 3 |] - - "Array should be without duplicates" - |> Expect.sequenceEqual actual expected - - testProperty "Correctness test on random int arrays" - <| fun (array: array) -> - let array = Array.sort array - - if array.Length > 0 then let clArray = context.CreateClArray array - let removeDuplicates = - if array.Length % 32 = 0 then - removeDuplicates_wg_32 - else - removeDuplicates_wg_2 - let actual = - let clActual = removeDuplicates q clArray + let clActual = removeDuplicates_wg_2 q clArray let actual = Array.zeroCreate clActual.Length q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) logger.debug ( eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" + >> setField "actual" (sprintf "%A" actual) ) - let expected = Seq.distinct array |> Array.ofSeq + let expected = [| 1; 2; 3 |] "Array should be without duplicates" - |> Expect.sequenceEqual actual expected ] + |> Expect.sequenceEqual actual expected + + testProperty "Correctness test on random int arrays" + <| fun (array: array) -> + let array = Array.sort array + + if array.Length > 0 then + let clArray = context.CreateClArray array + + let removeDuplicates = + if array.Length % 32 = 0 then + removeDuplicates_wg_32 + else + removeDuplicates_wg_2 + + let actual = + let clActual = removeDuplicates q clArray + + let actual = Array.zeroCreate clActual.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) + + let expected = Seq.distinct array |> Array.ofSeq + + "Array should be without duplicates" + |> Expect.sequenceEqual actual expected ] -let tests = - testCases - |> testList "Array.removeDuplicates tests" + let tests = + testCases + |> testList "Array.removeDuplicates tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs index c7067df5..770eb0b6 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Replicate +namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray open Expecto open Expecto.Logging @@ -8,53 +8,54 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Replicate.Tests" +module Replicate = + let logger = Log.create "Replicate.Tests" -let context = Context.defaultContext.ClContext + let context = Context.defaultContext.ClContext -let q = Context.defaultContext.Queue + let q = Context.defaultContext.Queue -let workGroupSize = Utils.defaultWorkGroupSize + let workGroupSize = Utils.defaultWorkGroupSize -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = - if array.Length > 0 && i > 0 then - use clArray = context.CreateClArray array + let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = + if array.Length > 0 && i > 0 then + use clArray = context.CreateClArray array - let actual = - use clActual: ClArray<'a> = replicateFun q HostInterop clArray i + let actual = + use clActual: ClArray<'a> = replicateFun q HostInterop clArray i - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = Array.zeroCreate clActual.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) - logger.debug ( - eventX $"Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX $"Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - let expected = - array |> Array.replicate i |> Array.concat + let expected = + array |> Array.replicate i |> Array.concat - $"Array should contains %i{i} copies of the original one" - |> Expect.sequenceEqual actual expected + $"Array should contains %i{i} copies of the original one" + |> Expect.sequenceEqual actual expected -let createTest<'a when 'a: equality> = - ClArray.replicate context workGroupSize - |> makeTest<'a> - |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" + let createTest<'a when 'a: equality> = + ClArray.replicate context workGroupSize + |> makeTest<'a> + |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" -let testCases = - q.Error.Add(fun e -> failwithf "%A" e) + let testCases = + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest - createTest + [ createTest + createTest - if Utils.isFloat64Available context.ClDevice then - createTest + if Utils.isFloat64Available context.ClDevice then + createTest - createTest - createTest ] + createTest + createTest ] -let tests = - testCases |> testList "ClArray.replicate tests" + let tests = + testCases |> testList "ClArray.replicate tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs index 27ffeb6a..31aaebd1 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.Reduce +namespace GraphBLAS.FSharp.Tests.Backend.Common.Reduce open Expecto open Expecto.Logging @@ -7,75 +7,76 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests -let logger = Log.create "Reduce.Tests" +module Reduce = + let logger = Log.create "Reduce.Tests" -let context = Context.defaultContext.ClContext + let context = Context.defaultContext.ClContext -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let q = Context.defaultContext.Queue + let q = Context.defaultContext.Queue -let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = + let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = - if array.Length > 0 then - let reduce = reduce q + if array.Length > 0 then + let reduce = reduce q - logger.debug ( - eventX "Filtered array is {array}\n" - >> setField "array" (sprintf "%A" array) - ) + logger.debug ( + eventX "Filtered array is {array}\n" + >> setField "array" (sprintf "%A" array) + ) - let actualSum = - use clArray = context.CreateClArray array - let total = reduce clArray + let actualSum = + use clArray = context.CreateClArray array + let total = reduce clArray - let actualSum = [| zero |] + let actualSum = [| zero |] - let sum = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) + let sum = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) - sum.[0] + sum.[0] - logger.debug ( - eventX "Actual is {actual}\n" - >> setField "actual" (sprintf "%A" actualSum) - ) + logger.debug ( + eventX "Actual is {actual}\n" + >> setField "actual" (sprintf "%A" actualSum) + ) - let expectedSum = Array.fold plus zero array + let expectedSum = Array.fold plus zero array - logger.debug ( - eventX "Expected is {expected}\n" - >> setField "expected" (sprintf "%A" expectedSum) - ) + logger.debug ( + eventX "Expected is {expected}\n" + >> setField "expected" (sprintf "%A" expectedSum) + ) - "Total sums should be equal" - |> Expect.equal actualSum expectedSum + "Total sums should be equal" + |> Expect.equal actualSum expectedSum -let testFixtures plus plusQ zero name = - let reduce = Reduce.reduce context wgSize plusQ + let testFixtures plus plusQ zero name = + let reduce = Reduce.reduce context wgSize plusQ - makeTest reduce plus zero - |> testPropertyWithConfig config $"Correctness on %s{name}" + makeTest reduce plus zero + |> testPropertyWithConfig config $"Correctness on %s{name}" -let tests = - q.Error.Add(fun e -> failwithf "%A" e) + let tests = + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 "int add" - testFixtures (+) <@ (+) @> 0uy "byte add" - testFixtures max <@ max @> System.Int32.MinValue "int max" - testFixtures max <@ max @> System.Byte.MinValue "byte max" - testFixtures min <@ min @> System.Int32.MaxValue "int min" + [ testFixtures (+) <@ (+) @> 0 "int add" + testFixtures (+) <@ (+) @> 0uy "byte add" + testFixtures max <@ max @> System.Int32.MinValue "int max" + testFixtures max <@ max @> System.Byte.MinValue "byte max" + testFixtures min <@ min @> System.Int32.MaxValue "int min" - if Utils.isFloat64Available context.ClDevice then - testFixtures max <@ max @> System.Double.MinValue "float max" - testFixtures min <@ min @> System.Double.MaxValue "float min" + if Utils.isFloat64Available context.ClDevice then + testFixtures max <@ max @> System.Double.MinValue "float max" + testFixtures min <@ min @> System.Double.MaxValue "float min" - testFixtures max <@ max @> System.Single.MinValue "float32 max" - testFixtures min <@ min @> System.Single.MaxValue "float32 min" + testFixtures max <@ max @> System.Single.MinValue "float32 max" + testFixtures min <@ min @> System.Single.MaxValue "float32 min" - testFixtures min <@ min @> System.Byte.MaxValue "byte min" - testFixtures (||) <@ (||) @> false "bool logic-or" - testFixtures (&&) <@ (&&) @> true "bool logic-and" ] - |> testList "Backend.Common.Reduce tests" + testFixtures min <@ min @> System.Byte.MaxValue "byte min" + testFixtures (||) <@ (||) @> false "bool logic-or" + testFixtures (&&) <@ (&&) @> true "bool logic-and" ] + |> testList "Backend.Common.Reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index e0d13aac..9f8eb54b 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ReduceByKey +namespace GraphBLAS.FSharp.Tests.Backend.Common.Reduce open Expecto open GraphBLAS.FSharp.Backend.Common @@ -7,180 +7,181 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -let context = Context.defaultContext.ClContext +module ByKey = + let context = Context.defaultContext.ClContext -let processor = Context.defaultContext.Queue + let processor = Context.defaultContext.Queue -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let checkResult isEqual actualKeys actualValues keys values reduceOp = + let checkResult isEqual actualKeys actualValues keys values reduceOp = - let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp + let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp - "Keys must be the same" - |> Utils.compareArrays (=) actualKeys expectedKeys + "Keys must be the same" + |> Utils.compareArrays (=) actualKeys expectedKeys - "Values must the same" - |> Utils.compareArrays isEqual actualValues expectedValues + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues -let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = - let keys, values = - Array.sortBy fst arrayAndKeys - |> Array.unzip + let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = + let keys, values = + Array.sortBy fst arrayAndKeys + |> Array.unzip - if keys.Length > 0 then - let clKeys = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + if keys.Length > 0 then + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) - let clValues = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let resultLength = Array.length <| Array.distinct keys + let resultLength = Array.length <| Array.distinct keys - let clActualKeys, clActualValues: ClArray * ClArray<'a> - = reduce processor HostInterop resultLength clKeys clValues + let clActualKeys, clActualValues: ClArray * ClArray<'a> + = reduce processor HostInterop resultLength clKeys clValues - clValues.Free processor - clKeys.Free processor + clValues.Free processor + clKeys.Free processor - let actualValues = clActualValues.ToHostAndFree processor - let actualKeys = clActualKeys.ToHostAndFree processor + let actualValues = clActualValues.ToHostAndFree processor + let actualKeys = clActualKeys.ToHostAndFree processor - checkResult isEqual actualKeys actualValues keys values reduceOp + checkResult isEqual actualKeys actualValues keys values reduceOp -let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = - let reduce = - Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ + let reduce = + Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ - makeTest isEqual reduce reduceOp - |> testPropertyWithConfig config $"test on {typeof<'a>}" + makeTest isEqual reduce reduceOp + |> testPropertyWithConfig config $"test on {typeof<'a>}" -let sequentialTest = - let addTests = - testList - "add tests" - [ createTestSequential (=) (+) <@ (+) @> - createTestSequential (=) (+) <@ (+) @> + let sequentialTest = + let addTests = + testList + "add tests" + [ createTestSequential (=) (+) <@ (+) @> + createTestSequential (=) (+) <@ (+) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequential Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequential Utils.floatIsEqual (+) <@ (+) @> - createTestSequential Utils.float32IsEqual (+) <@ (+) @> - createTestSequential (=) (||) <@ (||) @> ] + createTestSequential Utils.float32IsEqual (+) <@ (+) @> + createTestSequential (=) (||) <@ (||) @> ] - let mulTests = - testList - "mul tests" - [ createTestSequential (=) (*) <@ (*) @> - createTestSequential (=) (*) <@ (*) @> + let mulTests = + testList + "mul tests" + [ createTestSequential (=) (*) <@ (*) @> + createTestSequential (=) (*) <@ (*) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequential Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequential Utils.floatIsEqual (*) <@ (*) @> - createTestSequential Utils.float32IsEqual (*) <@ (*) @> - createTestSequential (=) (&&) <@ (&&) @> ] + createTestSequential Utils.float32IsEqual (*) <@ (*) @> + createTestSequential (=) (&&) <@ (&&) @> ] - testList "Sequential" [addTests; mulTests] + testList "Sequential" [addTests; mulTests] -let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = - let reduce = - Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ + let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ - makeTest isEqual reduce reduceOp - |> testPropertyWithConfig { config with endSize = Utils.defaultWorkGroupSize } $"test on {typeof<'a>}" + makeTest isEqual reduce reduceOp + |> testPropertyWithConfig { config with endSize = Utils.defaultWorkGroupSize } $"test on {typeof<'a>}" -let oneWorkGroupTest = - let addTests = - testList - "add tests" - [ createTestOneWorkGroup (=) (+) <@ (+) @> - createTestOneWorkGroup (=) (+) <@ (+) @> + let oneWorkGroupTest = + let addTests = + testList + "add tests" + [ createTestOneWorkGroup (=) (+) <@ (+) @> + createTestOneWorkGroup (=) (+) <@ (+) @> - if Utils.isFloat64Available context.ClDevice then - createTestOneWorkGroup Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available context.ClDevice then + createTestOneWorkGroup Utils.floatIsEqual (+) <@ (+) @> - createTestOneWorkGroup Utils.float32IsEqual (+) <@ (+) @> - createTestOneWorkGroup (=) (||) <@ (||) @> ] + createTestOneWorkGroup Utils.float32IsEqual (+) <@ (+) @> + createTestOneWorkGroup (=) (||) <@ (||) @> ] - let mulTests = - testList - "mul tests" - [ createTestOneWorkGroup (=) (*) <@ (*) @> - createTestOneWorkGroup (=) (*) <@ (*) @> + let mulTests = + testList + "mul tests" + [ createTestOneWorkGroup (=) (*) <@ (*) @> + createTestOneWorkGroup (=) (*) <@ (*) @> - if Utils.isFloat64Available context.ClDevice then - createTestOneWorkGroup Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available context.ClDevice then + createTestOneWorkGroup Utils.floatIsEqual (*) <@ (*) @> - createTestOneWorkGroup Utils.float32IsEqual (*) <@ (*) @> - createTestOneWorkGroup (=) (&&) <@ (&&) @> ] + createTestOneWorkGroup Utils.float32IsEqual (*) <@ (*) @> + createTestOneWorkGroup (=) (&&) <@ (&&) @> ] - testList "One work group" [addTests; mulTests] + testList "One work group" [addTests; mulTests] -let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a) []) = + let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a) []) = - let valuesAndKeys = Array.sortBy fst valuesAndKeys + let valuesAndKeys = Array.sortBy fst valuesAndKeys - if valuesAndKeys.Length > 0 then - let offsets = - Array.map fst valuesAndKeys - |> HostPrimitives.getUniqueBitmapFirstOccurrence - |> HostPrimitives.getBitPositions + if valuesAndKeys.Length > 0 then + let offsets = + Array.map fst valuesAndKeys + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions - let resultLength = offsets.Length + let resultLength = offsets.Length - let keys, values = Array.unzip valuesAndKeys + let keys, values = Array.unzip valuesAndKeys - let clOffsets = context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + let clOffsets = context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) - let clKeys = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) - let clValues = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let clReducedKeys, clReducedValues: ClArray * ClArray<'a> = - reduce processor DeviceOnly resultLength clOffsets clKeys clValues + let clReducedKeys, clReducedValues: ClArray * ClArray<'a> = + reduce processor DeviceOnly resultLength clOffsets clKeys clValues - let reducedKeys = clReducedKeys.ToHostAndFree processor - let reducedValues = clReducedValues.ToHostAndFree processor + let reducedKeys = clReducedKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor - checkResult isEqual reducedKeys reducedValues keys values reduceOp + checkResult isEqual reducedKeys reducedValues keys values reduceOp -let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = - let reduce = - Reduce.ByKey.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ - makeTestSequentialSegments isEqual reduce reduceOp - |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" + makeTestSequentialSegments isEqual reduce reduceOp + |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" -let sequentialSegmentTests = - let addTests = - testList - "add tests" - [ createTestSequentialSegments (=) (+) <@ (+) @> - createTestSequentialSegments (=) (+) <@ (+) @> + let sequentialSegmentTests = + let addTests = + testList + "add tests" + [ createTestSequentialSegments (=) (+) <@ (+) @> + createTestSequentialSegments (=) (+) <@ (+) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequentialSegments Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments Utils.floatIsEqual (+) <@ (+) @> - createTestSequentialSegments Utils.float32IsEqual (+) <@ (+) @> - createTestSequentialSegments (=) (||) <@ (||) @> ] + createTestSequentialSegments Utils.float32IsEqual (+) <@ (+) @> + createTestSequentialSegments (=) (||) <@ (||) @> ] - let mulTests = - testList - "mul tests" - [ createTestSequentialSegments (=) (*) <@ (*) @> - createTestSequentialSegments (=) (*) <@ (*) @> + let mulTests = + testList + "mul tests" + [ createTestSequentialSegments (=) (*) <@ (*) @> + createTestSequentialSegments (=) (*) <@ (*) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequentialSegments Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments Utils.floatIsEqual (*) <@ (*) @> - createTestSequentialSegments Utils.float32IsEqual (*) <@ (*) @> - createTestSequentialSegments (=) (&&) <@ (&&) @> ] + createTestSequentialSegments Utils.float32IsEqual (*) <@ (*) @> + createTestSequentialSegments (=) (&&) <@ (&&) @> ] - testList "Sequential segments" [addTests; mulTests] + testList "Sequential segments" [addTests; mulTests] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs index f3e2fffc..0b09a62c 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.Sum +namespace GraphBLAS.FSharp.Tests.Backend.Common.Reduce open Expecto open Expecto.Logging @@ -9,68 +9,69 @@ open GraphBLAS.FSharp.Tests open FSharp.Quotations open Context -let logger = Log.create "Sum.Test" +module Sum = + let logger = Log.create "Sum.Test" -let context = defaultContext.ClContext + let context = defaultContext.ClContext -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = 128 -let q = defaultContext.Queue + let wgSize = 128 + let q = defaultContext.Queue -let makeTest plus zero sum (array: 'a []) = - if array.Length > 0 then + let makeTest plus zero sum (array: 'a []) = + if array.Length > 0 then - logger.debug ( - eventX "Filtered array is {array}\n" - >> setField "array" (sprintf "%A" array) - ) + logger.debug ( + eventX "Filtered array is {array}\n" + >> setField "array" (sprintf "%A" array) + ) - let actualSum = - use clArray = context.CreateClArray array - use total = sum q clArray + let actualSum = + use clArray = context.CreateClArray array + use total = sum q clArray - let actualSum = [| zero |] - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)).[0] + let actualSum = [| zero |] + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)).[0] - logger.debug ( - eventX "Actual is {actual}\n" - >> setField "actual" (sprintf "%A" actualSum) - ) + logger.debug ( + eventX "Actual is {actual}\n" + >> setField "actual" (sprintf "%A" actualSum) + ) - let expectedSum = array |> Array.fold plus zero + let expectedSum = array |> Array.fold plus zero - logger.debug ( - eventX "Expected is {expected}\n" - >> setField "expected" (sprintf "%A" expectedSum) - ) + logger.debug ( + eventX "Expected is {expected}\n" + >> setField "expected" (sprintf "%A" expectedSum) + ) - "Total sums should be equal" - |> Expect.equal actualSum expectedSum + "Total sums should be equal" + |> Expect.equal actualSum expectedSum -let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = - Reduce.sum context wgSize plusQ zero - |> makeTest plus zero - |> testPropertyWithConfig config (sprintf "Correctness on %s" name) + let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = + Reduce.sum context wgSize plusQ zero + |> makeTest plus zero + |> testPropertyWithConfig config (sprintf "Correctness on %s" name) -let tests = + let tests = - q.Error.Add(fun e -> failwithf "%A" e) + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 "int add" - testFixtures (+) <@ (+) @> 0uy "byte add" - testFixtures max <@ max @> 0 "int max" - testFixtures max <@ max @> 0uy "byte max" - testFixtures min <@ min @> System.Int32.MaxValue "int min" + [ testFixtures (+) <@ (+) @> 0 "int add" + testFixtures (+) <@ (+) @> 0uy "byte add" + testFixtures max <@ max @> 0 "int max" + testFixtures max <@ max @> 0uy "byte max" + testFixtures min <@ min @> System.Int32.MaxValue "int min" - if Utils.isFloat64Available context.ClDevice then - testFixtures min <@ min @> System.Double.MaxValue "float min" - testFixtures max <@ max @> 0.0 "float max" + if Utils.isFloat64Available context.ClDevice then + testFixtures min <@ min @> System.Double.MaxValue "float min" + testFixtures max <@ max @> 0.0 "float max" - testFixtures min <@ min @> System.Single.MaxValue "float32 min" - testFixtures max <@ max @> 0.0f "float32 max" + testFixtures min <@ min @> System.Single.MaxValue "float32 min" + testFixtures max <@ max @> 0.0f "float32 max" - testFixtures min <@ min @> System.Byte.MaxValue "byte min" - testFixtures (||) <@ (||) @> false "bool logic-or" - testFixtures (&&) <@ (&&) @> true "bool logic-and" ] - |> testList "Backend.Common.Sum tests" + testFixtures min <@ min @> System.Byte.MaxValue "byte min" + testFixtures (||) <@ (||) @> false "bool logic-or" + testFixtures (&&) <@ (&&) @> true "bool logic-and" ] + |> testList "Backend.Common.Sum tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 5730ca2e..b3ead421 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.Scatter +namespace GraphBLAS.FSharp.Tests.Backend.Common open Expecto open Expecto.Logging @@ -7,57 +7,58 @@ open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Common -let logger = Log.create "Scatter.Tests" +module Scatter = + let logger = Log.create "Scatter.Tests" -let context = defaultContext.ClContext + let context = defaultContext.ClContext -let config = - { Tests.Utils.defaultConfig with - endSize = 1000000 } + let config = + { Tests.Utils.defaultConfig with + endSize = 1000000 } -let wgSize = Tests.Utils.defaultWorkGroupSize + let wgSize = Tests.Utils.defaultWorkGroupSize -let q = defaultContext.Queue + let q = defaultContext.Queue -let makeTest scatter (array: (int * 'a) []) (result: 'a []) = - if array.Length > 0 then - let expected = Array.copy result + let makeTest scatter (array: (int * 'a) []) (result: 'a []) = + if array.Length > 0 then + let expected = Array.copy result - array - |> Array.pairwise - |> Array.iter - (fun ((i, u), (j, _)) -> - if i <> j && 0 <= i && i < expected.Length then - expected.[i] <- u) + array + |> Array.pairwise + |> Array.iter + (fun ((i, u), (j, _)) -> + if i <> j && 0 <= i && i < expected.Length then + expected.[i] <- u) - let i, u = array.[array.Length - 1] + let i, u = array.[array.Length - 1] - if 0 <= i && i < expected.Length then - expected.[i] <- u + if 0 <= i && i < expected.Length then + expected.[i] <- u - let positions, values = Array.unzip array + let positions, values = Array.unzip array - let actual = - use clPositions = context.CreateClArray positions - use clValues = context.CreateClArray values - use clResult = context.CreateClArray result + let actual = + use clPositions = context.CreateClArray positions + use clValues = context.CreateClArray values + use clResult = context.CreateClArray result - scatter q clPositions clValues clResult + scatter q clPositions clValues clResult - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, Array.zeroCreate result.Length, ch)) + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, Array.zeroCreate result.Length, ch)) - $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" - |> Tests.Utils.compareArrays (=) actual expected + $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" + |> Tests.Utils.compareArrays (=) actual expected -let testFixtures<'a when 'a: equality> = - Scatter.runInplace<'a> context wgSize - |> makeTest - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" + let testFixtures<'a when 'a: equality> = + Scatter.runInplace<'a> context wgSize + |> makeTest + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" -let tests = - q.Error.Add(fun e -> failwithf $"%A{e}") + let tests = + q.Error.Add(fun e -> failwithf $"%A{e}") - [ testFixtures - testFixtures - testFixtures ] - |> testList "Backend.Common.Scatter tests" + [ testFixtures + testFixtures + testFixtures ] + |> testList "Backend.Common.Scatter tests" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs index 150ec153..038401c7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.Convert +namespace GraphBLAS.FSharp.Tests.Backend.Matrix open Expecto open Expecto.Logging @@ -12,98 +12,99 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Convert.Tests" - -let config = Utils.defaultConfig - -let workGroupSize = Utils.defaultWorkGroupSize - -let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = - let mtx = - Utils.createMatrixFromArray2D formatFrom array isZero - - if mtx.NNZ > 0 then - let actual = - let mBefore = mtx.ToDevice context - let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore - let res = mAfter.ToHost q - mBefore.Dispose q - mAfter.Dispose q - res - - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - let expected = - Utils.createMatrixFromArray2D formatTo array isZero - - "Matrices should be equal" - |> Expect.equal actual expected - -let testFixtures formatTo = - let getCorrectnessTestName datatype formatFrom = - $"Correctness on %s{datatype}, %A{formatFrom} to %A{formatTo}" - - let context = defaultContext.ClContext - let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) - - match formatTo with - | COO -> - [ let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | CSR -> - [ let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | CSC -> - [ let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - -let tests = - Utils.listOfUnionCases - |> List.collect testFixtures - |> testList "Convert tests" +module Convert = + let logger = Log.create "Convert.Tests" + + let config = Utils.defaultConfig + + let workGroupSize = Utils.defaultWorkGroupSize + + let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = + let mtx = + Utils.createMatrixFromArray2D formatFrom array isZero + + if mtx.NNZ > 0 then + let actual = + let mBefore = mtx.ToDevice context + let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore + let res = mAfter.ToHost q + mBefore.Dispose q + mAfter.Dispose q + res + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) + + let expected = + Utils.createMatrixFromArray2D formatTo array isZero + + "Matrices should be equal" + |> Expect.equal actual expected + + let testFixtures formatTo = + let getCorrectnessTestName datatype formatFrom = + $"Correctness on %s{datatype}, %A{formatFrom} to %A{formatTo}" + + let context = defaultContext.ClContext + let q = defaultContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + match formatTo with + | COO -> + [ let convertFun = Matrix.toCOO context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) 0) + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Matrix.toCOO context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) false) + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + | CSR -> + [ let convertFun = Matrix.toCSR context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) 0) + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Matrix.toCSR context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) false) + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + | CSC -> + [ let convertFun = Matrix.toCSC context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) 0) + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Matrix.toCSC context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) false) + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + + let tests = + Utils.listOfUnionCases + |> List.collect testFixtures + |> testList "Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index eeb1546f..952b406d 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.Map2 +namespace GraphBLAS.FSharp.Tests.Backend.Matrix open Expecto open Expecto.Logging @@ -15,190 +15,191 @@ open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Map2.Tests" +module Map2 = + let logger = Log.create "Map2.Tests" -let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let config = Utils.defaultConfig + let wgSize = Utils.defaultWorkGroupSize -let getCorrectnessTestName case datatype = - $"Correctness on %s{datatype}, %A{case}" + let getCorrectnessTestName case datatype = + $"Correctness on %s{datatype}, %A{case}" -let checkResult isEqual op zero (baseMtx1: 'a [,]) (baseMtx2: 'a [,]) (actual: Matrix<'a>) = - let rows = Array2D.length1 baseMtx1 - let columns = Array2D.length2 baseMtx1 - 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 checkResult isEqual op zero (baseMtx1: 'a [,]) (baseMtx2: 'a [,]) (actual: Matrix<'a>) = + let rows = Array2D.length1 baseMtx1 + let columns = Array2D.length2 baseMtx1 + 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 + 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 baseMtx1.[i, j] baseMtx2.[i, j] + for i in 0 .. rows - 1 do + for j in 0 .. columns - 1 do + expected2D.[i, j] <- op baseMtx1.[i, j] baseMtx2.[i, j] - let actual2D = Array2D.create rows columns zero + let actual2D = Array2D.create rows columns zero - match actual with - | Matrix.COO actual -> - for i in 0 .. actual.Rows.Length - 1 do - if isEqual zero actual.Values.[i] then - failwith "Resulting zeroes should be filtered." + match actual with + | Matrix.COO actual -> + for i in 0 .. actual.Rows.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." + 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 + "Arrays must be the same" + |> Utils.compare2DArrays isEqual actual2D expected2D -let correctnessGenericTest - zero - op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) - toCOOFun - (isEqual: 'a -> 'a -> bool) - q - (case: OperationCase) - (leftMatrix: 'a [,], rightMatrix: 'a [,]) - = + let correctnessGenericTest + zero + op + (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) + toCOOFun + (isEqual: 'a -> 'a -> bool) + q + (case: OperationCase) + (leftMatrix: 'a [,], rightMatrix: 'a [,]) + = - let mtx1 = - Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) + let mtx1 = + Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) - let mtx2 = - Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) + let mtx2 = + Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) - if mtx1.NNZ > 0 && mtx2.NNZ > 0 then - try - let m1 = mtx1.ToDevice case.TestContext.ClContext + if mtx1.NNZ > 0 && mtx2.NNZ > 0 then + try + let m1 = mtx1.ToDevice case.TestContext.ClContext - let m2 = mtx2.ToDevice case.TestContext.ClContext + let m2 = mtx2.ToDevice case.TestContext.ClContext - let res = addFun q HostInterop m1 m2 + let res = addFun q HostInterop m1 m2 - m1.Dispose q - m2.Dispose q + m1.Dispose q + m2.Dispose q - let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res - let actual = cooRes.ToHost q + let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res + let actual = cooRes.ToHost q - cooRes.Dispose q - res.Dispose q + cooRes.Dispose q + res.Dispose q - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) - checkResult isEqual op zero leftMatrix rightMatrix actual - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual op zero leftMatrix rightMatrix actual + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex -let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = - let getCorrectnessTestName = getCorrectnessTestName case + let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = + let getCorrectnessTestName = getCorrectnessTestName case - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - let map2 = map2 context addQ wgSize + let map2 = map2 context addQ wgSize - let toCOO = Matrix.toCOO context wgSize + let toCOO = Matrix.toCOO context wgSize - case - |> correctnessGenericTest zero add map2 toCOO isEqual q - |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") + case + |> correctnessGenericTest zero add map2 toCOO isEqual q + |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") -let testFixturesMap2Add case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + let testFixturesMap2Add case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSum Matrix.map2 + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSum Matrix.map2 - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSum Matrix.map2 + if Utils.isFloat64Available context.ClDevice then + creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSum Matrix.map2 - creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32Sum Matrix.map2 - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSum Matrix.map2 ] + creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32Sum Matrix.map2 + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSum Matrix.map2 ] -let addTests = - operationGPUTests "Backend.Matrix.map2 add tests" testFixturesMap2Add + let addTests = + operationGPUTests "Backend.Matrix.map2 add tests" testFixturesMap2Add -let testFixturesMap2AddAtLeastOne case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + let testFixturesMap2AddAtLeastOne case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOne - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSumAtLeastOne Matrix.map2AtLeastOne + if Utils.isFloat64Available context.ClDevice then + creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSumAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add - case - 0.0f - (+) - Utils.float32IsEqual - ArithmeticOperations.float32SumAtLeastOne - Matrix.map2AtLeastOne + creatTestMap2Add + case + 0.0f + (+) + Utils.float32IsEqual + ArithmeticOperations.float32SumAtLeastOne + Matrix.map2AtLeastOne + + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOne ] - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOne ] + let addAtLeastOneTests = + operationGPUTests "Backend.Matrix.map2AtLeastOne add tests" testFixturesMap2AddAtLeastOne -let addAtLeastOneTests = - operationGPUTests "Backend.Matrix.map2AtLeastOne add tests" testFixturesMap2AddAtLeastOne + let testFixturesMap2AddAtLeastOneToCOO case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) -let testFixturesMap2AddAtLeastOneToCOO case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOneToCOO + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOneToCOO - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOneToCOO - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOneToCOO + if Utils.isFloat64Available context.ClDevice then + creatTestMap2Add + case + 0.0 + (+) + Utils.floatIsEqual + ArithmeticOperations.floatSumAtLeastOne + Matrix.map2AtLeastOneToCOO - if Utils.isFloat64Available context.ClDevice then creatTestMap2Add case - 0.0 + 0.0f (+) - Utils.floatIsEqual - ArithmeticOperations.floatSumAtLeastOne + Utils.float32IsEqual + ArithmeticOperations.float32SumAtLeastOne Matrix.map2AtLeastOneToCOO - creatTestMap2Add - case - 0.0f - (+) - Utils.float32IsEqual - ArithmeticOperations.float32SumAtLeastOne - Matrix.map2AtLeastOneToCOO + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOneToCOO ] - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOneToCOO ] + let addAtLeastOneToCOOTests = + operationGPUTests "Backend.Matrix.map2AtLeastOneToCOO add tests" testFixturesMap2AddAtLeastOneToCOO -let addAtLeastOneToCOOTests = - operationGPUTests "Backend.Matrix.map2AtLeastOneToCOO add tests" testFixturesMap2AddAtLeastOneToCOO + let testFixturesMap2MulAtLeastOne case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) -let testFixturesMap2MulAtLeastOne case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + creatTestMap2Add case false (&&) (=) ArithmeticOperations.boolMulAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add case 0 (*) (=) ArithmeticOperations.intMulAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add case false (&&) (=) ArithmeticOperations.boolMulAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add case 0 (*) (=) ArithmeticOperations.intMulAtLeastOne Matrix.map2AtLeastOne + if Utils.isFloat64Available context.ClDevice then + creatTestMap2Add case 0.0 (*) Utils.floatIsEqual ArithmeticOperations.floatMulAtLeastOne Matrix.map2AtLeastOne - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (*) Utils.floatIsEqual ArithmeticOperations.floatMulAtLeastOne Matrix.map2AtLeastOne - - creatTestMap2Add - case - 0.0f - (*) - Utils.float32IsEqual - ArithmeticOperations.float32MulAtLeastOne - Matrix.map2AtLeastOne + creatTestMap2Add + case + 0.0f + (*) + Utils.float32IsEqual + ArithmeticOperations.float32MulAtLeastOne + Matrix.map2AtLeastOne - creatTestMap2Add case 0uy (*) (=) ArithmeticOperations.byteMulAtLeastOne Matrix.map2AtLeastOne ] + creatTestMap2Add case 0uy (*) (=) ArithmeticOperations.byteMulAtLeastOne Matrix.map2AtLeastOne ] -let mulAtLeastOneTests = - operationGPUTests "Backend.Matrix.map2AtLeastOne multiplication tests" testFixturesMap2MulAtLeastOne + let mulAtLeastOneTests = + operationGPUTests "Backend.Matrix.map2AtLeastOne multiplication tests" testFixturesMap2MulAtLeastOne diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs index 236f0973..4ce0f52c 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.Mxm +namespace GraphBLAS.FSharp.Tests.Backend.Matrix open Expecto open Expecto.Logging @@ -11,102 +11,103 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Test -let logger = Log.create "Mxm.Tests" +module Mxm = + let logger = Log.create "Mxm.Tests" -let context = defaultContext.ClContext -let workGroupSize = Utils.defaultWorkGroupSize + let context = defaultContext.ClContext + let workGroupSize = Utils.defaultWorkGroupSize -let makeTest context q zero isEqual plus mul mxmFun (leftMatrix: 'a [,], rightMatrix: 'a [,], mask: bool [,]) = + let makeTest context q zero isEqual plus mul mxmFun (leftMatrix: 'a [,], rightMatrix: 'a [,], mask: bool [,]) = - let m1 = - Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero) + let m1 = + Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero) - let m2 = - Utils.createMatrixFromArray2D CSC rightMatrix (isEqual zero) + let m2 = + Utils.createMatrixFromArray2D CSC rightMatrix (isEqual zero) - let matrixMask = - Utils.createMatrixFromArray2D COO mask ((=) false) + let matrixMask = + Utils.createMatrixFromArray2D COO mask ((=) false) - if m1.NNZ > 0 && m2.NNZ > 0 then - let expected = - Array2D.init - <| Array2D.length1 mask - <| Array2D.length2 mask - <| fun i j -> - if mask.[i, j] then - (leftMatrix.[i, *], rightMatrix.[*, j]) - ||> Array.map2 mul - |> Array.reduce plus - else - zero + if m1.NNZ > 0 && m2.NNZ > 0 then + let expected = + Array2D.init + <| Array2D.length1 mask + <| Array2D.length2 mask + <| fun i j -> + if mask.[i, j] then + (leftMatrix.[i, *], rightMatrix.[*, j]) + ||> Array.map2 mul + |> Array.reduce plus + else + zero - let expected = - Utils.createMatrixFromArray2D COO expected (isEqual zero) + let expected = + Utils.createMatrixFromArray2D COO expected (isEqual zero) - if expected.NNZ > 0 then - let m1 = m1.ToDevice context - let m2 = m2.ToDevice context - let matrixMask = matrixMask.ToDevice context + if expected.NNZ > 0 then + let m1 = m1.ToDevice context + let m2 = m2.ToDevice context + let matrixMask = matrixMask.ToDevice context - let (result: ClMatrix<'a>) = mxmFun q m1 m2 matrixMask - let actual = result.ToHost q + let (result: ClMatrix<'a>) = mxmFun q m1 m2 matrixMask + let actual = result.ToHost q - m1.Dispose q - m2.Dispose q - matrixMask.Dispose q - result.Dispose q + m1.Dispose q + m2.Dispose q + matrixMask.Dispose q + result.Dispose q - // Check result - "Matrices should be equal" - |> Expect.equal actual expected + // Check result + "Matrices should be equal" + |> Expect.equal actual expected -let tests = - let getCorrectnessTestName = sprintf "Correctness on %s" + let tests = + let getCorrectnessTestName = sprintf "Correctness on %s" - let config = - { Utils.defaultConfig with - arbitrary = [ typeof ] } + let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } - let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + let q = defaultContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - [ let add = - <@ fun x y -> - let mutable res = x + y + [ let add = + <@ fun x y -> + let mutable res = x + y - if res = 0 then None else (Some res) @> + if res = 0 then None else (Some res) @> - let mult = <@ fun x y -> Some(x * y) @> + let mult = <@ fun x y -> Some(x * y) @> - let mxmFun = - Matrix.mxm add mult context workGroupSize + let mxmFun = + Matrix.mxm add mult context workGroupSize - makeTest context q 0 (=) (+) (*) mxmFun - |> testPropertyWithConfig config (getCorrectnessTestName "int") + makeTest context q 0 (=) (+) (*) mxmFun + |> testPropertyWithConfig config (getCorrectnessTestName "int") - let logicalOr = - <@ fun x y -> - let mutable res = None + let logicalOr = + <@ fun x y -> + let mutable res = None - match x, y with - | false, false -> res <- None - | _ -> res <- Some true + match x, y with + | false, false -> res <- None + | _ -> res <- Some true - res @> + res @> - let logicalAnd = - <@ fun x y -> - let mutable res = None + let logicalAnd = + <@ fun x y -> + let mutable res = None - match x, y with - | true, true -> res <- Some true - | _ -> res <- None + match x, y with + | true, true -> res <- Some true + | _ -> res <- None - res @> + res @> - let mxmFun = - Matrix.mxm logicalOr logicalAnd context workGroupSize + let mxmFun = + Matrix.mxm logicalOr logicalAnd context workGroupSize - makeTest context q false (=) (||) (&&) mxmFun - |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] - |> testList "Mxm tests" + makeTest context q false (=) (||) (&&) mxmFun + |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] + |> testList "Mxm tests" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs index 4e894609..d7824ea7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.Transpose +namespace GraphBLAS.FSharp.Tests.Backend.Matrix open Expecto open Expecto.Logging @@ -12,127 +12,128 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Transpose.Tests" +module Transpose = + let logger = Log.create "Transpose.Tests" -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let getCorrectnessTestName case datatype = - $"Correctness on %s{datatype}, %A{case.Format}, %A{case.TestContext}" + let getCorrectnessTestName case datatype = + $"Correctness on %s{datatype}, %A{case.Format}, %A{case.TestContext}" -let checkResult areEqual zero actual (expected2D: 'a [,]) = - match actual with - | Matrix.COO actual -> - let expected = - Matrix.COO.FromArray2D(expected2D, areEqual zero) + let checkResult areEqual zero actual (expected2D: 'a [,]) = + match actual with + | Matrix.COO actual -> + let expected = + Matrix.COO.FromArray2D(expected2D, areEqual zero) - "The number of rows should be the same" - |> Expect.equal actual.RowCount expected.RowCount + "The number of rows should be the same" + |> Expect.equal actual.RowCount expected.RowCount - "The number of columns should be the same" - |> Expect.equal actual.ColumnCount expected.ColumnCount + "The number of columns should be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount - "Row arrays should be equal" - |> Utils.compareArrays (=) actual.Rows expected.Rows + "Row arrays should be equal" + |> Utils.compareArrays (=) actual.Rows expected.Rows - "Column arrays should be equal" - |> Utils.compareArrays (=) actual.Columns expected.Columns + "Column arrays should be equal" + |> Utils.compareArrays (=) actual.Columns expected.Columns - "Value arrays should be equal" - |> Utils.compareArrays areEqual actual.Values expected.Values - | Matrix.CSR actual -> - let expected = - Matrix.CSR.FromArray2D(expected2D, areEqual zero) + "Value arrays should be equal" + |> Utils.compareArrays areEqual actual.Values expected.Values + | Matrix.CSR actual -> + let expected = + Matrix.CSR.FromArray2D(expected2D, areEqual zero) - "The number of rows should be the same" - |> Expect.equal actual.RowCount expected.RowCount + "The number of rows should be the same" + |> Expect.equal actual.RowCount expected.RowCount - "The number of columns should be the same" - |> Expect.equal actual.ColumnCount expected.ColumnCount + "The number of columns should be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount - "Row pointer arrays should be equal" - |> Utils.compareArrays (=) actual.RowPointers expected.RowPointers + "Row pointer arrays should be equal" + |> Utils.compareArrays (=) actual.RowPointers expected.RowPointers - "Column arrays should be equal" - |> Utils.compareArrays (=) actual.ColumnIndices expected.ColumnIndices + "Column arrays should be equal" + |> Utils.compareArrays (=) actual.ColumnIndices expected.ColumnIndices - "Value arrays should be equal" - |> Utils.compareArrays areEqual actual.Values expected.Values - | Matrix.CSC actual -> - let expected = - Matrix.CSC.FromArray2D(expected2D, areEqual zero) + "Value arrays should be equal" + |> Utils.compareArrays areEqual actual.Values expected.Values + | Matrix.CSC actual -> + let expected = + Matrix.CSC.FromArray2D(expected2D, areEqual zero) - "The number of rows should be the same" - |> Expect.equal actual.RowCount expected.RowCount + "The number of rows should be the same" + |> Expect.equal actual.RowCount expected.RowCount - "The number of columns should be the same" - |> Expect.equal actual.ColumnCount expected.ColumnCount + "The number of columns should be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount - "Row arrays should be equal" - |> Utils.compareArrays (=) actual.RowIndices expected.RowIndices + "Row arrays should be equal" + |> Utils.compareArrays (=) actual.RowIndices expected.RowIndices - "Column pointer arrays should be equal" - |> Utils.compareArrays (=) actual.ColumnPointers expected.ColumnPointers + "Column pointer arrays should be equal" + |> Utils.compareArrays (=) actual.ColumnPointers expected.ColumnPointers - "Value arrays should be equal" - |> Utils.compareArrays areEqual actual.Values expected.Values + "Value arrays should be equal" + |> Utils.compareArrays areEqual actual.Values expected.Values -let makeTestRegular context q transposeFun hostTranspose isEqual zero case (array: 'a [,]) = - let mtx = - Utils.createMatrixFromArray2D case.Format array (isEqual zero) + let makeTestRegular context q transposeFun hostTranspose isEqual zero case (array: 'a [,]) = + let mtx = + Utils.createMatrixFromArray2D case.Format array (isEqual zero) - if mtx.NNZ > 0 then - let actual = - let m = mtx.ToDevice context - let (mT: ClMatrix<'a>) = transposeFun q HostInterop m - let res = mT.ToHost q - m.Dispose q - mT.Dispose q - res + if mtx.NNZ > 0 then + let actual = + let m = mtx.ToDevice context + let (mT: ClMatrix<'a>) = transposeFun q HostInterop m + let res = mT.ToHost q + m.Dispose q + mT.Dispose q + res - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - let expected2D = hostTranspose array + let expected2D = hostTranspose array - checkResult isEqual zero actual expected2D + checkResult isEqual zero actual expected2D -let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - let transposeFun = Matrix.transpose context wgSize + let transposeFun = Matrix.transpose context wgSize - let twiceTranspose processor allocationFlag matrix = - transposeFun processor allocationFlag matrix - |> transposeFun processor allocationFlag + let twiceTranspose processor allocationFlag matrix = + transposeFun processor allocationFlag matrix + |> transposeFun processor allocationFlag - [ case - |> makeTestRegular context q transposeFun Utils.transpose2DArray isEqual zero - |> testPropertyWithConfig config "single transpose" + [ case + |> makeTestRegular context q transposeFun Utils.transpose2DArray isEqual zero + |> testPropertyWithConfig config "single transpose" - case - |> makeTestRegular context q twiceTranspose id isEqual zero - |> testPropertyWithConfig config "twice transpose" ] + case + |> makeTestRegular context q twiceTranspose id isEqual zero + |> testPropertyWithConfig config "twice transpose" ] - |> testList (getCorrectnessTestName case $"{typeof<'a>}") + |> testList (getCorrectnessTestName case $"{typeof<'a>}") -let testFixtures case = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + let testFixtures case = + let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest case 0 (=) + [ createTest case 0 (=) - if Utils.isFloat64Available context.ClDevice then - createTest case 0.0 Utils.floatIsEqual + if Utils.isFloat64Available context.ClDevice then + createTest case 0.0 Utils.floatIsEqual - createTest case 0.0f Utils.float32IsEqual - createTest case 0uy (=) - createTest case false (=) ] + createTest case 0.0f Utils.float32IsEqual + createTest case 0uy (=) + createTest case false (=) ] -let tests = - operationGPUTests "Matrix.Transpose tests" testFixtures + let tests = + operationGPUTests "Matrix.Transpose tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 3b664920..e7021adc 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,70 +1,79 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Mxm.tests -// Matrix.Transpose.tests ] -// |> testSequenced -// -// let commonTests = -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.PrefixSum.tests -// Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.tests ] -// -// testList -// "Common tests" -// [ clArrayTests -// Common.BitonicSort.tests -// Common.Scatter.tests -// Common.Reduce.tests -// Common.Sum.tests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Mxm.tests + Matrix.Transpose.tests ] + |> testSequenced + +let commonTests = + let reduceTest = + testList + "Reduce" + [ Common.Reduce.ByKey.sequentialTest + Common.Reduce.ByKey.sequentialSegmentTests + Common.Reduce.ByKey.oneWorkGroupTest + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests] + + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.PrefixSum.tests + Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.tests ] + + testList + "Common tests" + [ clArrayTests + reduceTest + Common.BitonicSort.tests + Common.Scatter.tests ] + |> testSequenced + +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced [] let allTests = testList "All tests" - [ Common.ReduceByKey.sequentialTest - Common.ReduceByKey.sequentialSegmentTests - Common.ReduceByKey.oneWorkGroupTest ] + [ matrixTests + commonTests + vectorTests + algorithmsTests ] |> testSequenced [] diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs index 287d2b3a..77af14b0 100644 --- a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.QuickGraph.Algorithms +namespace GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms open System.Collections.Generic open QuikGraph diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs b/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs index bbf89add..1f9f0f65 100644 --- a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs +++ b/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.QuickGraph.Algorithms +namespace GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms open System.Collections.Generic open QuikGraph diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs b/tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs index d3f68d07..7684d586 100644 --- a/tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs +++ b/tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.QuickGraph +namespace GraphBLAS.FSharp.Tests.Backend.QuickGraph open QuikGraph diff --git a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs index c4193eb3..f0194486 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.AssignByMask +namespace GraphBLAS.FSharp.Tests.Backend.Vector open Expecto open Expecto.Logging @@ -13,129 +13,130 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Vector.assignByMask.Tests" +module AssignByMask = + let logger = Log.create "Vector.assignByMask.Tests" -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let getCorrectnessTestName case datatype = - $"Correctness on %s{datatype}, vector: %A{case.Format}" + let getCorrectnessTestName case datatype = + $"Correctness on %s{datatype}, vector: %A{case.Format}" -let checkResult isZero isComplemented (actual: Vector<'a>) (vector: 'a []) (mask: 'a []) (value: 'a) = + let checkResult isZero isComplemented (actual: Vector<'a>) (vector: 'a []) (mask: 'a []) (value: 'a) = - let expectedArray = Array.zeroCreate vector.Length + let expectedArray = Array.zeroCreate vector.Length - let vector = - Utils.createVectorFromArray Dense vector isZero - |> Utils.vectorToDenseVector + let vector = + Utils.createVectorFromArray Dense vector isZero + |> Utils.vectorToDenseVector - let mask = - Utils.createVectorFromArray Dense mask isZero - |> Utils.vectorToDenseVector + let mask = + Utils.createVectorFromArray Dense mask isZero + |> Utils.vectorToDenseVector - for i in 0 .. vector.Length - 1 do - expectedArray.[i] <- - if isComplemented then - match vector.[i], mask.[i] with - | _, None -> Some value - | _ -> vector.[i] - else - match vector.[i], mask.[i] with - | _, Some _ -> Some value - | _ -> vector.[i] + for i in 0 .. vector.Length - 1 do + expectedArray.[i] <- + if isComplemented then + match vector.[i], mask.[i] with + | _, None -> Some value + | _ -> vector.[i] + else + match vector.[i], mask.[i] with + | _, Some _ -> Some value + | _ -> vector.[i] - match actual with - | Vector.Dense actual -> Expect.equal actual expectedArray "Arrays must be equals" - | _ -> failwith "Vector format must be Dense." + match actual with + | Vector.Dense actual -> Expect.equal actual expectedArray "Arrays must be equals" + | _ -> failwith "Vector format must be Dense." -let makeTest<'a when 'a: struct and 'a: equality> - (isZero: 'a -> bool) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (fillVector: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClCell<'a> -> ClVector<'a>) - isComplemented - case - (vector: 'a [], mask: 'a [], value: 'a) - = + let makeTest<'a when 'a: struct and 'a: equality> + (isZero: 'a -> bool) + (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (fillVector: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClCell<'a> -> ClVector<'a>) + isComplemented + case + (vector: 'a [], mask: 'a [], value: 'a) + = - let leftVector = - Utils.createVectorFromArray case.Format vector isZero + let leftVector = + Utils.createVectorFromArray case.Format vector isZero - let maskVector = - Utils.createVectorFromArray case.Format mask isZero + let maskVector = + Utils.createVectorFromArray case.Format mask isZero - if leftVector.NNZ > 0 && maskVector.NNZ > 0 then + if leftVector.NNZ > 0 && maskVector.NNZ > 0 then - let q = case.TestContext.Queue - let context = case.TestContext.ClContext + let q = case.TestContext.Queue + let context = case.TestContext.ClContext - let clLeftVector = leftVector.ToDevice context - let clMaskVector = maskVector.ToDevice context + let clLeftVector = leftVector.ToDevice context + let clMaskVector = maskVector.ToDevice context - try - let clValue = context.CreateClCell<'a> value + try + let clValue = context.CreateClCell<'a> value - let clActual = - fillVector q HostInterop clLeftVector clMaskVector clValue + let clActual = + fillVector q HostInterop clLeftVector clMaskVector clValue - let cooClActual = toDense q HostInterop clActual + let cooClActual = toDense q HostInterop clActual - let actual = cooClActual.ToHost q + let actual = cooClActual.ToHost q - clLeftVector.Dispose q - clMaskVector.Dispose q - clActual.Dispose q - cooClActual.Dispose q + clLeftVector.Dispose q + clMaskVector.Dispose q + clActual.Dispose q + cooClActual.Dispose q - checkResult isZero isComplemented actual vector mask value - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isZero isComplemented actual vector mask value + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex -let createTest case (isZero: 'a -> bool) isComplemented fill = - let context = case.TestContext.ClContext - let getCorrectnessTestName = getCorrectnessTestName case + let createTest case (isZero: 'a -> bool) isComplemented fill = + let context = case.TestContext.ClContext + let getCorrectnessTestName = getCorrectnessTestName case - let fill = fill context Mask.assign wgSize + let fill = fill context Mask.assign wgSize - let toCoo = Vector.toDense context wgSize + let toCoo = Vector.toDense context wgSize - case - |> makeTest isZero toCoo fill isComplemented - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> makeTest isZero toCoo fill isComplemented + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") -let testFixtures case = - let context = case.TestContext.ClContext + let testFixtures case = + let context = case.TestContext.ClContext - let isComplemented = false + let isComplemented = false - [ createTest case ((=) 0) isComplemented Vector.assignByMask + [ createTest case ((=) 0) isComplemented Vector.assignByMask - if Utils.isFloat64Available context.ClDevice then - createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMask + if Utils.isFloat64Available context.ClDevice then + createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMask - createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMask - createTest case ((=) 0uy) isComplemented Vector.assignByMask - createTest case ((=) false) isComplemented Vector.assignByMask ] + createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMask + createTest case ((=) 0uy) isComplemented Vector.assignByMask + createTest case ((=) false) isComplemented Vector.assignByMask ] -let tests = - operationGPUTests "Backend.Vector.assignByMask tests" - <| testFixtures + let tests = + operationGPUTests "Backend.Vector.assignByMask tests" + <| testFixtures -let testFixturesComplemented case = - let context = case.TestContext.ClContext + let testFixturesComplemented case = + let context = case.TestContext.ClContext - let isComplemented = true + let isComplemented = true - [ createTest case ((=) 0) isComplemented Vector.assignByMaskComplemented + [ createTest case ((=) 0) isComplemented Vector.assignByMaskComplemented - if Utils.isFloat64Available context.ClDevice then - createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMaskComplemented + if Utils.isFloat64Available context.ClDevice then + createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMaskComplemented - createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMaskComplemented - createTest case ((=) 0uy) isComplemented Vector.assignByMaskComplemented - createTest case ((=) false) isComplemented Vector.assignByMaskComplemented ] + createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMaskComplemented + createTest case ((=) 0uy) isComplemented Vector.assignByMaskComplemented + createTest case ((=) false) isComplemented Vector.assignByMaskComplemented ] -let complementedTests = - operationGPUTests "Backend.Vector.assignByMaskComplemented tests" - <| testFixturesComplemented + let complementedTests = + operationGPUTests "Backend.Vector.assignByMaskComplemented tests" + <| testFixturesComplemented diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs index 2f586b03..57eccfae 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.Convert +namespace GraphBLAS.FSharp.Tests.Backend.Vector open Expecto open Expecto.Logging @@ -12,94 +12,95 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = - Log.create "Backend.Vector.Convert.Tests" +module Convert = + let logger = + Log.create "Backend.Vector.Convert.Tests" -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let makeTest - formatFrom - (convertFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - isZero - case - (array: 'a []) - = + let makeTest + formatFrom + (convertFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + isZero + case + (array: 'a []) + = - let vector = - Utils.createVectorFromArray formatFrom array isZero + let vector = + Utils.createVectorFromArray formatFrom array isZero - if vector.NNZ > 0 then + if vector.NNZ > 0 then - let context = case.TestContext.ClContext - let q = case.TestContext.Queue - - let actual = - let clVector = vector.ToDevice context - let convertedVector = convertFun q HostInterop clVector - - let res = convertedVector.ToHost q - - clVector.Dispose q - convertedVector.Dispose q - - res + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + let actual = + let clVector = vector.ToDevice context + let convertedVector = convertFun q HostInterop clVector - let expected = - Utils.createVectorFromArray case.Format array isZero + let res = convertedVector.ToHost q - Expect.equal actual expected "Vectors must be the same" + clVector.Dispose q + convertedVector.Dispose q -let testFixtures case = - let getCorrectnessTestName datatype formatFrom = - sprintf $"Correctness on %s{datatype}, %A{formatFrom} -> %A{case.Format}" + res - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - q.Error.Add(fun e -> failwithf "%A" e) + let expected = + Utils.createVectorFromArray case.Format array isZero - match case.Format with - | Sparse -> - [ let convertFun = Vector.toSparse context wgSize + Expect.equal actual expected "Vectors must be the same" - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) 0) case - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + let testFixtures case = + let getCorrectnessTestName datatype formatFrom = + sprintf $"Correctness on %s{datatype}, %A{formatFrom} -> %A{case.Format}" - let convertFun = Vector.toSparse context wgSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) false) case - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | Dense -> - [ let convertFun = Vector.toDense context wgSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) 0) case - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Vector.toDense context wgSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) false) case - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat + let context = case.TestContext.ClContext + let q = case.TestContext.Queue -let tests = - operationGPUTests "Backend.Vector.Convert tests" testFixtures + q.Error.Add(fun e -> failwithf "%A" e) + + match case.Format with + | Sparse -> + [ let convertFun = Vector.toSparse context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) 0) case + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Vector.toSparse context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) false) case + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + | Dense -> + [ let convertFun = Vector.toDense context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) 0) case + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Vector.toDense context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) false) case + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + + let tests = + operationGPUTests "Backend.Vector.Convert tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs b/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs index f5d28ca3..8c9870b0 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.Copy +namespace GraphBLAS.FSharp.Tests.Backend.Vector open Expecto open Expecto.Logging @@ -11,78 +11,79 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Vector.copy.Tests" +module Copy = + let logger = Log.create "Vector.copy.Tests" -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vector<'a>) = - Expect.equal actual.Size expected.Size "The size should be the same" + let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vector<'a>) = + Expect.equal actual.Size expected.Size "The size should be the same" - match actual, expected with - | Vector.Dense actual, Vector.Dense expected -> - let isEqual left right = - match left, right with - | Some left, Some right -> isEqual left right - | None, None -> true - | _, _ -> false + match actual, expected with + | Vector.Dense actual, Vector.Dense expected -> + let isEqual left right = + match left, right with + | Some left, Some right -> isEqual left right + | None, None -> true + | _, _ -> false - Utils.compareArrays isEqual actual expected "The values array must contain the default value" - | Vector.Sparse actual, Vector.Sparse expected -> - Utils.compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" - Utils.compareArrays (=) actual.Indices expected.Indices "The index array must contain the 0" - | _ -> failwith "Copy format must be the same" + Utils.compareArrays isEqual actual expected "The values array must contain the default value" + | Vector.Sparse actual, Vector.Sparse expected -> + Utils.compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" + Utils.compareArrays (=) actual.Indices expected.Indices "The index array must contain the 0" + | _ -> failwith "Copy format must be the same" -let correctnessGenericTest<'a when 'a: struct> - isEqual - zero - (copy: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (case: OperationCase) - (array: 'a []) - = + let correctnessGenericTest<'a when 'a: struct> + isEqual + zero + (copy: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (case: OperationCase) + (array: 'a []) + = - let expected = - Utils.createVectorFromArray case.Format array (isEqual zero) + let expected = + Utils.createVectorFromArray case.Format array (isEqual zero) - if array.Length > 0 && expected.NNZ > 0 then + if array.Length > 0 && expected.NNZ > 0 then - let q = case.TestContext.Queue - let context = case.TestContext.ClContext + let q = case.TestContext.Queue + let context = case.TestContext.ClContext - let clVector = expected.ToDevice context - let clVectorCopy = copy q HostInterop clVector - let actual = clVectorCopy.ToHost q + let clVector = expected.ToDevice context + let clVectorCopy = copy q HostInterop clVector + let actual = clVectorCopy.ToHost q - clVector.Dispose q - clVectorCopy.Dispose q + clVector.Dispose q + clVectorCopy.Dispose q - checkResult isEqual actual expected + checkResult isEqual actual expected -let createTest<'a when 'a: struct> case isEqual zero = - let context = case.TestContext.ClContext + let createTest<'a when 'a: struct> case isEqual zero = + let context = case.TestContext.ClContext - let getCorrectnessTestName datatype = - $"Correctness on %s{datatype}, %A{case.Format}" + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, %A{case.Format}" - let intCopy = Vector.copy context wgSize + let intCopy = Vector.copy context wgSize - case - |> correctnessGenericTest<'a> isEqual zero intCopy - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> correctnessGenericTest<'a> isEqual zero intCopy + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") -let testFixtures (case: OperationCase) = - let context = case.TestContext.ClContext + let testFixtures (case: OperationCase) = + let context = case.TestContext.ClContext - [ createTest case (=) 0 + [ createTest case (=) 0 - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 - createTest case Utils.float32IsEqual 0.0f - createTest case (=) false - createTest case (=) 0uy ] + createTest case Utils.float32IsEqual 0.0f + createTest case (=) false + createTest case (=) 0uy ] -let tests = - operationGPUTests "Backend.Vector.copy tests" testFixtures + let tests = + operationGPUTests "Backend.Vector.copy tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index 33f4a693..504fb578 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.Map2 +namespace GraphBLAS.FSharp.Tests.Backend.Vector open Expecto open Expecto.Logging @@ -12,191 +12,192 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Vector.ElementWise.Tests" +module Map2 = + let logger = Log.create "Vector.ElementWise.Tests" -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let getCorrectnessTestName<'a> (case: OperationCase<'a>) dataType = - $"Correctness on '{dataType} option -> '{dataType} option -> '{dataType} option, {case.Format}" + let getCorrectnessTestName<'a> (case: OperationCase<'a>) dataType = + $"Correctness on '{dataType} option -> '{dataType} option -> '{dataType} option, {case.Format}" -let checkResult isEqual resultZero (op: 'a -> 'b -> 'c) (actual: Vector<'c>) (leftArray: 'a []) (rightArray: 'b []) = + let checkResult isEqual resultZero (op: 'a -> 'b -> 'c) (actual: Vector<'c>) (leftArray: 'a []) (rightArray: 'b []) = - let expectedArrayLength = leftArray.Length + let expectedArrayLength = leftArray.Length - let expectedArray = - Array.create expectedArrayLength resultZero + let expectedArray = + Array.create expectedArrayLength resultZero - for i in 0 .. expectedArrayLength - 1 do - expectedArray.[i] <- op leftArray.[i] rightArray.[i] + for i in 0 .. expectedArrayLength - 1 do + expectedArray.[i] <- op leftArray.[i] rightArray.[i] - let expected = - Utils.createVectorFromArray Dense expectedArray (isEqual resultZero) - |> Utils.vectorToDenseVector + let expected = + Utils.createVectorFromArray Dense expectedArray (isEqual resultZero) + |> Utils.vectorToDenseVector - match actual with - | Vector.Dense actual -> - "arrays must have the same values" - |> Expect.equal actual expected - | _ -> failwith "Vector format must be Sparse." + match actual with + | Vector.Dense actual -> + "arrays must have the same values" + |> Expect.equal actual expected + | _ -> failwith "Vector format must be Sparse." -let correctnessGenericTest - isEqual - zero - op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a>) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - case - (leftArray: 'a [], rightArray: 'a []) - = + let correctnessGenericTest + isEqual + zero + op + (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a>) + (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + case + (leftArray: 'a [], rightArray: 'a []) + = - let isZero = (isEqual zero) + let isZero = (isEqual zero) - let firstVectorHost = - Utils.createVectorFromArray case.Format leftArray isZero + let firstVectorHost = + Utils.createVectorFromArray case.Format leftArray isZero - let secondVectorHost = - Utils.createVectorFromArray case.Format rightArray isZero + let secondVectorHost = + Utils.createVectorFromArray case.Format rightArray isZero - if firstVectorHost.NNZ > 0 - && secondVectorHost.NNZ > 0 then + if firstVectorHost.NNZ > 0 + && secondVectorHost.NNZ > 0 then - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - let firstVector = firstVectorHost.ToDevice context - let secondVector = secondVectorHost.ToDevice context + let firstVector = firstVectorHost.ToDevice context + let secondVector = secondVectorHost.ToDevice context - try - let res = - addFun q HostInterop firstVector secondVector + try + let res = + addFun q HostInterop firstVector secondVector - firstVector.Dispose q - secondVector.Dispose q + firstVector.Dispose q + secondVector.Dispose q - let denseActual = toDense q HostInterop res + let denseActual = toDense q HostInterop res - let actual = denseActual.ToHost q + let actual = denseActual.ToHost q - res.Dispose q - denseActual.Dispose q + res.Dispose q + denseActual.Dispose q - checkResult isEqual zero op actual leftArray rightArray - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual zero op actual leftArray rightArray + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex -let createTest case isEqual (zero: 'a) plus plusQ map2 = - let context = case.TestContext.ClContext + let createTest case isEqual (zero: 'a) plus plusQ map2 = + let context = case.TestContext.ClContext - let map2 = map2 context plusQ wgSize + let map2 = map2 context plusQ wgSize - let intToDense = Vector.toDense context wgSize + let intToDense = Vector.toDense context wgSize - case - |> correctnessGenericTest isEqual zero plus map2 intToDense - |> testPropertyWithConfig config (getCorrectnessTestName case $"%A{typeof<'a>}") + case + |> correctnessGenericTest isEqual zero plus map2 intToDense + |> testPropertyWithConfig config (getCorrectnessTestName case $"%A{typeof<'a>}") -let addTestFixtures case = - let context = case.TestContext.ClContext + let addTestFixtures case = + let context = case.TestContext.ClContext - [ createTest case (=) 0 (+) ArithmeticOperations.intSum Vector.map2 + [ createTest case (=) 0 (+) ArithmeticOperations.intSum Vector.map2 - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSum Vector.map2 + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSum Vector.map2 - createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32Sum Vector.map2 - createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 - createTest case (=) 0uy (+) ArithmeticOperations.byteSum Vector.map2 ] + createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32Sum Vector.map2 + createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 + createTest case (=) 0uy (+) ArithmeticOperations.byteSum Vector.map2 ] -let addTests = - operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures + let addTests = + operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures -let mulTestFixtures case = - let context = case.TestContext.ClContext + let mulTestFixtures case = + let context = case.TestContext.ClContext - [ createTest case (=) 0 (*) ArithmeticOperations.intMul Vector.map2 + [ createTest case (=) 0 (*) ArithmeticOperations.intMul Vector.map2 - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMul Vector.map2 + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMul Vector.map2 - createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32Mul Vector.map2 - createTest case (=) false (&&) ArithmeticOperations.boolMul Vector.map2 - createTest case (=) 0uy (*) ArithmeticOperations.byteMul Vector.map2 ] + createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32Mul Vector.map2 + createTest case (=) false (&&) ArithmeticOperations.boolMul Vector.map2 + createTest case (=) 0uy (*) ArithmeticOperations.byteMul Vector.map2 ] -let mulTests = - operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures + let mulTests = + operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures -let addAtLeastOneTestFixtures case = - let context = case.TestContext.ClContext + let addAtLeastOneTestFixtures case = + let context = case.TestContext.ClContext - [ createTest case (=) 0 (+) ArithmeticOperations.intSumAtLeastOne Vector.map2AtLeastOne + [ createTest case (=) 0 (+) ArithmeticOperations.intSumAtLeastOne Vector.map2AtLeastOne - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumAtLeastOne Vector.map2AtLeastOne + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumAtLeastOne Vector.map2AtLeastOne - createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumAtLeastOne Vector.map2AtLeastOne - createTest case (=) false (||) ArithmeticOperations.boolSumAtLeastOne Vector.map2AtLeastOne - createTest case (=) 0uy (+) ArithmeticOperations.byteSumAtLeastOne Vector.map2AtLeastOne ] + createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumAtLeastOne Vector.map2AtLeastOne + createTest case (=) false (||) ArithmeticOperations.boolSumAtLeastOne Vector.map2AtLeastOne + createTest case (=) 0uy (+) ArithmeticOperations.byteSumAtLeastOne Vector.map2AtLeastOne ] -let addAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2LeastOne add tests" addTestFixtures + let addAtLeastOneTests = + operationGPUTests "Backend.Vector.Map2LeastOne add tests" addTestFixtures -let mulAtLeastOneTestFixtures case = - let context = case.TestContext.ClContext + let mulAtLeastOneTestFixtures case = + let context = case.TestContext.ClContext + + [ createTest case (=) 0 (*) ArithmeticOperations.intMulAtLeastOne Vector.map2AtLeastOne - [ createTest case (=) 0 (*) ArithmeticOperations.intMulAtLeastOne Vector.map2AtLeastOne + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMulAtLeastOne Vector.map2AtLeastOne - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMulAtLeastOne Vector.map2AtLeastOne + createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32MulAtLeastOne Vector.map2AtLeastOne + createTest case (=) false (&&) ArithmeticOperations.boolMulAtLeastOne Vector.map2AtLeastOne + createTest case (=) 0uy (*) ArithmeticOperations.byteMulAtLeastOne Vector.map2AtLeastOne ] - createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32MulAtLeastOne Vector.map2AtLeastOne - createTest case (=) false (&&) ArithmeticOperations.boolMulAtLeastOne Vector.map2AtLeastOne - createTest case (=) 0uy (*) ArithmeticOperations.byteMulAtLeastOne Vector.map2AtLeastOne ] + let mulAtLeastOneTests = + operationGPUTests "Backend.Vector.Map2AtLeasOne mul tests" mulTestFixtures -let mulAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2AtLeasOne mul tests" mulTestFixtures + let fillSubVectorComplementedQ<'a, 'b> value = + <@ fun (left: 'a option) (right: 'b option) -> + match left with + | None -> Some value + | _ -> right @> -let fillSubVectorComplementedQ<'a, 'b> value = - <@ fun (left: 'a option) (right: 'b option) -> - match left with - | None -> Some value - | _ -> right @> + let fillSubVectorFun value zero isEqual = + fun left right -> + if isEqual left zero then + value + else + right -let fillSubVectorFun value zero isEqual = - fun left right -> - if isEqual left zero then - value - else - right + let complementedGeneralTestFixtures case = + let context = case.TestContext.ClContext -let complementedGeneralTestFixtures case = - let context = case.TestContext.ClContext + [ createTest case (=) 0 (fillSubVectorFun 1 0 (=)) (fillSubVectorComplementedQ 1) Vector.map2 - [ createTest case (=) 0 (fillSubVectorFun 1 0 (=)) (fillSubVectorComplementedQ 1) Vector.map2 + if Utils.isFloat64Available context.ClDevice then + createTest + case + Utils.floatIsEqual + 0.0 + (fillSubVectorFun 1.0 0.0 Utils.floatIsEqual) + (fillSubVectorComplementedQ 1.0) + Vector.map2 - if Utils.isFloat64Available context.ClDevice then createTest case - Utils.floatIsEqual - 0.0 - (fillSubVectorFun 1.0 0.0 Utils.floatIsEqual) - (fillSubVectorComplementedQ 1.0) + Utils.float32IsEqual + 0.0f + (fillSubVectorFun 1.0f 0.0f Utils.float32IsEqual) + (fillSubVectorComplementedQ 1.0f) Vector.map2 - createTest - case - Utils.float32IsEqual - 0.0f - (fillSubVectorFun 1.0f 0.0f Utils.float32IsEqual) - (fillSubVectorComplementedQ 1.0f) - Vector.map2 - - createTest case (=) false (fillSubVectorFun true false (=)) (fillSubVectorComplementedQ true) Vector.map2 + createTest case (=) false (fillSubVectorFun true false (=)) (fillSubVectorComplementedQ true) Vector.map2 - createTest case (=) 0uy (fillSubVectorFun 1uy 0uy (=)) (fillSubVectorComplementedQ 1uy) Vector.map2 ] + createTest case (=) 0uy (fillSubVectorFun 1uy 0uy (=)) (fillSubVectorComplementedQ 1uy) Vector.map2 ] -let complementedGeneralTests = - operationGPUTests "Backend.Vector.Map2Gen mask tests" complementedGeneralTestFixtures + let complementedGeneralTests = + operationGPUTests "Backend.Vector.Map2Gen mask tests" complementedGeneralTestFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs index 6bc5a392..59fab292 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.OfList +namespace GraphBLAS.FSharp.Tests.Backend.Vector open Expecto open Expecto.Logging @@ -12,93 +12,94 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Vector.ofList.Tests" +module OfList = + let logger = Log.create "Vector.ofList.Tests" -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let checkResult - (isEqual: 'a -> 'a -> bool) - (expectedIndices: int []) - (expectedValues: 'a []) - (actual: Vector<'a>) - actualSize - = + let checkResult + (isEqual: 'a -> 'a -> bool) + (expectedIndices: int []) + (expectedValues: 'a []) + (actual: Vector<'a>) + actualSize + = - Expect.equal actual.Size actualSize "lengths must be the same" + Expect.equal actual.Size actualSize "lengths must be the same" - match actual with - | Vector.Sparse actual -> - Utils.compareArrays (=) actual.Indices expectedIndices "indices must be the same" - Utils.compareArrays isEqual actual.Values expectedValues "values must be the same" - | _ -> failwith "Vector format must be Sparse." + match actual with + | Vector.Sparse actual -> + Utils.compareArrays (=) actual.Indices expectedIndices "indices must be the same" + Utils.compareArrays isEqual actual.Values expectedValues "values must be the same" + | _ -> failwith "Vector format must be Sparse." -let correctnessGenericTest<'a when 'a: struct> - (isEqual: 'a -> 'a -> bool) - (ofList: MailboxProcessor<_> -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) - (toCoo: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (case: OperationCase) - (elements: (int * 'a) []) - (sizeDelta: int) - = + let correctnessGenericTest<'a when 'a: struct> + (isEqual: 'a -> 'a -> bool) + (ofList: MailboxProcessor<_> -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) + (toCoo: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (case: OperationCase) + (elements: (int * 'a) []) + (sizeDelta: int) + = - let elements = - elements |> Array.distinctBy fst |> List.ofArray + let elements = + elements |> Array.distinctBy fst |> List.ofArray - if elements.Length > 0 then + if elements.Length > 0 then - let q = case.TestContext.Queue + let q = case.TestContext.Queue - let indices, values = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip + let indices, values = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip - let actualSize = (Array.max indices) + abs sizeDelta + 1 + let actualSize = (Array.max indices) + abs sizeDelta + 1 - let clActual = - ofList q HostInterop case.Format actualSize elements + let clActual = + ofList q HostInterop case.Format actualSize elements - let clCooActual = toCoo q HostInterop clActual + let clCooActual = toCoo q HostInterop clActual - let actual = clCooActual.ToHost q + let actual = clCooActual.ToHost q - clActual.Dispose q - clCooActual.Dispose q + clActual.Dispose q + clCooActual.Dispose q - checkResult isEqual indices values actual actualSize + checkResult isEqual indices values actual actualSize -let creatTest<'a> case = - let getCorrectnessTestName datatype = - $"Correctness on %s{datatype}, %A{datatype}, %A{case.Format}" + let creatTest<'a> case = + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, %A{datatype}, %A{case.Format}" - let context = case.TestContext.ClContext + let context = case.TestContext.ClContext - let boolOfList = Vector.ofList context wgSize + let boolOfList = Vector.ofList context wgSize - let toCoo = Vector.toSparse context wgSize + let toCoo = Vector.toSparse context wgSize - case - |> correctnessGenericTest (=) boolOfList toCoo - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> correctnessGenericTest (=) boolOfList toCoo + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") -let testFixtures (case: OperationCase) = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let testFixtures (case: OperationCase) = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf $"%A{e}") + q.Error.Add(fun e -> failwithf $"%A{e}") - creatTest case - creatTest case - creatTest case + creatTest case + creatTest case + creatTest case - if Utils.isFloat64Available context.ClDevice then - creatTest case + if Utils.isFloat64Available context.ClDevice then + creatTest case - creatTest case ] + creatTest case ] -let tests = - operationGPUTests "Backend.Vector.ofList tests" testFixtures + let tests = + operationGPUTests "Backend.Vector.ofList tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs index cfbca46b..3c759387 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.Reduce +namespace GraphBLAS.FSharp.Tests.Backend.Vector open Expecto open Expecto.Logging @@ -10,86 +10,87 @@ open TestCases open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Vector -let logger = Log.create "Vector.reduce.Tests" +module Reduce = + let logger = Log.create "Vector.reduce.Tests" -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let checkResult zero op (actual: 'a) (vector: 'a []) = - let expected = Array.fold op zero vector + let checkResult zero op (actual: 'a) (vector: 'a []) = + let expected = Array.fold op zero vector - "Results should be the same" - |> Expect.equal actual expected + "Results should be the same" + |> Expect.equal actual expected -let correctnessGenericTest - isEqual - zero - op - opQ - (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) - case - (array: 'a []) - = + let correctnessGenericTest + isEqual + zero + op + opQ + (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) + case + (array: 'a []) + = - let vector = - Utils.createVectorFromArray case.Format array (isEqual zero) + let vector = + Utils.createVectorFromArray case.Format array (isEqual zero) - if vector.NNZ > 0 then - let q = case.TestContext.Queue - let context = case.TestContext.ClContext + if vector.NNZ > 0 then + let q = case.TestContext.Queue + let context = case.TestContext.ClContext - let clVector = vector.ToDevice context + let clVector = vector.ToDevice context - let resultCell = reduce opQ q clVector + let resultCell = reduce opQ q clVector - let result = Array.zeroCreate 1 + let result = Array.zeroCreate 1 - let result = - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) + let result = + let res = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - q.Post(Msg.CreateFreeMsg<_>(resultCell)) + q.Post(Msg.CreateFreeMsg<_>(resultCell)) - res.[0] + res.[0] - checkResult zero op result array + checkResult zero op result array -let createTest<'a when 'a: equality and 'a: struct> case isEqual (zero: 'a) plus plusQ name = - let context = case.TestContext.ClContext + let createTest<'a when 'a: equality and 'a: struct> case isEqual (zero: 'a) plus plusQ name = + let context = case.TestContext.ClContext - let reduce = Vector.reduce context wgSize + let reduce = Vector.reduce context wgSize - case - |> correctnessGenericTest isEqual zero plus plusQ reduce - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}, %s{name} %A{case.Format}" + case + |> correctnessGenericTest isEqual zero plus plusQ reduce + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}, %s{name} %A{case.Format}" -let testFixtures case = + let testFixtures case = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest case (=) 0 (+) <@ (+) @> "add" - createTest case (=) 0uy (+) <@ (+) @> "add" - createTest case (=) System.Int32.MinValue max <@ max @> "max" + [ createTest case (=) 0 (+) <@ (+) @> "add" + createTest case (=) 0uy (+) <@ (+) @> "add" + createTest case (=) System.Int32.MinValue max <@ max @> "max" - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual System.Double.MinValue max <@ max @> "max" + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual System.Double.MinValue max <@ max @> "max" - createTest case Utils.float32IsEqual System.Single.MinValue max <@ max @> "max" - createTest case (=) System.Byte.MinValue max <@ max @> "max" - createTest case (=) System.Int32.MaxValue min <@ min @> "min" + createTest case Utils.float32IsEqual System.Single.MinValue max <@ max @> "max" + createTest case (=) System.Byte.MinValue max <@ max @> "max" + createTest case (=) System.Int32.MaxValue min <@ min @> "min" - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual System.Double.MaxValue min <@ min @> "min" + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual System.Double.MaxValue min <@ min @> "min" - createTest case Utils.float32IsEqual System.Single.MaxValue min <@ min @> "min" - createTest case (=) System.Byte.MaxValue min <@ min @> "min" - createTest case (=) false (||) <@ (||) @> "add" - createTest case (=) true (&&) <@ (&&) @> "multiply" ] + createTest case Utils.float32IsEqual System.Single.MaxValue min <@ min @> "min" + createTest case (=) System.Byte.MaxValue min <@ min @> "min" + createTest case (=) false (||) <@ (||) @> "add" + createTest case (=) true (&&) <@ (&&) @> "multiply" ] -let tests = - operationGPUTests "Reduce tests" testFixtures + let tests = + operationGPUTests "Reduce tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 90d90ef4..3339989f 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.SpMV +namespace GraphBLAS.FSharp.Tests.Backend.Vector open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Expecto @@ -14,120 +14,121 @@ open GraphBLAS.FSharp.Backend.Vector open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects.ClContext -let config = Utils.defaultConfig +module SpMV = + let config = Utils.defaultConfig + + let wgSize = Utils.defaultWorkGroupSize -let wgSize = Utils.defaultWorkGroupSize + let checkResult isEqual sumOp mulOp zero (baseMtx: 'a [,]) (baseVtr: 'a []) (actual: 'a option []) = + let rows = Array2D.length1 baseMtx + let columns = Array2D.length2 baseMtx -let checkResult isEqual sumOp mulOp zero (baseMtx: 'a [,]) (baseVtr: 'a []) (actual: 'a option []) = - let rows = Array2D.length1 baseMtx - let columns = Array2D.length2 baseMtx + let expected = Array.create rows zero - let expected = Array.create rows zero + for i in 0 .. rows - 1 do + let mutable sum = zero - for i in 0 .. rows - 1 do - let mutable sum = zero + for v in 0 .. columns - 1 do + sum <- sumOp sum (mulOp baseMtx.[i, v] baseVtr.[v]) - for v in 0 .. columns - 1 do - sum <- sumOp sum (mulOp baseMtx.[i, v] baseVtr.[v]) + expected.[i] <- sum - expected.[i] <- sum + for i in 0 .. actual.Size - 1 do + match actual.[i] with + | Some v -> + if isEqual zero v then + failwith "Resulting zeroes should be implicit." + | None -> () - for i in 0 .. actual.Size - 1 do - match actual.[i] with - | Some v -> - if isEqual zero v then - failwith "Resulting zeroes should be implicit." - | None -> () + for i in 0 .. actual.Size - 1 do + match actual.[i] with + | Some v -> + Expect.isTrue (isEqual v expected.[i]) $"Values should be the same. Actual is {v}, expected {expected.[i]}." + | None -> + Expect.isTrue + (isEqual zero expected.[i]) + $"Values should be the same. Actual is {zero}, expected {expected.[i]}." - for i in 0 .. actual.Size - 1 do - match actual.[i] with - | Some v -> - Expect.isTrue (isEqual v expected.[i]) $"Values should be the same. Actual is {v}, expected {expected.[i]}." - | None -> - Expect.isTrue - (isEqual zero expected.[i]) - $"Values should be the same. Actual is {zero}, expected {expected.[i]}." + let correctnessGenericTest + zero + sumOp + mulOp + (spMV: MailboxProcessor<_> -> AllocationFlag -> ClMatrix.CSR<'a> -> ClArray<'a option> -> ClArray<'a option>) + (isEqual: 'a -> 'a -> bool) + q + (testContext: TestContext) + (matrix: 'a [,], vector: 'a [], _: bool []) + = -let correctnessGenericTest - zero - sumOp - mulOp - (spMV: MailboxProcessor<_> -> AllocationFlag -> ClMatrix.CSR<'a> -> ClArray<'a option> -> ClArray<'a option>) - (isEqual: 'a -> 'a -> bool) - q - (testContext: TestContext) - (matrix: 'a [,], vector: 'a [], _: bool []) - = + let mtx = + Utils.createMatrixFromArray2D CSR matrix (isEqual zero) - let mtx = - Utils.createMatrixFromArray2D CSR matrix (isEqual zero) + let vtr = + Utils.createVectorFromArray Dense vector (isEqual zero) - let vtr = - Utils.createVectorFromArray Dense vector (isEqual zero) + if mtx.NNZ > 0 && vtr.Size > 0 then + try + let m = mtx.ToDevice testContext.ClContext - if mtx.NNZ > 0 && vtr.Size > 0 then - try - let m = mtx.ToDevice testContext.ClContext + match vtr, m with + | Vector.Dense vtr, ClMatrix.CSR m -> + let v = vtr.ToDevice testContext.ClContext - match vtr, m with - | Vector.Dense vtr, ClMatrix.CSR m -> - let v = vtr.ToDevice testContext.ClContext + let res = spMV testContext.Queue HostInterop m v - let res = spMV testContext.Queue HostInterop m v + (ClMatrix.CSR m).Dispose q + v.Dispose q + let hostRes = res.ToHost q + res.Dispose q - (ClMatrix.CSR m).Dispose q - v.Dispose q - let hostRes = res.ToHost q - res.Dispose q + checkResult isEqual sumOp mulOp zero matrix vector hostRes + | _ -> failwith "Impossible" + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex - checkResult isEqual sumOp mulOp zero matrix vector hostRes - | _ -> failwith "Impossible" - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = + let context = testContext.ClContext + let q = testContext.Queue -let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = - let context = testContext.ClContext - let q = testContext.Queue + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, %A{testContext.ClContext}" - let getCorrectnessTestName datatype = - $"Correctness on %s{datatype}, %A{testContext.ClContext}" + let spMV = SpMV.run context addQ mulQ wgSize - let spMV = SpMV.run context addQ mulQ wgSize + testContext + |> correctnessGenericTest zero add mul spMV isEqual q + |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") - testContext - |> correctnessGenericTest zero add mul spMV isEqual q - |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") + let testFixturesSpMV (testContext: TestContext) = + [ let context = testContext.ClContext + let q = testContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) -let testFixturesSpMV (testContext: TestContext) = - [ let context = testContext.ClContext - let q = testContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMul + createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSum ArithmeticOperations.intMul - createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMul - createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSum ArithmeticOperations.intMul + if Utils.isFloat64Available context.ClDevice then + createTest + testContext + 0.0 + Utils.floatIsEqual + (+) + (*) + ArithmeticOperations.floatSum + ArithmeticOperations.floatMul - if Utils.isFloat64Available context.ClDevice then createTest testContext - 0.0 - Utils.floatIsEqual + 0.0f + Utils.float32IsEqual (+) (*) - ArithmeticOperations.floatSum - ArithmeticOperations.floatMul - - createTest - testContext - 0.0f - Utils.float32IsEqual - (+) - (*) - ArithmeticOperations.float32Sum - ArithmeticOperations.float32Mul - - createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSum ArithmeticOperations.byteMul ] - -let tests = - gpuTests "Backend.Vector.SpMV tests" testFixturesSpMV + ArithmeticOperations.float32Sum + ArithmeticOperations.float32Mul + + createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSum ArithmeticOperations.byteMul ] + + let tests = + gpuTests "Backend.Vector.SpMV tests" testFixturesSpMV diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs index 313e0066..a7e59b7a 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Vector.ZeroCreate +namespace GraphBLAS.FSharp.Tests.Backend.Vector open Expecto open Expecto.Logging @@ -12,70 +12,71 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -let logger = Log.create "Vector.zeroCreate.Tests" +module ZeroCreate = + let logger = Log.create "Vector.zeroCreate.Tests" -let config = Utils.defaultConfig + let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize + let wgSize = Utils.defaultWorkGroupSize -let checkResult size (actual: Vector<'a>) = - Expect.equal actual.Size size "The size should be the same" + let checkResult size (actual: Vector<'a>) = + Expect.equal actual.Size size "The size should be the same" - match actual with - | Vector.Dense vector -> - Array.iter - <| (fun item -> Expect.equal item None "values must be None") - <| vector - | Vector.Sparse vector -> - Expect.equal vector.Values [| Unchecked.defaultof<'a> |] "The values array must contain the default value" - Expect.equal vector.Indices [| 0 |] "The index array must contain the 0" + match actual with + | Vector.Dense vector -> + Array.iter + <| (fun item -> Expect.equal item None "values must be None") + <| vector + | Vector.Sparse vector -> + Expect.equal vector.Values [| Unchecked.defaultof<'a> |] "The values array must contain the default value" + Expect.equal vector.Indices [| 0 |] "The index array must contain the 0" -let correctnessGenericTest<'a when 'a: struct and 'a: equality> - (zeroCreate: MailboxProcessor<_> -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) - (case: OperationCase) - (vectorSize: int) - = + let correctnessGenericTest<'a when 'a: struct and 'a: equality> + (zeroCreate: MailboxProcessor<_> -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) + (case: OperationCase) + (vectorSize: int) + = - let vectorSize = abs vectorSize + let vectorSize = abs vectorSize - if vectorSize > 0 then - let q = case.TestContext.Queue + if vectorSize > 0 then + let q = case.TestContext.Queue - let clVector = - zeroCreate q HostInterop vectorSize case.Format + let clVector = + zeroCreate q HostInterop vectorSize case.Format - let hostVector = clVector.ToHost q + let hostVector = clVector.ToHost q - clVector.Dispose q + clVector.Dispose q - checkResult vectorSize hostVector + checkResult vectorSize hostVector -let createTest<'a> case = - let getCorrectnessTestName dataType = - $"Correctness on %A{dataType}, %A{case.Format}" + let createTest<'a> case = + let getCorrectnessTestName dataType = + $"Correctness on %A{dataType}, %A{case.Format}" - let context = case.TestContext.ClContext + let context = case.TestContext.ClContext - let intZeroCreate = Vector.zeroCreate context wgSize + let intZeroCreate = Vector.zeroCreate context wgSize - case - |> correctnessGenericTest intZeroCreate - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> correctnessGenericTest intZeroCreate + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") -let testFixtures case = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let testFixtures case = + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest case - createTest case + [ createTest case + createTest case - if Utils.isFloat64Available context.ClDevice then - createTest case + if Utils.isFloat64Available context.ClDevice then + createTest case - createTest case - createTest case ] + createTest case + createTest case ] -let tests = - operationGPUTests "Backend.Vector.zeroCreate tests" testFixtures + let tests = + operationGPUTests "Backend.Vector.zeroCreate tests" testFixtures From bca2cf63ddff82198a5e31f371ce590133f2555a Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 16:16:02 +0300 Subject: [PATCH 020/143] refactor: formatting --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 146 ++++++++++++++---- .../GraphBLAS-sharp.Backend.fsproj | 4 +- .../Quotes/PreparePositions.fs | 8 +- src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 2 +- .../Common/Reduce/ReduceByKey.fs | 44 +++--- .../GraphBLAS-sharp.Tests.fsproj | 6 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 26 ++-- tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 16 +- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- .../Vector/AssignByMask.fs | 7 +- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 9 +- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 4 +- 12 files changed, 192 insertions(+), 82 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 2a1130b7..405356e7 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -5,10 +5,12 @@ open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Reduce = + /// + /// Generalized reduction pattern. + /// let private runGeneral (clContext: ClContext) workGroupSize scan scanToCell = fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> @@ -47,8 +49,8 @@ module Reduce = let result = scanToCell processor fstVertices verticesLength - processor.Post(Msg.CreateFreeMsg(firstVerticesArray)) - processor.Post(Msg.CreateFreeMsg(secondVerticesArray)) + firstVerticesArray.Free processor + secondVerticesArray.Free processor result @@ -129,6 +131,13 @@ module Reduce = resultCell + /// + /// Summarize array elements. + /// + /// ClContext. + /// Work group size. + /// Summation operation. + /// Neutral element for summation. let sum (clContext: ClContext) workGroupSize op zero = let scan = scanSum clContext workGroupSize op zero @@ -226,6 +235,12 @@ module Reduce = resultCell + /// + /// Reduce an array of values. + /// + /// ClContext. + /// Work group size. + /// Reduction operation. let reduce (clContext: ClContext) workGroupSize op = let scan = scanReduce clContext workGroupSize op @@ -238,7 +253,19 @@ module Reduce = fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array + /// + /// Reduction of an array of values by an array of keys. + /// module ByKey = + /// + /// Reduce an array of values by key using a single work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = let kernel = @@ -246,43 +273,59 @@ module Reduce = let gid = ndRange.GlobalID0 - if gid = 0 then - let mutable currentKey = keys.[0] - let mutable segmentResult = values.[0] - let mutable segmentCount = 0 + if gid = 0 then + let mutable currentKey = keys.[0] + let mutable segmentResult = values.[0] + let mutable segmentCount = 0 - for i in 1 .. length - 1 do - if currentKey = keys.[i] then - segmentResult <- (%reduceOp) segmentResult values.[i] - else - reducedValues.[segmentCount] <- segmentResult - reducedKeys.[segmentCount] <- currentKey + for i in 1 .. length - 1 do + if currentKey = keys.[i] then + segmentResult <- (%reduceOp) segmentResult values.[i] + else + reducedValues.[segmentCount] <- segmentResult + reducedKeys.[segmentCount] <- currentKey - segmentCount <- segmentCount + 1 - currentKey <- keys.[i] - segmentResult <- values.[i] + segmentCount <- segmentCount + 1 + currentKey <- keys.[i] + segmentResult <- values.[i] - reducedKeys.[segmentCount] <- currentKey - reducedValues.[segmentCount] <- segmentResult @> + reducedKeys.[segmentCount] <- currentKey + reducedValues.[segmentCount] <- segmentResult @> let kernel = clContext.Compile kernel fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> - let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let reducedKeys = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys)) + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) reducedKeys, reducedValues + + /// + /// Reduces values by key. Each segment is reduced by one working item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// let segmentSequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = let kernel = @@ -311,20 +354,45 @@ module Reduce = fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> - let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let reducedKeys = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange resultLength keys.Length offsets keys values reducedValues reducedKeys)) + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + keys.Length + offsets + keys + values + reducedValues + reducedKeys) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) reducedKeys, reducedValues + /// + /// Reduces values by key. One working group participates in the reduction. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// Reduces an array of values that does not exceed the size of the workgroup. + /// The length of the result must be calculated in advance. + /// let oneWorkGroupSegments (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = let kernel = @@ -334,11 +402,15 @@ module Reduce = // load values to local memory (may be without it) let localValues = localArray<'a> workGroupSize - if lid < length then localValues.[lid] <- values.[lid] + + if lid < length then + localValues.[lid] <- values.[lid] // load keys to local memory (mb without it) let localKeys = localArray workGroupSize - if lid < length then localKeys.[lid] <- keys.[lid] + + if lid < length then + localKeys.[lid] <- keys.[lid] // get unique keys bitmap let localBitmap = localArray workGroupSize @@ -377,19 +449,25 @@ module Reduce = let kernel = clContext.Compile kernel fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> - if keys.Length > workGroupSize then failwith "The length of the value should not exceed the size of the workgroup" + if keys.Length > workGroupSize then + failwith "The length of the value should not exceed the size of the workgroup" - let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let reducedKeys = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let ndRange = Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys)) + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) reducedKeys, reducedValues - diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 01654c1d..c40576ad 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -26,12 +26,12 @@ - + - + diff --git a/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs b/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs index 33bcec1d..d219e7ec 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/PreparePositions.fs @@ -28,7 +28,7 @@ module PreparePositions = rawPositionsBuffer.[index] <- 1 | None -> rawPositionsBuffer.[index] <- 0 @> - let getUniqueBitmapLocal<'a when 'a : equality> = + let getUniqueBitmapLocal<'a when 'a: equality> = <@ fun (array: 'a []) length lid (result: int []) -> if lid < length then let isFirst = lid = 0 @@ -36,5 +36,7 @@ module PreparePositions = let isNotEqualToPrev = array.[lid] <> array.[lid - 1] let isUnique = lid > 0 && isNotEqualToPrev - if isFirst || isUnique then result.[lid] <- 1 else result.[lid] <- 0 @> - + if isFirst || isUnique then + result.[lid] <- 1 + else + result.[lid] <- 0 @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index a0d6f45b..89d93659 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -56,7 +56,7 @@ module Search = /// /// Find lower position of item in array. /// - let lowerPosition<'a when 'a : equality and 'a: comparison> = + let lowerPosition<'a when 'a: equality and 'a: comparison> = <@ fun lenght sourceItem (keys: 'a []) -> let mutable leftEdge = 0 diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 9f8eb54b..245f97f5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -16,7 +16,8 @@ module ByKey = let checkResult isEqual actualKeys actualValues keys values reduceOp = - let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp + let expectedKeys, expectedValues = + HostPrimitives.reduceByKey keys values reduceOp "Keys must be the same" |> Utils.compareArrays (=) actualKeys expectedKeys @@ -26,8 +27,7 @@ module ByKey = let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let keys, values = - Array.sortBy fst arrayAndKeys - |> Array.unzip + Array.sortBy fst arrayAndKeys |> Array.unzip if keys.Length > 0 then let clKeys = @@ -38,8 +38,8 @@ module ByKey = let resultLength = Array.length <| Array.distinct keys - let clActualKeys, clActualValues: ClArray * ClArray<'a> - = reduce processor HostInterop resultLength clKeys clValues + let clActualKeys, clActualValues: ClArray * ClArray<'a> = + reduce processor HostInterop resultLength clKeys clValues clValues.Free processor clKeys.Free processor @@ -65,7 +65,7 @@ module ByKey = createTestSequential (=) (+) <@ (+) @> if Utils.isFloat64Available context.ClDevice then - createTestSequential Utils.floatIsEqual (+) <@ (+) @> + createTestSequential Utils.floatIsEqual (+) <@ (+) @> createTestSequential Utils.float32IsEqual (+) <@ (+) @> createTestSequential (=) (||) <@ (||) @> ] @@ -77,19 +77,22 @@ module ByKey = createTestSequential (=) (*) <@ (*) @> if Utils.isFloat64Available context.ClDevice then - createTestSequential Utils.floatIsEqual (*) <@ (*) @> + createTestSequential Utils.floatIsEqual (*) <@ (*) @> createTestSequential Utils.float32IsEqual (*) <@ (*) @> createTestSequential (=) (&&) <@ (&&) @> ] - testList "Sequential" [addTests; mulTests] + testList "Sequential" [ addTests; mulTests ] let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ makeTest isEqual reduce reduceOp - |> testPropertyWithConfig { config with endSize = Utils.defaultWorkGroupSize } $"test on {typeof<'a>}" + |> testPropertyWithConfig + { config with + endSize = Utils.defaultWorkGroupSize } + $"test on {typeof<'a>}" let oneWorkGroupTest = let addTests = @@ -99,7 +102,7 @@ module ByKey = createTestOneWorkGroup (=) (+) <@ (+) @> if Utils.isFloat64Available context.ClDevice then - createTestOneWorkGroup Utils.floatIsEqual (+) <@ (+) @> + createTestOneWorkGroup Utils.floatIsEqual (+) <@ (+) @> createTestOneWorkGroup Utils.float32IsEqual (+) <@ (+) @> createTestOneWorkGroup (=) (||) <@ (||) @> ] @@ -111,12 +114,12 @@ module ByKey = createTestOneWorkGroup (=) (*) <@ (*) @> if Utils.isFloat64Available context.ClDevice then - createTestOneWorkGroup Utils.floatIsEqual (*) <@ (*) @> + createTestOneWorkGroup Utils.floatIsEqual (*) <@ (*) @> createTestOneWorkGroup Utils.float32IsEqual (*) <@ (*) @> createTestOneWorkGroup (=) (&&) <@ (&&) @> ] - testList "One work group" [addTests; mulTests] + testList "One work group" [ addTests; mulTests ] let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a) []) = @@ -132,7 +135,8 @@ module ByKey = let keys, values = Array.unzip valuesAndKeys - let clOffsets = context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) let clKeys = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) @@ -164,7 +168,7 @@ module ByKey = createTestSequentialSegments (=) (+) <@ (+) @> if Utils.isFloat64Available context.ClDevice then - createTestSequentialSegments Utils.floatIsEqual (+) <@ (+) @> + createTestSequentialSegments Utils.floatIsEqual (+) <@ (+) @> createTestSequentialSegments Utils.float32IsEqual (+) <@ (+) @> createTestSequentialSegments (=) (||) <@ (||) @> ] @@ -176,17 +180,9 @@ module ByKey = createTestSequentialSegments (=) (*) <@ (*) @> if Utils.isFloat64Available context.ClDevice then - createTestSequentialSegments Utils.floatIsEqual (*) <@ (*) @> + createTestSequentialSegments Utils.floatIsEqual (*) <@ (*) @> createTestSequentialSegments Utils.float32IsEqual (*) <@ (*) @> createTestSequentialSegments (=) (&&) <@ (&&) @> ] - testList "Sequential segments" [addTests; mulTests] - - - - - - - - + testList "Sequential segments" [ addTests; mulTests ] diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 7d2534bd..e36c1ceb 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -26,9 +26,9 @@ - - - + + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 5d955de9..d29dfe3e 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -143,19 +143,24 @@ module Utils = module HostPrimitives = let prefixSumInclude array = Array.scan (+) 0 array - |> fun scanned -> scanned.[1 ..] + |> fun scanned -> scanned.[1..] let prefixSumExclude sourceArray = prefixSumInclude sourceArray |> Array.insertAt 0 0 - |> fun array -> - Array.take sourceArray.Length array, Array.last array + |> fun array -> Array.take sourceArray.Length array, Array.last array let getUniqueBitmapLastOccurrence array = Array.pairwise array |> fun pairs -> - Array.init array.Length (fun index -> - if index = array.Length - 1 || fst pairs.[index] <> snd pairs.[index] then 1 else 0) + Array.init + array.Length + (fun index -> + if index = array.Length - 1 + || fst pairs.[index] <> snd pairs.[index] then + 1 + else + 0) let getUniqueBitmapFirstOccurrence (sourceArray: _ []) = let resultArray = Array.zeroCreate sourceArray.Length @@ -168,16 +173,19 @@ module HostPrimitives = let getBitPositions bitmap = bitmap - |> Array.mapi (fun index bit -> if bit = 1 then Some index else None ) + |> Array.mapi (fun index bit -> if bit = 1 then Some index else None) |> Array.choose id let reduceByKey keys value reduceOp = let zipped = Array.zip keys value Array.distinct keys - |> Array.map (fun key -> - // extract elements corresponding to key - (key, Array.map snd <| Array.filter ((=) key << fst) zipped)) + |> Array.map + (fun key -> + // extract elements corresponding to key + (key, + Array.map snd + <| Array.filter ((=) key << fst) zipped)) // reduce elements |> Array.map (fun (key, values) -> key, Array.reduce reduceOp values) |> Array.unzip diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index 952b406d..03b13791 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -134,7 +134,13 @@ module Map2 = creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOne if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSumAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add + case + 0.0 + (+) + Utils.floatIsEqual + ArithmeticOperations.floatSumAtLeastOne + Matrix.map2AtLeastOne creatTestMap2Add case @@ -189,7 +195,13 @@ module Map2 = creatTestMap2Add case 0 (*) (=) ArithmeticOperations.intMulAtLeastOne Matrix.map2AtLeastOne if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (*) Utils.floatIsEqual ArithmeticOperations.floatMulAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add + case + 0.0 + (*) + Utils.floatIsEqual + ArithmeticOperations.floatMulAtLeastOne + Matrix.map2AtLeastOne creatTestMap2Add case diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index e7021adc..11b8ee87 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -21,7 +21,7 @@ let commonTests = Common.Reduce.ByKey.sequentialSegmentTests Common.Reduce.ByKey.oneWorkGroupTest Common.Reduce.Reduce.tests - Common.Reduce.Sum.tests] + Common.Reduce.Sum.tests ] let clArrayTests = testList diff --git a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs index f0194486..31455fd8 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs @@ -53,7 +53,12 @@ module AssignByMask = let makeTest<'a when 'a: struct and 'a: equality> (isZero: 'a -> bool) (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (fillVector: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClCell<'a> -> ClVector<'a>) + (fillVector: MailboxProcessor + -> AllocationFlag + -> ClVector<'a> + -> ClVector<'a> + -> ClCell<'a> + -> ClVector<'a>) isComplemented case (vector: 'a [], mask: 'a [], value: 'a) diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index 504fb578..909f6ceb 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -22,7 +22,14 @@ module Map2 = let getCorrectnessTestName<'a> (case: OperationCase<'a>) dataType = $"Correctness on '{dataType} option -> '{dataType} option -> '{dataType} option, {case.Format}" - let checkResult isEqual resultZero (op: 'a -> 'b -> 'c) (actual: Vector<'c>) (leftArray: 'a []) (rightArray: 'b []) = + let checkResult + isEqual + resultZero + (op: 'a -> 'b -> 'c) + (actual: Vector<'c>) + (leftArray: 'a []) + (rightArray: 'b []) + = let expectedArrayLength = leftArray.Length diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 3339989f..e4880d9a 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -43,7 +43,9 @@ module SpMV = for i in 0 .. actual.Size - 1 do match actual.[i] with | Some v -> - Expect.isTrue (isEqual v expected.[i]) $"Values should be the same. Actual is {v}, expected {expected.[i]}." + Expect.isTrue + (isEqual v expected.[i]) + $"Values should be the same. Actual is {v}, expected {expected.[i]}." | None -> Expect.isTrue (isEqual zero expected.[i]) From 24cb1650571fa26879ad4ac62f22bbfdac66d0d6 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 16:21:41 +0300 Subject: [PATCH 021/143] refactor: comments --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 405356e7..bbfa8af9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -316,9 +316,8 @@ module Reduce = reducedKeys, reducedValues - /// - /// Reduces values by key. Each segment is reduced by one working item. + /// Reduces values by key. Each segment is reduced by one work item. /// /// ClContext. /// Work group size. @@ -384,7 +383,7 @@ module Reduce = reducedKeys, reducedValues /// - /// Reduces values by key. One working group participates in the reduction. + /// Reduces values by key. One work group participates in the reduction. /// /// ClContext. /// Work group size. From 7b2ca8156db0d813593655ac64a954b73dffbfd8 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 16:32:40 +0300 Subject: [PATCH 022/143] refactor: comments in search module --- src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index 89d93659..00cd8e0a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -4,8 +4,12 @@ open Brahma.FSharp module Search = module Bin = + /// + /// Searches value in array by key. + /// In case there is a value at the given key position, it is returned. + /// let byKey<'a> = - <@ fun lenght sourceIndex (indices: ClArray) (values: ClArray<'a>) -> + <@ fun lenght sourceIndex (keys: ClArray) (values: ClArray<'a>) -> let mutable leftEdge = 0 let mutable rightEdge = lenght - 1 @@ -14,7 +18,7 @@ module Search = while leftEdge <= rightEdge do let middleIdx = (leftEdge + rightEdge) / 2 - let currentIndex = indices.[middleIdx] + let currentIndex = keys.[middleIdx] if sourceIndex = currentIndex then result <- Some values.[middleIdx] @@ -27,6 +31,10 @@ module Search = result @> + /// + /// Searches value in array by two keys. + /// In case there is a value at the given keys position, it is returned. + /// let byKey2<'a> = <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> From a4aa5935d77022442c0c3b4b629f13427ec3dcd4 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 17:19:14 +0300 Subject: [PATCH 023/143] add: radix sort --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 80 +---- .../Common/PrefixSum.fs | 52 +++ .../Common/Sort/Radix.fs | 329 ++++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 2 +- .../Matrix/COOMatrix/Matrix.fs | 2 +- .../Matrix/CSRMatrix/Matrix.fs | 2 +- .../Matrix/CSRMatrix/SpGEMM.fs | 1 - src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 1 - .../Objects/ArraysExtentions.fs | 9 +- src/GraphBLAS-sharp.Backend/Objects/ClCell.fs | 12 +- .../Predefined/PrefixSum.fs | 41 --- src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs | 2 +- .../Vector/DenseVector/DenseVector.fs | 1 - .../Vector/SparseVector/Common.fs | 1 - .../Common/BitonicSort.fs | 85 ----- .../Common/ClArray/PrefixSum.fs | 2 +- .../Common/Sort/Bitonic.fs | 86 +++++ .../Common/Sort/Radix.fs | 85 +++++ .../GraphBLAS-sharp.Tests.fsproj | 3 +- tests/GraphBLAS-sharp.Tests/Program.fs | 9 +- 20 files changed, 585 insertions(+), 220 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs delete mode 100644 src/GraphBLAS-sharp.Backend/Predefined/PrefixSum.fs delete mode 100644 tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 23dbb71a..aace2a48 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -129,82 +129,6 @@ module ClArray = outputArray - /// - /// Exclude inplace prefix sum. - /// - /// - /// - /// let arr = [| 1; 1; 1; 1 |] - /// let sum = [| 0 |] - /// runExcludeInplace clContext workGroupSize processor arr sum <@ (+) @> 0 - /// |> ignore - /// ... - /// > val arr = [| 0; 1; 2; 3 |] - /// > val sum = [| 4 |] - /// - /// - ///Should be a power of 2 and greater than 1. - ///Associative binary operation. - ///Zero element for binary operation. - let prefixSumExcludeInplace = PrefixSum.runExcludeInplace - - /// - /// Include inplace prefix sum. - /// - /// - /// - /// let arr = [| 1; 1; 1; 1 |] - /// let sum = [| 0 |] - /// runExcludeInplace clContext workGroupSize processor arr sum <@ (+) @> 0 - /// |> ignore - /// ... - /// > val arr = [| 1; 2; 3; 4 |] - /// > val sum = [| 4 |] - /// - /// - ///Should be a power of 2 and greater than 1. - ///Associative binary operation. - ///Zero element for binary operation. - let prefixSumIncludeInplace = PrefixSum.runIncludeInplace - - let prefixSumExclude plus (clContext: ClContext) workGroupSize = - - let runExcludeInplace = - prefixSumExcludeInplace plus clContext workGroupSize - - let copy = copy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) (zero: 'a) -> - - let outputArray = copy processor allocationMode inputArray - - let totalSum = - runExcludeInplace processor outputArray zero - - outputArray, totalSum - - let prefixSumInclude plus (clContext: ClContext) workGroupSize = - - let runIncludeInplace = - prefixSumIncludeInplace plus clContext workGroupSize - - let copy = copy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) (zero: 'a) -> - - let outputArray = copy processor allocationMode inputArray - - let totalSum = - runIncludeInplace processor outputArray zero - - outputArray, totalSum - - let prefixSumBackwardsExcludeInplace plus = - PrefixSum.runBackwardsExcludeInplace plus - - let prefixSumBackwardsIncludeInplace plus = - PrefixSum.runBackwardsIncludeInplace plus - let getUniqueBitmap (clContext: ClContext) workGroupSize = let getUniqueBitmap = @@ -250,7 +174,7 @@ module ClArray = let getUniqueBitmap = getUniqueBitmap clContext workGroupSize let prefixSumExclude = - prefixSumExcludeInplace <@ (+) @> clContext workGroupSize + PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> @@ -380,7 +304,7 @@ module ClArray = <| Map.optionToValueOrZero Unchecked.defaultof<'b> let prefixSum = - prefixSumExcludeInplace <@ (+) @> clContext workGroupSize + PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize let scatter = Scatter.runInplace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index 8d81eb3f..b25cd85e 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -218,3 +218,55 @@ module PrefixSum = let runBackwardsExcludeInplace plus = runInplace true scanExclusive plus let runBackwardsIncludeInplace plus = runInplace true scanInclusive plus + + /// + /// Exclude inplace prefix sum. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1 |] + /// let sum = [| 0 |] + /// runExcludeInplace clContext workGroupSize processor arr sum <@ (+) @> 0 + /// |> ignore + /// ... + /// > val arr = [| 0; 1; 2; 3 |] + /// > val sum = [| 4 |] + /// + /// + ///Should be a power of 2 and greater than 1. + ///Associative binary operation. + ///Zero element for binary operation. + let standardExcludeInplace (clContext: ClContext) workGroupSize = + + let scan = + runExcludeInplace <@ (+) @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> + + scan processor inputArray 0 + + /// + /// Include inplace prefix sum. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1 |] + /// let sum = [| 0 |] + /// runExcludeInplace clContext workGroupSize processor arr sum <@ (+) @> 0 + /// |> ignore + /// ... + /// > val arr = [| 1; 2; 3; 4 |] + /// > val sum = [| 4 |] + /// + /// + ///Should be a power of 2 and greater than 1. + ///Associative binary operation. + ///Zero element for binary operation. + let standardIncludeInplace (clContext: ClContext) workGroupSize = + + let scan = + runIncludeInplace <@ (+) @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> + + scan processor inputArray 0 diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs new file mode 100644 index 00000000..d2055b6e --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -0,0 +1,329 @@ +namespace GraphBLAS.FSharp.Backend.Common.Sort + + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +type Indices = ClArray + +module Radix = + // the number of bits considered per iteration + let defaultBitCount = 4 + + let keyBitCount = 32 + + let localPrefixSum = + <@ fun (lid: int) (workGroupSize: int) (array: int []) -> + let mutable offset = 1 + + while offset < workGroupSize do + barrierLocal () + let mutable value = array.[lid] + + if lid >= offset then + value <- value + array.[lid - offset] + + offset <- offset * 2 + + barrierLocal () + array.[lid] <- value @> + + let count (clContext: ClContext) workGroupSize mask = + + let bitCount = mask + 1 + + let kernel = + <@ fun (ndRange: Range1D) length (indices: Indices) (workGroupCount: ClCell) (shift: ClCell) (globalOffsets: Indices) (localOffsets: Indices) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let position = (indices.[gid] >>> shift.Value) &&& mask + + let localMask = localArray workGroupSize + + if gid < length then + localMask.[lid] <- position + else + localMask.[lid] <- 0 + + let localPositions = localArray workGroupSize + + for currentBit in 0 .. bitCount - 1 do + let isCurrentPosition = localMask.[lid] = currentBit + + if isCurrentPosition && gid < length then + localPositions.[lid] <- 1 + else + localPositions.[lid] <- 0 + + barrierLocal () + + (%localPrefixSum) lid workGroupSize localPositions + + barrierLocal () + + if gid < length && isCurrentPosition then + localOffsets.[gid] <- localPositions.[lid] - 1 + + if lid = 0 then + let processedItemsCount = localPositions.[workGroupSize - 1] + let wgId = gid / workGroupSize + + globalOffsets.[workGroupCount.Value * currentBit + wgId] <- processedItemsCount @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (indices: Indices) (clWorkGroupCount: ClCell) (shift: ClCell) -> + let ndRange = + Range1D.CreateValid(indices.Length, workGroupSize) + + let workGroupCount = (indices.Length - 1) / workGroupSize + 1 + + let globalOffsetsLength = bitCount * workGroupCount + + let globalOffsets = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalOffsetsLength) + + let localOffsets = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, indices.Length) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + indices.Length + indices + clWorkGroupCount + shift + globalOffsets + localOffsets) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + globalOffsets, localOffsets + + let scatter (clContext: ClContext) workGroupSize mask = + + let kernel = + <@ fun (ndRange: Range1D) length (keys: Indices) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: Indices) (localOffsets: Indices) (result: ClArray) -> + + let gid = ndRange.GlobalID0 + let wgId = gid / workGroupSize + + let workGroupCount = workGroupCount.Value + + if gid < length then + let slot = (keys.[gid] >>> shift.Value) &&& mask + + let localOffset = localOffsets.[gid] + + let globalOffset = + globalOffsets.[workGroupCount * slot + wgId] + + let offset = globalOffset + localOffset + + result.[offset] <- keys.[gid] @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (keys: Indices) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: Indices) (localOffsets: Indices) (result: ClArray) -> + + let ndRange = + Range1D.CreateValid(keys.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange keys.Length keys shift workGroupCount globalOffset localOffsets result) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let runKeysOnly (clContext: ClContext) workGroupSize bitCount = + let copy = ClArray.copy clContext workGroupSize + + let mask = (pown 2 bitCount) - 1 + + let count = count clContext workGroupSize mask + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let scatter = scatter clContext workGroupSize mask + + fun (processor: MailboxProcessor<_>) (keys: Indices) -> + if keys.Length <= 1 then + keys + else + let firstKeys = copy processor DeviceOnly keys + + let secondKeys = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) + + let workGroupCount = + clContext.CreateClCell((keys.Length - 1) / workGroupSize + 1) + + let mutable pair = (firstKeys, secondKeys) + let swap (x, y) = y, x + + let highBound = keyBitCount / bitCount - 1 + + for i in 0 .. highBound do + let shift = clContext.CreateClCell(bitCount * i) + + let globalOffset, localOffset = + count processor (fst pair) workGroupCount shift + + (prefixSum processor globalOffset).Free processor + + scatter processor (fst pair) shift workGroupCount globalOffset localOffset (snd pair) + + pair <- swap pair + + globalOffset.Free processor + localOffset.Free processor + shift.Free processor + + fst pair + + let standardRunKeysOnly clContext workGroupSize = + runKeysOnly clContext workGroupSize defaultBitCount + + let scatterByKey (clContext: ClContext) workGroupSize mask = + + let kernel = + <@ fun (ndRange: Range1D) length (keys: Indices) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: Indices) (localOffsets: Indices) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + let wgId = gid / workGroupSize + + let workGroupCount = workGroupCount.Value + + if gid < length then + let slot = (keys.[gid] >>> shift.Value) &&& mask + + let localOffset = localOffsets.[gid] + + let globalOffset = + globalOffsets.[workGroupCount * slot + wgId] + + let offset = globalOffset + localOffset + + resultKeys.[offset] <- keys.[gid] + resultValues.[offset] <- values.[gid] @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (keys: Indices) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: Indices) (localOffsets: Indices) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + + let ndRange = + Range1D.CreateValid(keys.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + keys.Length + keys + values + shift + workGroupCount + globalOffset + localOffsets + resultKeys + resultValues) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let runByKeys (clContext: ClContext) workGroupSize bitCount = + let copy = ClArray.copy clContext workGroupSize + + let dataCopy = ClArray.copy clContext workGroupSize + + let mask = (pown 2 bitCount) - 1 + + let count = count clContext workGroupSize mask + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let scatterByKey = + scatterByKey clContext workGroupSize mask + + fun (processor: MailboxProcessor<_>) (keys: Indices) (values: ClArray<'a>) -> + if values.Length <> keys.Length then + failwith "Mismatch of key lengths and value. Lengths must be the same" + + if values.Length <= 1 then + values + else + let firstKeys = copy processor DeviceOnly keys + + let secondKeys = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) + + let secondValues = dataCopy processor DeviceOnly values + + let workGroupCount = + clContext.CreateClCell((keys.Length - 1) / workGroupSize + 1) + + let mutable keysPair = (firstKeys, secondKeys) + let mutable valuesPair = (values, secondValues) + + let swap (x, y) = y, x + // compute bound of iterations + let highBound = keyBitCount / bitCount - 1 + + for i in 0 .. highBound do + let shift = clContext.CreateClCell(bitCount * i) + + let currentKeys = fst keysPair + let resultKeysBuffer = snd keysPair + + let currentValues = fst valuesPair + let resultValuesBuffer = snd valuesPair + + let globalOffset, localOffset = + count processor currentKeys workGroupCount shift + + (prefixSum processor globalOffset).Free processor + + scatterByKey + processor + currentKeys + currentValues + shift + workGroupCount + globalOffset + localOffset + resultKeysBuffer + resultValuesBuffer + + keysPair <- swap keysPair + valuesPair <- swap valuesPair + + localOffset.Free processor + shift.Free processor + + (fst keysPair).Free processor + (snd keysPair).Free processor + (snd valuesPair).Free processor + + (fst valuesPair) + + let runByKeysStandard clContext workGroupSize = + runByKeys clContext workGroupSize defaultBitCount diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index affc7f5a..05dfddf9 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -32,7 +32,7 @@ - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs index b7714251..a785d8b5 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs @@ -61,7 +61,7 @@ module Matrix = let create = ClArray.create clContext workGroupSize let scan = - ClArray.prefixSumBackwardsIncludeInplace <@ min @> clContext workGroupSize + PrefixSum.runBackwardsIncludeInplace <@ min @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (rowIndices: ClArray) rowCount -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index c639135b..6e5ff5c2 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -29,7 +29,7 @@ module Matrix = ClArray.zeroCreate clContext workGroupSize let scan = - ClArray.prefixSumIncludeInplace <@ max @> clContext workGroupSize + PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs index cbcfbeb4..a7b45ebc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs @@ -2,7 +2,6 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR open GraphBLAS.FSharp.Backend.Common open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Predefined open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index 997521af..1300b3cb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -2,7 +2,6 @@ namespace GraphBLAS.FSharp.Backend.Matrix open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index d76b90b9..cf17409f 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -3,7 +3,6 @@ open Brahma.FSharp module ArraysExtensions = - type ClArray<'a> with member this.Dispose(q: MailboxProcessor) = q.Post(Msg.CreateFreeMsg this) @@ -13,6 +12,14 @@ module ArraysExtensions = let dst = Array.zeroCreate this.Length q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) + member this.Free(q: MailboxProcessor) = q.Post(Msg.CreateFreeMsg this) + + member this.ToHostAndFree(q: MailboxProcessor) = + let result = this.ToHost q + this.Free q + + result + member this.Size = this.Length type 'a ``[]`` with diff --git a/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs b/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs index 5d6d1dc6..6b6b188f 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs @@ -4,10 +4,14 @@ open Brahma.FSharp module ClCell = type ClCell<'a> with - member this.ToHostAndFree(processor: MailboxProcessor<_>) = - let res = - processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(this, (Array.zeroCreate<'a> 1), ch)) + member this.ToHost(processor: MailboxProcessor<_>) = + processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(this, (Array.zeroCreate<'a> 1), ch)).[0] + member this.Free(processor: MailboxProcessor<_>) = processor.Post(Msg.CreateFreeMsg<_>(this)) - res.[0] + member this.ToHostAndFree(processor: MailboxProcessor<_>) = + let result = this.ToHost processor + this.Free processor + + result diff --git a/src/GraphBLAS-sharp.Backend/Predefined/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Predefined/PrefixSum.fs deleted file mode 100644 index 5e07eac7..00000000 --- a/src/GraphBLAS-sharp.Backend/Predefined/PrefixSum.fs +++ /dev/null @@ -1,41 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.Predefined - -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common - -module internal PrefixSum = - let standardExcludeInplace (clContext: ClContext) workGroupSize = - - let scan = - ClArray.prefixSumExcludeInplace <@ (+) @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> - - scan processor inputArray 0 - - let standardIncludeInplace (clContext: ClContext) workGroupSize = - - let scan = - ClArray.prefixSumIncludeInplace <@ (+) @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> - - scan processor inputArray 0 - - let standardInclude (clContext: ClContext) workGroupSize = - - let scan = - ClArray.prefixSumInclude <@ (+) @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray) -> - - scan processor allocationMode inputArray 0 - - let standardExclude (clContext: ClContext) workGroupSize = - - let scan = - ClArray.prefixSumExclude <@ (+) @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray) -> - - scan processor allocationMode inputArray 0 diff --git a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs index c4ed9ec2..39f8cb76 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs @@ -4,7 +4,7 @@ open Brahma.FSharp module SubSum = let private treeAccess<'a> opAdd = - <@ fun step lid wgSize (localBuffer: 'a []) -> + <@ fun step lid _ (localBuffer: 'a []) -> let i = step * (lid + 1) - 1 let firstValue = localBuffer.[i - (step >>> 1)] diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 5e509f9f..5aca4a57 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -4,7 +4,6 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Quotations -open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs index b69f2029..a78fdd9f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs @@ -3,7 +3,6 @@ namespace GraphBLAS.FSharp.Backend.Vector.Sparse open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Control -open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell diff --git a/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs b/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs deleted file mode 100644 index 99f54495..00000000 --- a/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs +++ /dev/null @@ -1,85 +0,0 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.BitonicSort - -open Expecto -open Expecto.Logging -open Expecto.Logging.Message -open GraphBLAS.FSharp.Backend.Common -open Brahma.FSharp -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Tests.Context - -let logger = Log.create "BitonicSort.Tests" - -let context = defaultContext.ClContext - -let config = - { Utils.defaultConfig with - endSize = 1000000 } - -let wgSize = Utils.defaultWorkGroupSize - -let q = defaultContext.Queue - -let makeTest sort (array: ('n * 'n * 'a) []) = - if array.Length > 0 then - let projection (row: 'n) (col: 'n) (_: 'a) = row, col - - logger.debug ( - eventX "Initial size is {size}" - >> setField "size" $"%A{array.Length}" - ) - - let rows, cols, vals = Array.unzip3 array - - use clRows = context.CreateClArray rows - use clColumns = context.CreateClArray cols - use clValues = context.CreateClArray vals - - let actualRows, actualCols, actualValues = - sort q clRows clColumns clValues - - let rows = Array.zeroCreate<'n> clRows.Length - let columns = Array.zeroCreate<'n> clColumns.Length - let values = Array.zeroCreate<'a> clValues.Length - - q.Post(Msg.CreateToHostMsg(clRows, rows)) - q.Post(Msg.CreateToHostMsg(clColumns, columns)) - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) - |> ignore - - rows, columns, values - - let expectedRows, expectedCols, expectedValues = - (rows, cols, vals) - |||> Array.zip3 - |> Array.sortBy ((<|||) projection) - |> Array.unzip3 - - $"Row arrays should be equal. Actual is \n%A{actualRows}, expected \n%A{expectedRows}, input is \n%A{rows}" - |> Utils.compareArrays (=) actualRows expectedRows - - $"Column arrays should be equal. Actual is \n%A{actualCols}, expected \n%A{expectedCols}, input is \n%A{cols}" - |> Utils.compareArrays (=) actualCols expectedCols - - $"Value arrays should be equal. Actual is \n%A{actualValues}, expected \n%A{expectedValues}, input is \n%A{vals}" - |> Utils.compareArrays (=) actualValues expectedValues - -let testFixtures<'a when 'a: equality> = - BitonicSort.sortKeyValuesInplace context wgSize - |> makeTest - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" - -let tests = - q.Error.Add(fun e -> failwithf "%A" e) - - [ testFixtures - - if Utils.isFloat64Available context.ClDevice then - testFixtures - - testFixtures - - testFixtures - testFixtures ] - |> testList "Backend.Common.BitonicSort tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs index 18d61544..3c8bedee 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs @@ -60,7 +60,7 @@ let makeTest plus zero isEqual scan (array: 'a []) = |> Tests.Utils.compareArrays isEqual actual expected let testFixtures plus plusQ zero isEqual name = - ClArray.prefixSumIncludeInplace plusQ context wgSize + PrefixSum.runIncludeInplace plusQ context wgSize |> makeTest plus zero isEqual |> testPropertyWithConfig config (sprintf "Correctness on %s" name) diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs new file mode 100644 index 00000000..3c47da43 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs @@ -0,0 +1,86 @@ +namespace GraphBLAS.FSharp.Tests.Backend.Common.Sort + +open Expecto +open Expecto.Logging +open Expecto.Logging.Message +open GraphBLAS.FSharp.Backend.Common +open Brahma.FSharp +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context + +module Bitonic = + let logger = Log.create "BitonicSort.Tests" + + let context = defaultContext.ClContext + + let config = + { Utils.defaultConfig with + endSize = 1000000 } + + let wgSize = Utils.defaultWorkGroupSize + + let q = defaultContext.Queue + + let makeTest sort (array: ('n * 'n * 'a) []) = + if array.Length > 0 then + let projection (row: 'n) (col: 'n) (_: 'a) = row, col + + logger.debug ( + eventX "Initial size is {size}" + >> setField "size" $"%A{array.Length}" + ) + + let rows, cols, vals = Array.unzip3 array + + use clRows = context.CreateClArray rows + use clColumns = context.CreateClArray cols + use clValues = context.CreateClArray vals + + let actualRows, actualCols, actualValues = + sort q clRows clColumns clValues + + let rows = Array.zeroCreate<'n> clRows.Length + let columns = Array.zeroCreate<'n> clColumns.Length + let values = Array.zeroCreate<'a> clValues.Length + + q.Post(Msg.CreateToHostMsg(clRows, rows)) + q.Post(Msg.CreateToHostMsg(clColumns, columns)) + + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) + |> ignore + + rows, columns, values + + let expectedRows, expectedCols, expectedValues = + (rows, cols, vals) + |||> Array.zip3 + |> Array.sortBy ((<|||) projection) + |> Array.unzip3 + + $"Row arrays should be equal. Actual is \n%A{actualRows}, expected \n%A{expectedRows}, input is \n%A{rows}" + |> Utils.compareArrays (=) actualRows expectedRows + + $"Column arrays should be equal. Actual is \n%A{actualCols}, expected \n%A{expectedCols}, input is \n%A{cols}" + |> Utils.compareArrays (=) actualCols expectedCols + + $"Value arrays should be equal. Actual is \n%A{actualValues}, expected \n%A{expectedValues}, input is \n%A{vals}" + |> Utils.compareArrays (=) actualValues expectedValues + + let testFixtures<'a when 'a: equality> = + BitonicSort.sortKeyValuesInplace context wgSize + |> makeTest + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" + + let tests = + q.Error.Add(fun e -> failwithf "%A" e) + + [ testFixtures + + if Utils.isFloat64Available context.ClDevice then + testFixtures + + testFixtures + + testFixtures + testFixtures ] + |> testList "Backend.Common.BitonicSort tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs new file mode 100644 index 00000000..e76b9bd2 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs @@ -0,0 +1,85 @@ +namespace GraphBLAS.FSharp.Tests.Backend.Common.Sort + +open Expecto +open GraphBLAS.FSharp.Backend.Common.Sort +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp + +module Radix = + let config = + { Utils.defaultConfig with + startSize = 1000000 } + + let workGroupSize = Utils.defaultWorkGroupSize + + let processor = Context.defaultContext.Queue + + let context = Context.defaultContext.ClContext + + let checkResultByKeys (inputArray: (int * 'a) []) (actualValues: 'a []) = + let expectedValues = + Array.sortBy fst inputArray |> Array.map snd + + "Values must be the same" + |> Expect.sequenceEqual expectedValues actualValues + + let makeTestByKeys<'a when 'a: equality> sortFun (array: (int * 'a) []) = + // since Array.sort not stable + let array = Array.distinctBy fst array + + if array.Length > 0 then + let keys = Array.map fst array + let values = Array.map snd array + + let clKeys = keys.ToDevice context + let clValues = values.ToDevice context + + let clActualValues: ClArray<'a> = sortFun processor clKeys clValues + + let actualValues = clActualValues.ToHostAndFree processor + + checkResultByKeys array actualValues + + let createTestByKeys<'a when 'a: equality and 'a: struct> = + let sort = + Radix.runByKeysStandard context workGroupSize + + makeTestByKeys<'a> sort + |> testPropertyWithConfig config $"test on {typeof<'a>}" + + let testFixturesByKeys = + [ createTestByKeys + createTestByKeys + + if Utils.isFloat64Available context.ClDevice then + createTestByKeys + + createTestByKeys + createTestByKeys ] + + let testsByKeys = + testList "Radix sort by keys" testFixturesByKeys + + let makeTestKeysOnly sort (keys: uint []) = + if keys.Length > 0 then + let keys = Array.map int keys + + let clKeys = keys.ToDevice context + + let actual = + (sort processor clKeys: ClArray) + .ToHostAndFree processor + + let expected = Array.sort keys + + "Keys must be the same" + |> Expect.sequenceEqual expected actual + + let testKeysOnly = + let sort = + Radix.standardRunKeysOnly context workGroupSize + + makeTestKeysOnly sort + |> testPropertyWithConfig config $"keys only" + diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 14bbf3ff..72b53216 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -16,7 +16,6 @@ - @@ -28,6 +27,8 @@ + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 2514a8ff..46b00937 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -27,10 +27,17 @@ let commonTests = Common.ClArray.Map2.mulTests Common.ClArray.Choose.tests ] + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.testsByKeys + Common.Sort.Radix.testKeysOnly ] + testList "Common tests" [ clArrayTests - Common.BitonicSort.tests + sortTests Common.Scatter.tests Common.Reduce.tests Common.Sum.tests ] From b028f011c630663b5cc3d85b8096907c9ecd5657 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 17:21:58 +0300 Subject: [PATCH 024/143] refactor: formatting --- .../Common/{BitonicSort.fs => Sort/Bitonic.fs} | 4 ++-- src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj | 2 +- tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs | 2 +- tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs | 1 - 4 files changed, 4 insertions(+), 5 deletions(-) rename src/GraphBLAS-sharp.Backend/Common/{BitonicSort.fs => Sort/Bitonic.fs} (99%) diff --git a/src/GraphBLAS-sharp.Backend/Common/BitonicSort.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs similarity index 99% rename from src/GraphBLAS-sharp.Backend/Common/BitonicSort.fs rename to src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs index b2c0116c..342f02e9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/BitonicSort.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs @@ -1,8 +1,8 @@ -namespace GraphBLAS.FSharp.Backend.Common +namespace GraphBLAS.FSharp.Backend.Common.Sort open Brahma.FSharp -module internal BitonicSort = +module internal Bitonic = let private localBegin (clContext: ClContext) workGroupSize = let processedSize = workGroupSize * 2 diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 05dfddf9..03bafc9f 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -31,8 +31,8 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs index 3c47da43..40fcc9f6 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs @@ -67,7 +67,7 @@ module Bitonic = |> Utils.compareArrays (=) actualValues expectedValues let testFixtures<'a when 'a: equality> = - BitonicSort.sortKeyValuesInplace context wgSize + Sort.Bitonic.sortKeyValuesInplace context wgSize |> makeTest |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs index e76b9bd2..56add17c 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs @@ -82,4 +82,3 @@ module Radix = makeTestKeysOnly sort |> testPropertyWithConfig config $"keys only" - From 2e8f46bb55472307744fb84e0994c0b230f93126 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 24 Mar 2023 18:34:15 +0300 Subject: [PATCH 025/143] refactor: imports --- src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs | 1 + src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs index 342f02e9..db833874 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs @@ -1,6 +1,7 @@ namespace GraphBLAS.FSharp.Backend.Common.Sort open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common module internal Bitonic = let private localBegin (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs index a785d8b5..56476c22 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs @@ -124,7 +124,7 @@ module Matrix = let transposeInplace (clContext: ClContext) workGroupSize = let sort = - BitonicSort.sortKeyValuesInplace clContext workGroupSize + Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.COO<'a>) -> sort queue matrix.Columns matrix.Rows matrix.Values From 4f2b965d86bc20d4e611f53ba1c9cb298958a76b Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Sat, 25 Mar 2023 11:27:53 +0300 Subject: [PATCH 026/143] refactor: map tests --- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index afa8d5f2..07c05f30 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -87,25 +87,28 @@ let correctnessGenericTest | ex when ex.Message = "InvalidBufferSize" -> () | ex -> raise ex -let createTestMap case (zero: 'a) op isEqual opQ map = +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 map = map context opQ wgSize + 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 op map toCOO isEqual q + |> 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 not (=) ArithmeticOperations.notQ Matrix.map ] + createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notQ) ] let notTests = operationGPUTests "Backend.Matrix.map not tests" testFixturesMapNot @@ -116,11 +119,11 @@ let testFixturesMapAdd case = q.Error.Add(fun e -> failwithf "%A" e) if Utils.isFloat64Available context.ClDevice then - createTestMap case 0.0 ((+) 10.0) Utils.floatIsEqual (ArithmeticOperations.addLeftConst 0.0 10.0) Matrix.map + createTestMap case 0.0 10.0 (+) Utils.floatIsEqual ArithmeticOperations.addLeftConst - createTestMap case 0.0f ((+) 10.0f) Utils.float32IsEqual (ArithmeticOperations.addLeftConst 0.0f 10.0f) Matrix.map + createTestMap case 0.0f 10.0f (+) Utils.float32IsEqual ArithmeticOperations.addLeftConst - createTestMap case 0uy ((+) 10uy) (=) (ArithmeticOperations.addLeftConst 0uy 10uy) Matrix.map ] + createTestMap case 0uy 10uy (+) (=) ArithmeticOperations.addLeftConst ] let addTests = operationGPUTests "Backend.Matrix.map add tests" testFixturesMapAdd @@ -131,11 +134,11 @@ let testFixturesMapMul case = q.Error.Add(fun e -> failwithf "%A" e) if Utils.isFloat64Available context.ClDevice then - createTestMap case 0.0 ((*) 10.0) Utils.floatIsEqual (ArithmeticOperations.mulLeftConst 0.0 10.0) Matrix.map + createTestMap case 0.0 10.0 (*) Utils.floatIsEqual ArithmeticOperations.mulLeftConst - createTestMap case 0.0f ((*) 10.0f) Utils.float32IsEqual (ArithmeticOperations.mulLeftConst 0.0f 10.0f) Matrix.map + createTestMap case 0.0f 10.0f (*) Utils.float32IsEqual ArithmeticOperations.mulLeftConst - createTestMap case 0uy ((*) 10uy) (=) (ArithmeticOperations.mulLeftConst 0uy 10uy) Matrix.map ] + createTestMap case 0uy 10uy (*) (=) ArithmeticOperations.mulLeftConst ] let mulTests = operationGPUTests "Backend.Matrix.map mul tests" testFixturesMapMul From 9102d0ffe4045f3b229ebee225b89cea2d1c97b2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 25 Mar 2023 13:08:45 +0300 Subject: [PATCH 027/143] refactor: modules in tests --- tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs | 75 +++-- .../Common/BitonicSort.fs | 107 ++++--- .../Common/ClArray/Choose.fs | 65 ++-- .../Common/ClArray/Copy.fs | 67 ++-- .../Common/ClArray/Exists.fs | 81 +++-- .../Common/ClArray/Map.fs | 75 +++-- .../Common/ClArray/Map2.fs | 89 +++--- .../Common/ClArray/PrefixSum.fs | 115 ++++--- .../Common/ClArray/RemoveDuplicates.fs | 95 +++--- .../Common/ClArray/Replicate.fs | 71 +++-- .../Common/Reduce/Reduce.fs | 103 ++++--- .../Common/Reduce/ReduceByKey.fs | 251 ++++++++------- .../Common/Reduce/Sum.fs | 97 +++--- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 79 +++-- tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs | 193 ++++++------ tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 285 +++++++++--------- tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs | 147 +++++---- .../GraphBLAS-sharp.Tests/Matrix/Transpose.fs | 181 ++++++----- .../Vector/AssignByMask.fs | 186 ++++++------ tests/GraphBLAS-sharp.Tests/Vector/Convert.fs | 153 +++++----- tests/GraphBLAS-sharp.Tests/Vector/Copy.fs | 109 ++++--- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 270 ++++++++--------- tests/GraphBLAS-sharp.Tests/Vector/OfList.fs | 127 ++++---- tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs | 115 ++++--- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 229 +++++++------- .../Vector/ZeroCreate.fs | 95 +++--- 26 files changed, 1704 insertions(+), 1756 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index 52107493..1590f142 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Algorithms +module GraphBLAS.FSharp.Tests.Backend.Algorithms.BFS open Expecto open GraphBLAS.FSharp.Backend @@ -12,55 +12,54 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects -module BFS = - let testFixtures (testContext: TestContext) = - [ let config = Utils.undirectedAlgoConfig - let context = testContext.ClContext - let queue = testContext.Queue - let workGroupSize = Utils.defaultWorkGroupSize +let testFixtures (testContext: TestContext) = + [ let config = Utils.undirectedAlgoConfig + let context = testContext.ClContext + let queue = testContext.Queue + let workGroupSize = Utils.defaultWorkGroupSize - let testName = - sprintf "Test on %A" testContext.ClContext + let testName = + sprintf "Test on %A" testContext.ClContext - let bfs = - Algorithms.BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul workGroupSize + let bfs = + Algorithms.BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul workGroupSize - testPropertyWithConfig config testName - <| fun (matrix: int [,]) -> + testPropertyWithConfig config testName + <| fun (matrix: int [,]) -> - let graph = undirectedFromArray2D matrix 0 + let graph = undirectedFromArray2D matrix 0 - let largestComponent = - ConnectedComponents.largestComponent graph + let largestComponent = + ConnectedComponents.largestComponent graph - if largestComponent.Length > 0 then - let source = largestComponent.[0] + if largestComponent.Length > 0 then + let source = largestComponent.[0] - let expected = - (snd (BFS.runUndirected graph source)) - |> Utils.createArrayFromDictionary (Array2D.length1 matrix) 0 + let expected = + (snd (BFS.runUndirected graph source)) + |> Utils.createArrayFromDictionary (Array2D.length1 matrix) 0 - let matrixHost = - Utils.createMatrixFromArray2D CSR matrix ((=) 0) + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0) - let matrix = matrixHost.ToDevice context + let matrix = matrixHost.ToDevice context - match matrix with - | ClMatrix.CSR mtx -> - let res = bfs queue mtx source |> ClVector.Dense + match matrix with + | ClMatrix.CSR mtx -> + let res = bfs queue mtx source |> ClVector.Dense - let resHost = res.ToHost queue + let resHost = res.ToHost queue - (mtx :> IDeviceMemObject).Dispose queue - res.Dispose queue + (mtx :> IDeviceMemObject).Dispose queue + res.Dispose queue - match resHost with - | Vector.Dense resHost -> - let actual = resHost |> Utils.unwrapOptionArray 0 + match resHost with + | Vector.Dense resHost -> + let actual = resHost |> Utils.unwrapOptionArray 0 - Expect.sequenceEqual actual expected "Sequences must be equal" - | _ -> failwith "Not implemented" - | _ -> failwith "Not implemented" ] + Expect.sequenceEqual actual expected "Sequences must be equal" + | _ -> failwith "Not implemented" + | _ -> failwith "Not implemented" ] - let tests = - TestCases.gpuTests "Bfs tests" testFixtures +let tests = + TestCases.gpuTests "Bfs tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs b/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs index f5e5c3a4..99f54495 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/BitonicSort.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common +module GraphBLAS.FSharp.Tests.Backend.Common.BitonicSort open Expecto open Expecto.Logging @@ -8,79 +8,78 @@ open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context -module BitonicSort = - let logger = Log.create "BitonicSort.Tests" +let logger = Log.create "BitonicSort.Tests" - let context = defaultContext.ClContext +let context = defaultContext.ClContext - let config = - { Utils.defaultConfig with - endSize = 1000000 } +let config = + { Utils.defaultConfig with + endSize = 1000000 } - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let q = defaultContext.Queue +let q = defaultContext.Queue - let makeTest sort (array: ('n * 'n * 'a) []) = - if array.Length > 0 then - let projection (row: 'n) (col: 'n) (_: 'a) = row, col +let makeTest sort (array: ('n * 'n * 'a) []) = + if array.Length > 0 then + let projection (row: 'n) (col: 'n) (_: 'a) = row, col - logger.debug ( - eventX "Initial size is {size}" - >> setField "size" $"%A{array.Length}" - ) + logger.debug ( + eventX "Initial size is {size}" + >> setField "size" $"%A{array.Length}" + ) - let rows, cols, vals = Array.unzip3 array + let rows, cols, vals = Array.unzip3 array - use clRows = context.CreateClArray rows - use clColumns = context.CreateClArray cols - use clValues = context.CreateClArray vals + use clRows = context.CreateClArray rows + use clColumns = context.CreateClArray cols + use clValues = context.CreateClArray vals - let actualRows, actualCols, actualValues = - sort q clRows clColumns clValues + let actualRows, actualCols, actualValues = + sort q clRows clColumns clValues - let rows = Array.zeroCreate<'n> clRows.Length - let columns = Array.zeroCreate<'n> clColumns.Length - let values = Array.zeroCreate<'a> clValues.Length + let rows = Array.zeroCreate<'n> clRows.Length + let columns = Array.zeroCreate<'n> clColumns.Length + let values = Array.zeroCreate<'a> clValues.Length - q.Post(Msg.CreateToHostMsg(clRows, rows)) - q.Post(Msg.CreateToHostMsg(clColumns, columns)) + q.Post(Msg.CreateToHostMsg(clRows, rows)) + q.Post(Msg.CreateToHostMsg(clColumns, columns)) - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) + |> ignore - rows, columns, values + rows, columns, values - let expectedRows, expectedCols, expectedValues = - (rows, cols, vals) - |||> Array.zip3 - |> Array.sortBy ((<|||) projection) - |> Array.unzip3 + let expectedRows, expectedCols, expectedValues = + (rows, cols, vals) + |||> Array.zip3 + |> Array.sortBy ((<|||) projection) + |> Array.unzip3 - $"Row arrays should be equal. Actual is \n%A{actualRows}, expected \n%A{expectedRows}, input is \n%A{rows}" - |> Utils.compareArrays (=) actualRows expectedRows + $"Row arrays should be equal. Actual is \n%A{actualRows}, expected \n%A{expectedRows}, input is \n%A{rows}" + |> Utils.compareArrays (=) actualRows expectedRows - $"Column arrays should be equal. Actual is \n%A{actualCols}, expected \n%A{expectedCols}, input is \n%A{cols}" - |> Utils.compareArrays (=) actualCols expectedCols + $"Column arrays should be equal. Actual is \n%A{actualCols}, expected \n%A{expectedCols}, input is \n%A{cols}" + |> Utils.compareArrays (=) actualCols expectedCols - $"Value arrays should be equal. Actual is \n%A{actualValues}, expected \n%A{expectedValues}, input is \n%A{vals}" - |> Utils.compareArrays (=) actualValues expectedValues + $"Value arrays should be equal. Actual is \n%A{actualValues}, expected \n%A{expectedValues}, input is \n%A{vals}" + |> Utils.compareArrays (=) actualValues expectedValues - let testFixtures<'a when 'a: equality> = - BitonicSort.sortKeyValuesInplace context wgSize - |> makeTest - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" +let testFixtures<'a when 'a: equality> = + BitonicSort.sortKeyValuesInplace context wgSize + |> makeTest + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" - let tests = - q.Error.Add(fun e -> failwithf "%A" e) +let tests = + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures + [ testFixtures - if Utils.isFloat64Available context.ClDevice then - testFixtures + if Utils.isFloat64Available context.ClDevice then + testFixtures - testFixtures + testFixtures - testFixtures - testFixtures ] - |> testList "Backend.Common.BitonicSort tests" + testFixtures + testFixtures ] + |> testList "Backend.Common.BitonicSort tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index c59e8154..628ff51a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Choose open GraphBLAS.FSharp.Backend.Common open Expecto @@ -8,51 +8,50 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes -module Choose = - let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Utils.defaultWorkGroupSize - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = - if array.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue +let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = + if array.Length > 0 then + let context = testContext.ClContext + let q = testContext.Queue - let clArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) + let clArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) - let (clResult: ClArray<'b>) = choose q HostInterop clArray + let (clResult: ClArray<'b>) = choose q HostInterop clArray - let hostResult = Array.zeroCreate clResult.Length + let hostResult = Array.zeroCreate clResult.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, hostResult, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, hostResult, ch)) + |> ignore - let expectedResult = Array.choose mapFun array + let expectedResult = Array.choose mapFun array - "Result should be the same" - |> Utils.compareArrays isEqual hostResult expectedResult + "Result should be the same" + |> Utils.compareArrays isEqual hostResult expectedResult - let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = - let context = testContext.ClContext +let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = + let context = testContext.ClContext - let choose = - ClArray.choose context workGroupSize mapFunQ + let choose = + ClArray.choose context workGroupSize mapFunQ - makeTest<'a, 'b> testContext choose mapFun isEqual - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>} -> %A{typeof<'b>}" + makeTest<'a, 'b> testContext choose mapFun isEqual + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>} -> %A{typeof<'b>}" - let testFixtures testContext = - let device = testContext.ClContext.ClDevice +let testFixtures testContext = + let device = testContext.ClContext.ClDevice - [ createTest testContext id Map.id (=) - createTest testContext id Map.id (=) - createTest testContext id Map.id (=) + [ createTest testContext id Map.id (=) + createTest testContext id Map.id (=) + createTest testContext id Map.id (=) - if Utils.isFloat64Available device then - createTest testContext id Map.id Utils.floatIsEqual + if Utils.isFloat64Available device then + createTest testContext id Map.id Utils.floatIsEqual - createTest testContext id Map.id Utils.float32IsEqual ] + createTest testContext id Map.id Utils.float32IsEqual ] - let tests = - TestCases.gpuTests "ClArray.choose id tests" testFixtures +let tests = + TestCases.gpuTests "ClArray.choose id tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs index 5abd811b..dcf4ed83 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Copy open Expecto open Expecto.Logging @@ -8,51 +8,50 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects.ClContext -module Copy = - let logger = Log.create "ClArray.Copy.Tests" +let logger = Log.create "ClArray.Copy.Tests" - let context = Context.defaultContext.ClContext +let context = Context.defaultContext.ClContext - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let q = Context.defaultContext.Queue +let q = Context.defaultContext.Queue - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = - if array.Length > 0 then - use clArray = context.CreateClArray array +let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = + if array.Length > 0 then + use clArray = context.CreateClArray array - let actual = - use clActual: ClArray<'a> = copyFun q HostInterop clArray + let actual = + use clActual: ClArray<'a> = copyFun q HostInterop clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = Array.zeroCreate clActual.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - "Array should be equals to original" - |> Expect.sequenceEqual actual array + "Array should be equals to original" + |> Expect.sequenceEqual actual array - let creatTest<'a when 'a: equality> = - ClArray.copy context wgSize - |> makeTest<'a> - |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" +let creatTest<'a when 'a: equality> = + ClArray.copy context wgSize + |> makeTest<'a> + |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" - let testCases = - q.Error.Add(fun e -> failwithf "%A" e) +let testCases = + q.Error.Add(fun e -> failwithf "%A" e) - [ creatTest - creatTest + [ creatTest + creatTest - if Utils.isFloat64Available context.ClDevice then - creatTest + if Utils.isFloat64Available context.ClDevice then + creatTest - creatTest - creatTest ] + creatTest + creatTest ] - let tests = - testCases |> testList "ClArray.copy tests" +let tests = + testCases |> testList "ClArray.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs index 94355b78..dbbb3415 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Exists open Expecto open Expecto.Logging @@ -9,62 +9,61 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Quotes -module Exists = - let logger = - Log.create "ClArray.containsNonZero.Tests" +let logger = + Log.create "ClArray.containsNonZero.Tests" - let context = defaultContext.ClContext +let context = defaultContext.ClContext - let q = defaultContext.Queue +let q = defaultContext.Queue - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (array: 'a []) = +let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (array: 'a []) = - if array.Length > 0 then - let vector = - Utils.createVectorFromArray Dense array isZero + if array.Length > 0 then + let vector = + Utils.createVectorFromArray Dense array isZero - let result = - match vector.ToDevice context with - | ClVector.Dense clArray -> - let resultCell = exists q clArray - let result = Array.zeroCreate 1 + let result = + match vector.ToDevice context with + | ClVector.Dense clArray -> + let resultCell = exists q clArray + let result = Array.zeroCreate 1 - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) + let res = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - q.Post(Msg.CreateFreeMsg<_>(resultCell)) + q.Post(Msg.CreateFreeMsg<_>(resultCell)) - res.[0] + res.[0] - | _ -> failwith "Unsupported vector format" + | _ -> failwith "Unsupported vector format" - $"The results should be the same, vector : {vector}" - |> Expect.equal result (Array.exists (not << isZero) array) + $"The results should be the same, vector : {vector}" + |> Expect.equal result (Array.exists (not << isZero) array) - let createTest<'a when 'a: struct and 'a: equality> isEqual zero = - let exists = - ClArray.exists context wgSize Predicates.isSome +let createTest<'a when 'a: struct and 'a: equality> isEqual zero = + let exists = + ClArray.exists context wgSize Predicates.isSome - [ correctnessGenericTest<'a> (isEqual zero) exists - |> testPropertyWithConfig config "FSCheck data" + [ correctnessGenericTest<'a> (isEqual zero) exists + |> testPropertyWithConfig config "FSCheck data" - correctnessGenericTest<'a> (isEqual zero) exists (Array.create 1000 zero) - |> testPropertyWithConfig config "Zeros" ] - |> testList $"Correctness on %A{typeof<'a>}" + correctnessGenericTest<'a> (isEqual zero) exists (Array.create 1000 zero) + |> testPropertyWithConfig config "Zeros" ] + |> testList $"Correctness on %A{typeof<'a>}" - let testFixtures = - [ createTest (=) 0 - createTest (=) 0uy +let testFixtures = + [ createTest (=) 0 + createTest (=) 0uy - if Utils.isFloat64Available context.ClDevice then - createTest Utils.floatIsEqual 0.0 + if Utils.isFloat64Available context.ClDevice then + createTest Utils.floatIsEqual 0.0 - createTest Utils.float32IsEqual 0.0f - createTest (=) false ] + createTest Utils.float32IsEqual 0.0f + createTest (=) false ] - let tests = - testList "Common.ClArray.exists tests" testFixtures +let tests = + testList "Common.ClArray.exists tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs index 766b1465..be501e41 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Map open Brahma.FSharp open GraphBLAS.FSharp.Tests @@ -8,58 +8,57 @@ open GraphBLAS.FSharp.Backend.Quotes open Expecto open GraphBLAS.FSharp.Backend.Objects.ClContext -module Map = - let context = defaultContext.Queue +let context = defaultContext.Queue - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let mapOptionToValue zero = - function - | Some value -> value - | None -> zero +let mapOptionToValue zero = + function + | Some value -> value + | None -> zero - let makeTest (testContext: TestContext) mapFun zero isEqual (array: 'a option []) = - if array.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue +let makeTest (testContext: TestContext) mapFun zero isEqual (array: 'a option []) = + if array.Length > 0 then + let context = testContext.ClContext + let q = testContext.Queue - let clArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) + let clArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) - let (actualDevice: ClArray<_>) = mapFun q HostInterop clArray + let (actualDevice: ClArray<_>) = mapFun q HostInterop clArray - let actualHost = Array.zeroCreate actualDevice.Length + let actualHost = Array.zeroCreate actualDevice.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) + |> ignore - let expected = Array.map (mapOptionToValue zero) array + let expected = Array.map (mapOptionToValue zero) array - "Arrays must be the same" - |> Utils.compareArrays isEqual actualHost expected + "Arrays must be the same" + |> Utils.compareArrays isEqual actualHost expected - let createTest<'a when 'a: equality> (testContext: TestContext) (zero: 'a) isEqual = +let createTest<'a when 'a: equality> (testContext: TestContext) (zero: 'a) isEqual = - let context = testContext.ClContext + let context = testContext.ClContext - let map = - ClArray.map context wgSize - <| Map.optionToValueOrZero zero + let map = + ClArray.map context wgSize + <| Map.optionToValueOrZero zero - makeTest testContext map zero isEqual - |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" + makeTest testContext map zero isEqual + |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" - let testFixtures (testContext: TestContext) = - [ createTest testContext 0 (=) - createTest testContext false (=) +let testFixtures (testContext: TestContext) = + [ createTest testContext 0 (=) + createTest testContext false (=) - if Utils.isFloat64Available testContext.ClContext.ClDevice then - createTest testContext 0.0 Utils.floatIsEqual + if Utils.isFloat64Available testContext.ClContext.ClDevice then + createTest testContext 0.0 Utils.floatIsEqual - createTest testContext 0.0f Utils.float32IsEqual - createTest testContext 0uy (=) ] + createTest testContext 0.0f Utils.float32IsEqual + createTest testContext 0uy (=) ] - let tests = - TestCases.gpuTests "ClArray.map tests" testFixtures +let tests = + TestCases.gpuTests "ClArray.map tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs index 17ab89c8..c1ab2af8 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Map2 open Brahma.FSharp open GraphBLAS.FSharp.Tests @@ -7,69 +7,68 @@ open GraphBLAS.FSharp.Backend.Common open Expecto open GraphBLAS.FSharp.Backend.Objects.ClContext -module Map2 = - let context = defaultContext.Queue +let context = defaultContext.Queue - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let makeTest<'a when 'a: equality> testContext clMapFun hostMapFun isEqual (leftArray: 'a [], rightArray: 'a []) = - if leftArray.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue +let makeTest<'a when 'a: equality> testContext clMapFun hostMapFun isEqual (leftArray: 'a [], rightArray: 'a []) = + if leftArray.Length > 0 then + let context = testContext.ClContext + let q = testContext.Queue - let leftClArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftArray) + let leftClArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftArray) - let rightClArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, rightArray) + let rightClArray = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, rightArray) - let (actualDevice: ClArray<'a>) = - clMapFun q HostInterop leftClArray rightClArray + let (actualDevice: ClArray<'a>) = + clMapFun q HostInterop leftClArray rightClArray - let actualHost = Array.zeroCreate actualDevice.Length + let actualHost = Array.zeroCreate actualDevice.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) + |> ignore - let expected = - Array.map2 hostMapFun leftArray rightArray + let expected = + Array.map2 hostMapFun leftArray rightArray - "Arrays must be the same" - |> Utils.compareArrays isEqual actualHost expected + "Arrays must be the same" + |> Utils.compareArrays isEqual actualHost expected - let createTest<'a when 'a: equality> (testContext: TestContext) isEqual hostMapFun mapFunQ = +let createTest<'a when 'a: equality> (testContext: TestContext) isEqual hostMapFun mapFunQ = - let context = testContext.ClContext + let context = testContext.ClContext - let map = ClArray.map2 context wgSize mapFunQ + let map = ClArray.map2 context wgSize mapFunQ - makeTest<'a> testContext map hostMapFun isEqual - |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" + makeTest<'a> testContext map hostMapFun isEqual + |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" - let testFixturesAdd (testContext: TestContext) = - [ createTest testContext (=) (+) <@ (+) @> - createTest testContext (=) (||) <@ (||) @> +let testFixturesAdd (testContext: TestContext) = + [ createTest testContext (=) (+) <@ (+) @> + createTest testContext (=) (||) <@ (||) @> - if Utils.isFloat64Available testContext.ClContext.ClDevice then - createTest testContext Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available testContext.ClContext.ClDevice then + createTest testContext Utils.floatIsEqual (+) <@ (+) @> - createTest testContext Utils.float32IsEqual (+) <@ (+) @> - createTest testContext (=) (+) <@ (+) @> ] + createTest testContext Utils.float32IsEqual (+) <@ (+) @> + createTest testContext (=) (+) <@ (+) @> ] - let addTests = - TestCases.gpuTests "ClArray.map2 add tests" testFixturesAdd +let addTests = + TestCases.gpuTests "ClArray.map2 add tests" testFixturesAdd - let testFixturesMul (testContext: TestContext) = - [ createTest testContext (=) (*) <@ (*) @> - createTest testContext (=) (&&) <@ (&&) @> +let testFixturesMul (testContext: TestContext) = + [ createTest testContext (=) (*) <@ (*) @> + createTest testContext (=) (&&) <@ (&&) @> - if Utils.isFloat64Available testContext.ClContext.ClDevice then - createTest testContext Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available testContext.ClContext.ClDevice then + createTest testContext Utils.floatIsEqual (*) <@ (*) @> - createTest testContext Utils.float32IsEqual (*) <@ (*) @> - createTest testContext (=) (+) <@ (+) @> ] + createTest testContext Utils.float32IsEqual (*) <@ (*) @> + createTest testContext (=) (+) <@ (+) @> ] - let mulTests = - TestCases.gpuTests "ClArray.map2 multiplication tests" testFixturesMul +let mulTests = + TestCases.gpuTests "ClArray.map2 multiplication tests" testFixturesMul diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs index 667c8de6..18d61544 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.PrefixSum open Expecto open Expecto.Logging @@ -9,79 +9,78 @@ open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Objects.ClCell -module PrefixSum = - let logger = Log.create "ClArray.PrefixSum.Tests" +let logger = Log.create "ClArray.PrefixSum.Tests" - let context = defaultContext.ClContext +let context = defaultContext.ClContext - let config = Tests.Utils.defaultConfig +let config = Tests.Utils.defaultConfig - let wgSize = 128 +let wgSize = 128 - let q = defaultContext.Queue +let q = defaultContext.Queue - let makeTest plus zero isEqual scan (array: 'a []) = - if array.Length > 0 then +let makeTest plus zero isEqual scan (array: 'a []) = + if array.Length > 0 then - logger.debug ( - eventX $"Array is %A{array}\n" - >> setField "array" (sprintf "%A" array) - ) + logger.debug ( + eventX $"Array is %A{array}\n" + >> setField "array" (sprintf "%A" array) + ) - let actual, actualSum = - use clArray = context.CreateClArray array - let (total: ClCell<_>) = scan q clArray zero + let actual, actualSum = + use clArray = context.CreateClArray array + let (total: ClCell<_>) = scan q clArray zero - let actual = Array.zeroCreate<'a> clArray.Length - let actualSum = total.ToHostAndFree(q) - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clArray, actual, ch)), actualSum + let actual = Array.zeroCreate<'a> clArray.Length + let actualSum = total.ToHostAndFree(q) + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clArray, actual, ch)), actualSum - logger.debug ( - eventX "Actual is {actual}\n" - >> setField "actual" (sprintf "%A" actual) - ) + logger.debug ( + eventX "Actual is {actual}\n" + >> setField "actual" (sprintf "%A" actual) + ) - let expected, expectedSum = - array - |> Array.mapFold - (fun s t -> - let a = plus s t - a, a) - zero + let expected, expectedSum = + array + |> Array.mapFold + (fun s t -> + let a = plus s t + a, a) + zero - logger.debug ( - eventX "Expected is {expected}\n" - >> setField "expected" (sprintf "%A" expected) - ) + logger.debug ( + eventX "Expected is {expected}\n" + >> setField "expected" (sprintf "%A" expected) + ) - "Total sums should be equal" - |> Expect.equal actualSum expectedSum + "Total sums should be equal" + |> Expect.equal actualSum expectedSum - "Arrays should be the same" - |> Tests.Utils.compareArrays isEqual actual expected + "Arrays should be the same" + |> Tests.Utils.compareArrays isEqual actual expected - let testFixtures plus plusQ zero isEqual name = - ClArray.prefixSumIncludeInplace plusQ context wgSize - |> makeTest plus zero isEqual - |> testPropertyWithConfig config (sprintf "Correctness on %s" name) +let testFixtures plus plusQ zero isEqual name = + ClArray.prefixSumIncludeInplace plusQ context wgSize + |> makeTest plus zero isEqual + |> testPropertyWithConfig config (sprintf "Correctness on %s" name) - let tests = - q.Error.Add(fun e -> failwithf "%A" e) +let tests = + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 (=) "int add" - testFixtures (+) <@ (+) @> 0uy (=) "byte add" - testFixtures max <@ max @> 0 (=) "int max" - testFixtures max <@ max @> 0uy (=) "byte max" - testFixtures min <@ min @> System.Int32.MaxValue (=) "int min" + [ testFixtures (+) <@ (+) @> 0 (=) "int add" + testFixtures (+) <@ (+) @> 0uy (=) "byte add" + testFixtures max <@ max @> 0 (=) "int max" + testFixtures max <@ max @> 0uy (=) "byte max" + testFixtures min <@ min @> System.Int32.MaxValue (=) "int min" - if Tests.Utils.isFloat64Available context.ClDevice then - testFixtures min <@ min @> System.Double.MaxValue (=) "float min" - testFixtures max <@ max @> 0.0 (=) "float max" + if Tests.Utils.isFloat64Available context.ClDevice then + testFixtures min <@ min @> System.Double.MaxValue (=) "float min" + testFixtures max <@ max @> 0.0 (=) "float max" - testFixtures min <@ min @> System.Single.MaxValue (=) "float32 min" - testFixtures max <@ max @> 0.0f (=) "float32 max" + testFixtures min <@ min @> System.Single.MaxValue (=) "float32 min" + testFixtures max <@ max @> 0.0f (=) "float32 max" - testFixtures min <@ min @> System.Byte.MaxValue (=) "byte min" - testFixtures (||) <@ (||) @> false (=) "bool logic-or" - testFixtures (&&) <@ (&&) @> true (=) "bool logic-and" ] - |> testList "Backend.Common.PrefixSum tests" + testFixtures min <@ min @> System.Byte.MaxValue (=) "byte min" + testFixtures (||) <@ (||) @> false (=) "bool logic-or" + testFixtures (&&) <@ (&&) @> true (=) "bool logic-and" ] + |> testList "Backend.Common.PrefixSum tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs index 876426f3..1f8e3f7d 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.RemoveDuplicates open Expecto open Expecto.Logging @@ -7,68 +7,67 @@ open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Common -module RemoveDuplicates = - let logger = Log.create "RemoveDuplicates.Tests" +let logger = Log.create "RemoveDuplicates.Tests" - let context = Context.defaultContext.ClContext +let context = Context.defaultContext.ClContext - let testCases = - let removeDuplicates_wg_2 = ClArray.removeDuplications context 2 - let removeDuplicates_wg_32 = ClArray.removeDuplications context 32 - let q = Context.defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) +let testCases = + let removeDuplicates_wg_2 = ClArray.removeDuplications context 2 + let removeDuplicates_wg_32 = ClArray.removeDuplications context 32 + let q = Context.defaultContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - [ testCase "Simple correctness test" - <| fun () -> - let array = [| 1; 2; 2; 3; 3; 3 |] + [ testCase "Simple correctness test" + <| fun () -> + let array = [| 1; 2; 2; 3; 3; 3 |] - let clArray = context.CreateClArray array + let clArray = context.CreateClArray array - let actual = - let clActual = removeDuplicates_wg_2 q clArray + let actual = + let clActual = removeDuplicates_wg_2 q clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = Array.zeroCreate clActual.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) - let expected = [| 1; 2; 3 |] + let expected = [| 1; 2; 3 |] - "Array should be without duplicates" - |> Expect.sequenceEqual actual expected + "Array should be without duplicates" + |> Expect.sequenceEqual actual expected - testProperty "Correctness test on random int arrays" - <| fun (array: array) -> - let array = Array.sort array + testProperty "Correctness test on random int arrays" + <| fun (array: array) -> + let array = Array.sort array - if array.Length > 0 then - let clArray = context.CreateClArray array + if array.Length > 0 then + let clArray = context.CreateClArray array - let removeDuplicates = - if array.Length % 32 = 0 then - removeDuplicates_wg_32 - else - removeDuplicates_wg_2 + let removeDuplicates = + if array.Length % 32 = 0 then + removeDuplicates_wg_32 + else + removeDuplicates_wg_2 - let actual = - let clActual = removeDuplicates q clArray + let actual = + let clActual = removeDuplicates q clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = Array.zeroCreate clActual.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - let expected = Seq.distinct array |> Array.ofSeq + let expected = Seq.distinct array |> Array.ofSeq - "Array should be without duplicates" - |> Expect.sequenceEqual actual expected ] + "Array should be without duplicates" + |> Expect.sequenceEqual actual expected ] - let tests = - testCases - |> testList "Array.removeDuplicates tests" +let tests = + testCases + |> testList "Array.removeDuplicates tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs index 770eb0b6..c7067df5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.ClArray +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Replicate open Expecto open Expecto.Logging @@ -8,54 +8,53 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext -module Replicate = - let logger = Log.create "Replicate.Tests" +let logger = Log.create "Replicate.Tests" - let context = Context.defaultContext.ClContext +let context = Context.defaultContext.ClContext - let q = Context.defaultContext.Queue +let q = Context.defaultContext.Queue - let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Utils.defaultWorkGroupSize - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = - if array.Length > 0 && i > 0 then - use clArray = context.CreateClArray array +let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = + if array.Length > 0 && i > 0 then + use clArray = context.CreateClArray array - let actual = - use clActual: ClArray<'a> = replicateFun q HostInterop clArray i + let actual = + use clActual: ClArray<'a> = replicateFun q HostInterop clArray i - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = Array.zeroCreate clActual.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) - logger.debug ( - eventX $"Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX $"Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - let expected = - array |> Array.replicate i |> Array.concat + let expected = + array |> Array.replicate i |> Array.concat - $"Array should contains %i{i} copies of the original one" - |> Expect.sequenceEqual actual expected + $"Array should contains %i{i} copies of the original one" + |> Expect.sequenceEqual actual expected - let createTest<'a when 'a: equality> = - ClArray.replicate context workGroupSize - |> makeTest<'a> - |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" +let createTest<'a when 'a: equality> = + ClArray.replicate context workGroupSize + |> makeTest<'a> + |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" - let testCases = - q.Error.Add(fun e -> failwithf "%A" e) +let testCases = + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest - createTest + [ createTest + createTest - if Utils.isFloat64Available context.ClDevice then - createTest + if Utils.isFloat64Available context.ClDevice then + createTest - createTest - createTest ] + createTest + createTest ] - let tests = - testCases |> testList "ClArray.replicate tests" +let tests = + testCases |> testList "ClArray.replicate tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs index 31aaebd1..3d365f27 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.Reduce +module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.Reduce open Expecto open Expecto.Logging @@ -7,76 +7,75 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests -module Reduce = - let logger = Log.create "Reduce.Tests" +let logger = Log.create "Reduce.Tests" - let context = Context.defaultContext.ClContext +let context = Context.defaultContext.ClContext - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let q = Context.defaultContext.Queue +let q = Context.defaultContext.Queue - let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = +let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = - if array.Length > 0 then - let reduce = reduce q + if array.Length > 0 then + let reduce = reduce q - logger.debug ( - eventX "Filtered array is {array}\n" - >> setField "array" (sprintf "%A" array) - ) + logger.debug ( + eventX "Filtered array is {array}\n" + >> setField "array" (sprintf "%A" array) + ) - let actualSum = - use clArray = context.CreateClArray array - let total = reduce clArray + let actualSum = + use clArray = context.CreateClArray array + let total = reduce clArray - let actualSum = [| zero |] + let actualSum = [| zero |] - let sum = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) + let sum = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) - sum.[0] + sum.[0] - logger.debug ( - eventX "Actual is {actual}\n" - >> setField "actual" (sprintf "%A" actualSum) - ) + logger.debug ( + eventX "Actual is {actual}\n" + >> setField "actual" (sprintf "%A" actualSum) + ) - let expectedSum = Array.fold plus zero array + let expectedSum = Array.fold plus zero array - logger.debug ( - eventX "Expected is {expected}\n" - >> setField "expected" (sprintf "%A" expectedSum) - ) + logger.debug ( + eventX "Expected is {expected}\n" + >> setField "expected" (sprintf "%A" expectedSum) + ) - "Total sums should be equal" - |> Expect.equal actualSum expectedSum + "Total sums should be equal" + |> Expect.equal actualSum expectedSum - let testFixtures plus plusQ zero name = - let reduce = Reduce.reduce context wgSize plusQ +let testFixtures plus plusQ zero name = + let reduce = Reduce.reduce context wgSize plusQ - makeTest reduce plus zero - |> testPropertyWithConfig config $"Correctness on %s{name}" + makeTest reduce plus zero + |> testPropertyWithConfig config $"Correctness on %s{name}" - let tests = - q.Error.Add(fun e -> failwithf "%A" e) +let tests = + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 "int add" - testFixtures (+) <@ (+) @> 0uy "byte add" - testFixtures max <@ max @> System.Int32.MinValue "int max" - testFixtures max <@ max @> System.Byte.MinValue "byte max" - testFixtures min <@ min @> System.Int32.MaxValue "int min" + [ testFixtures (+) <@ (+) @> 0 "int add" + testFixtures (+) <@ (+) @> 0uy "byte add" + testFixtures max <@ max @> System.Int32.MinValue "int max" + testFixtures max <@ max @> System.Byte.MinValue "byte max" + testFixtures min <@ min @> System.Int32.MaxValue "int min" - if Utils.isFloat64Available context.ClDevice then - testFixtures max <@ max @> System.Double.MinValue "float max" - testFixtures min <@ min @> System.Double.MaxValue "float min" + if Utils.isFloat64Available context.ClDevice then + testFixtures max <@ max @> System.Double.MinValue "float max" + testFixtures min <@ min @> System.Double.MaxValue "float min" - testFixtures max <@ max @> System.Single.MinValue "float32 max" - testFixtures min <@ min @> System.Single.MaxValue "float32 min" + testFixtures max <@ max @> System.Single.MinValue "float32 max" + testFixtures min <@ min @> System.Single.MaxValue "float32 min" - testFixtures min <@ min @> System.Byte.MaxValue "byte min" - testFixtures (||) <@ (||) @> false "bool logic-or" - testFixtures (&&) <@ (&&) @> true "bool logic-and" ] - |> testList "Backend.Common.Reduce tests" + testFixtures min <@ min @> System.Byte.MaxValue "byte min" + testFixtures (||) <@ (||) @> false "bool logic-or" + testFixtures (&&) <@ (&&) @> true "bool logic-and" ] + |> testList "Backend.Common.Reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 245f97f5..6ef76e26 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.Reduce +module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.ByKey open Expecto open GraphBLAS.FSharp.Backend.Common @@ -7,182 +7,181 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -module ByKey = - let context = Context.defaultContext.ClContext +let context = Context.defaultContext.ClContext - let processor = Context.defaultContext.Queue +let processor = Context.defaultContext.Queue - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let checkResult isEqual actualKeys actualValues keys values reduceOp = +let checkResult isEqual actualKeys actualValues keys values reduceOp = - let expectedKeys, expectedValues = - HostPrimitives.reduceByKey keys values reduceOp + let expectedKeys, expectedValues = + HostPrimitives.reduceByKey keys values reduceOp - "Keys must be the same" - |> Utils.compareArrays (=) actualKeys expectedKeys + "Keys must be the same" + |> Utils.compareArrays (=) actualKeys expectedKeys - "Values must the same" - |> Utils.compareArrays isEqual actualValues expectedValues + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues - let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = - let keys, values = - Array.sortBy fst arrayAndKeys |> Array.unzip +let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = + let keys, values = + Array.sortBy fst arrayAndKeys |> Array.unzip - if keys.Length > 0 then - let clKeys = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + if keys.Length > 0 then + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) - let clValues = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let resultLength = Array.length <| Array.distinct keys + let resultLength = Array.length <| Array.distinct keys - let clActualKeys, clActualValues: ClArray * ClArray<'a> = - reduce processor HostInterop resultLength clKeys clValues + let clActualKeys, clActualValues: ClArray * ClArray<'a> = + reduce processor HostInterop resultLength clKeys clValues - clValues.Free processor - clKeys.Free processor + clValues.Free processor + clKeys.Free processor - let actualValues = clActualValues.ToHostAndFree processor - let actualKeys = clActualKeys.ToHostAndFree processor + let actualValues = clActualValues.ToHostAndFree processor + let actualKeys = clActualKeys.ToHostAndFree processor - checkResult isEqual actualKeys actualValues keys values reduceOp + checkResult isEqual actualKeys actualValues keys values reduceOp - let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = +let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = - let reduce = - Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ + let reduce = + Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ - makeTest isEqual reduce reduceOp - |> testPropertyWithConfig config $"test on {typeof<'a>}" + makeTest isEqual reduce reduceOp + |> testPropertyWithConfig config $"test on {typeof<'a>}" - let sequentialTest = - let addTests = - testList - "add tests" - [ createTestSequential (=) (+) <@ (+) @> - createTestSequential (=) (+) <@ (+) @> +let sequentialTest = + let addTests = + testList + "add tests" + [ createTestSequential (=) (+) <@ (+) @> + createTestSequential (=) (+) <@ (+) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequential Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequential Utils.floatIsEqual (+) <@ (+) @> - createTestSequential Utils.float32IsEqual (+) <@ (+) @> - createTestSequential (=) (||) <@ (||) @> ] + createTestSequential Utils.float32IsEqual (+) <@ (+) @> + createTestSequential (=) (||) <@ (||) @> ] - let mulTests = - testList - "mul tests" - [ createTestSequential (=) (*) <@ (*) @> - createTestSequential (=) (*) <@ (*) @> + let mulTests = + testList + "mul tests" + [ createTestSequential (=) (*) <@ (*) @> + createTestSequential (=) (*) <@ (*) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequential Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequential Utils.floatIsEqual (*) <@ (*) @> - createTestSequential Utils.float32IsEqual (*) <@ (*) @> - createTestSequential (=) (&&) <@ (&&) @> ] + createTestSequential Utils.float32IsEqual (*) <@ (*) @> + createTestSequential (=) (&&) <@ (&&) @> ] - testList "Sequential" [ addTests; mulTests ] + testList "Sequential" [ addTests; mulTests ] - let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = - let reduce = - Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ +let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ - makeTest isEqual reduce reduceOp - |> testPropertyWithConfig - { config with - endSize = Utils.defaultWorkGroupSize } - $"test on {typeof<'a>}" + makeTest isEqual reduce reduceOp + |> testPropertyWithConfig + { config with + endSize = Utils.defaultWorkGroupSize } + $"test on {typeof<'a>}" - let oneWorkGroupTest = - let addTests = - testList - "add tests" - [ createTestOneWorkGroup (=) (+) <@ (+) @> - createTestOneWorkGroup (=) (+) <@ (+) @> +let oneWorkGroupTest = + let addTests = + testList + "add tests" + [ createTestOneWorkGroup (=) (+) <@ (+) @> + createTestOneWorkGroup (=) (+) <@ (+) @> - if Utils.isFloat64Available context.ClDevice then - createTestOneWorkGroup Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available context.ClDevice then + createTestOneWorkGroup Utils.floatIsEqual (+) <@ (+) @> - createTestOneWorkGroup Utils.float32IsEqual (+) <@ (+) @> - createTestOneWorkGroup (=) (||) <@ (||) @> ] + createTestOneWorkGroup Utils.float32IsEqual (+) <@ (+) @> + createTestOneWorkGroup (=) (||) <@ (||) @> ] - let mulTests = - testList - "mul tests" - [ createTestOneWorkGroup (=) (*) <@ (*) @> - createTestOneWorkGroup (=) (*) <@ (*) @> + let mulTests = + testList + "mul tests" + [ createTestOneWorkGroup (=) (*) <@ (*) @> + createTestOneWorkGroup (=) (*) <@ (*) @> - if Utils.isFloat64Available context.ClDevice then - createTestOneWorkGroup Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available context.ClDevice then + createTestOneWorkGroup Utils.floatIsEqual (*) <@ (*) @> - createTestOneWorkGroup Utils.float32IsEqual (*) <@ (*) @> - createTestOneWorkGroup (=) (&&) <@ (&&) @> ] + createTestOneWorkGroup Utils.float32IsEqual (*) <@ (*) @> + createTestOneWorkGroup (=) (&&) <@ (&&) @> ] - testList "One work group" [ addTests; mulTests ] + testList "One work group" [ addTests; mulTests ] - let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a) []) = +let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a) []) = - let valuesAndKeys = Array.sortBy fst valuesAndKeys + let valuesAndKeys = Array.sortBy fst valuesAndKeys - if valuesAndKeys.Length > 0 then - let offsets = - Array.map fst valuesAndKeys - |> HostPrimitives.getUniqueBitmapFirstOccurrence - |> HostPrimitives.getBitPositions + if valuesAndKeys.Length > 0 then + let offsets = + Array.map fst valuesAndKeys + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions - let resultLength = offsets.Length + let resultLength = offsets.Length - let keys, values = Array.unzip valuesAndKeys + let keys, values = Array.unzip valuesAndKeys - let clOffsets = - context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) - let clKeys = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) - let clValues = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let clReducedKeys, clReducedValues: ClArray * ClArray<'a> = - reduce processor DeviceOnly resultLength clOffsets clKeys clValues + let clReducedKeys, clReducedValues: ClArray * ClArray<'a> = + reduce processor DeviceOnly resultLength clOffsets clKeys clValues - let reducedKeys = clReducedKeys.ToHostAndFree processor - let reducedValues = clReducedValues.ToHostAndFree processor + let reducedKeys = clReducedKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor - checkResult isEqual reducedKeys reducedValues keys values reduceOp + checkResult isEqual reducedKeys reducedValues keys values reduceOp - let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = - let reduce = - Reduce.ByKey.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ +let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ - makeTestSequentialSegments isEqual reduce reduceOp - |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" + makeTestSequentialSegments isEqual reduce reduceOp + |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" - let sequentialSegmentTests = - let addTests = - testList - "add tests" - [ createTestSequentialSegments (=) (+) <@ (+) @> - createTestSequentialSegments (=) (+) <@ (+) @> +let sequentialSegmentTests = + let addTests = + testList + "add tests" + [ createTestSequentialSegments (=) (+) <@ (+) @> + createTestSequentialSegments (=) (+) <@ (+) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequentialSegments Utils.floatIsEqual (+) <@ (+) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments Utils.floatIsEqual (+) <@ (+) @> - createTestSequentialSegments Utils.float32IsEqual (+) <@ (+) @> - createTestSequentialSegments (=) (||) <@ (||) @> ] + createTestSequentialSegments Utils.float32IsEqual (+) <@ (+) @> + createTestSequentialSegments (=) (||) <@ (||) @> ] - let mulTests = - testList - "mul tests" - [ createTestSequentialSegments (=) (*) <@ (*) @> - createTestSequentialSegments (=) (*) <@ (*) @> + let mulTests = + testList + "mul tests" + [ createTestSequentialSegments (=) (*) <@ (*) @> + createTestSequentialSegments (=) (*) <@ (*) @> - if Utils.isFloat64Available context.ClDevice then - createTestSequentialSegments Utils.floatIsEqual (*) <@ (*) @> + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments Utils.floatIsEqual (*) <@ (*) @> - createTestSequentialSegments Utils.float32IsEqual (*) <@ (*) @> - createTestSequentialSegments (=) (&&) <@ (&&) @> ] + createTestSequentialSegments Utils.float32IsEqual (*) <@ (*) @> + createTestSequentialSegments (=) (&&) <@ (&&) @> ] - testList "Sequential segments" [ addTests; mulTests ] + testList "Sequential segments" [ addTests; mulTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs index 0b09a62c..c779ea07 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.Reduce +module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.Sum open Expecto open Expecto.Logging @@ -9,69 +9,68 @@ open GraphBLAS.FSharp.Tests open FSharp.Quotations open Context -module Sum = - let logger = Log.create "Sum.Test" +let logger = Log.create "Sum.Test" - let context = defaultContext.ClContext +let context = defaultContext.ClContext - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = 128 - let q = defaultContext.Queue +let wgSize = 128 +let q = defaultContext.Queue - let makeTest plus zero sum (array: 'a []) = - if array.Length > 0 then +let makeTest plus zero sum (array: 'a []) = + if array.Length > 0 then - logger.debug ( - eventX "Filtered array is {array}\n" - >> setField "array" (sprintf "%A" array) - ) + logger.debug ( + eventX "Filtered array is {array}\n" + >> setField "array" (sprintf "%A" array) + ) - let actualSum = - use clArray = context.CreateClArray array - use total = sum q clArray + let actualSum = + use clArray = context.CreateClArray array + use total = sum q clArray - let actualSum = [| zero |] - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)).[0] + let actualSum = [| zero |] + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)).[0] - logger.debug ( - eventX "Actual is {actual}\n" - >> setField "actual" (sprintf "%A" actualSum) - ) + logger.debug ( + eventX "Actual is {actual}\n" + >> setField "actual" (sprintf "%A" actualSum) + ) - let expectedSum = array |> Array.fold plus zero + let expectedSum = array |> Array.fold plus zero - logger.debug ( - eventX "Expected is {expected}\n" - >> setField "expected" (sprintf "%A" expectedSum) - ) + logger.debug ( + eventX "Expected is {expected}\n" + >> setField "expected" (sprintf "%A" expectedSum) + ) - "Total sums should be equal" - |> Expect.equal actualSum expectedSum + "Total sums should be equal" + |> Expect.equal actualSum expectedSum - let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = - Reduce.sum context wgSize plusQ zero - |> makeTest plus zero - |> testPropertyWithConfig config (sprintf "Correctness on %s" name) +let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = + Reduce.sum context wgSize plusQ zero + |> makeTest plus zero + |> testPropertyWithConfig config (sprintf "Correctness on %s" name) - let tests = +let tests = - q.Error.Add(fun e -> failwithf "%A" e) + q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 "int add" - testFixtures (+) <@ (+) @> 0uy "byte add" - testFixtures max <@ max @> 0 "int max" - testFixtures max <@ max @> 0uy "byte max" - testFixtures min <@ min @> System.Int32.MaxValue "int min" + [ testFixtures (+) <@ (+) @> 0 "int add" + testFixtures (+) <@ (+) @> 0uy "byte add" + testFixtures max <@ max @> 0 "int max" + testFixtures max <@ max @> 0uy "byte max" + testFixtures min <@ min @> System.Int32.MaxValue "int min" - if Utils.isFloat64Available context.ClDevice then - testFixtures min <@ min @> System.Double.MaxValue "float min" - testFixtures max <@ max @> 0.0 "float max" + if Utils.isFloat64Available context.ClDevice then + testFixtures min <@ min @> System.Double.MaxValue "float min" + testFixtures max <@ max @> 0.0 "float max" - testFixtures min <@ min @> System.Single.MaxValue "float32 min" - testFixtures max <@ max @> 0.0f "float32 max" + testFixtures min <@ min @> System.Single.MaxValue "float32 min" + testFixtures max <@ max @> 0.0f "float32 max" - testFixtures min <@ min @> System.Byte.MaxValue "byte min" - testFixtures (||) <@ (||) @> false "bool logic-or" - testFixtures (&&) <@ (&&) @> true "bool logic-and" ] - |> testList "Backend.Common.Sum tests" + testFixtures min <@ min @> System.Byte.MaxValue "byte min" + testFixtures (||) <@ (||) @> false "bool logic-or" + testFixtures (&&) <@ (&&) @> true "bool logic-and" ] + |> testList "Backend.Common.Sum tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index b3ead421..5730ca2e 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common +module GraphBLAS.FSharp.Tests.Backend.Common.Scatter open Expecto open Expecto.Logging @@ -7,58 +7,57 @@ open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Common -module Scatter = - let logger = Log.create "Scatter.Tests" +let logger = Log.create "Scatter.Tests" - let context = defaultContext.ClContext +let context = defaultContext.ClContext - let config = - { Tests.Utils.defaultConfig with - endSize = 1000000 } +let config = + { Tests.Utils.defaultConfig with + endSize = 1000000 } - let wgSize = Tests.Utils.defaultWorkGroupSize +let wgSize = Tests.Utils.defaultWorkGroupSize - let q = defaultContext.Queue +let q = defaultContext.Queue - let makeTest scatter (array: (int * 'a) []) (result: 'a []) = - if array.Length > 0 then - let expected = Array.copy result +let makeTest scatter (array: (int * 'a) []) (result: 'a []) = + if array.Length > 0 then + let expected = Array.copy result - array - |> Array.pairwise - |> Array.iter - (fun ((i, u), (j, _)) -> - if i <> j && 0 <= i && i < expected.Length then - expected.[i] <- u) + array + |> Array.pairwise + |> Array.iter + (fun ((i, u), (j, _)) -> + if i <> j && 0 <= i && i < expected.Length then + expected.[i] <- u) - let i, u = array.[array.Length - 1] + let i, u = array.[array.Length - 1] - if 0 <= i && i < expected.Length then - expected.[i] <- u + if 0 <= i && i < expected.Length then + expected.[i] <- u - let positions, values = Array.unzip array + let positions, values = Array.unzip array - let actual = - use clPositions = context.CreateClArray positions - use clValues = context.CreateClArray values - use clResult = context.CreateClArray result + let actual = + use clPositions = context.CreateClArray positions + use clValues = context.CreateClArray values + use clResult = context.CreateClArray result - scatter q clPositions clValues clResult + scatter q clPositions clValues clResult - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, Array.zeroCreate result.Length, ch)) + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, Array.zeroCreate result.Length, ch)) - $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" - |> Tests.Utils.compareArrays (=) actual expected + $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" + |> Tests.Utils.compareArrays (=) actual expected - let testFixtures<'a when 'a: equality> = - Scatter.runInplace<'a> context wgSize - |> makeTest - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" +let testFixtures<'a when 'a: equality> = + Scatter.runInplace<'a> context wgSize + |> makeTest + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" - let tests = - q.Error.Add(fun e -> failwithf $"%A{e}") +let tests = + q.Error.Add(fun e -> failwithf $"%A{e}") - [ testFixtures - testFixtures - testFixtures ] - |> testList "Backend.Common.Scatter tests" + [ testFixtures + testFixtures + testFixtures ] + |> testList "Backend.Common.Scatter tests" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs index 038401c7..150ec153 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Matrix +module GraphBLAS.FSharp.Tests.Backend.Matrix.Convert open Expecto open Expecto.Logging @@ -12,99 +12,98 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module Convert = - let logger = Log.create "Convert.Tests" - - let config = Utils.defaultConfig - - let workGroupSize = Utils.defaultWorkGroupSize - - let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = - let mtx = - Utils.createMatrixFromArray2D formatFrom array isZero - - if mtx.NNZ > 0 then - let actual = - let mBefore = mtx.ToDevice context - let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore - let res = mAfter.ToHost q - mBefore.Dispose q - mAfter.Dispose q - res - - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - let expected = - Utils.createMatrixFromArray2D formatTo array isZero - - "Matrices should be equal" - |> Expect.equal actual expected - - let testFixtures formatTo = - let getCorrectnessTestName datatype formatFrom = - $"Correctness on %s{datatype}, %A{formatFrom} to %A{formatTo}" - - let context = defaultContext.ClContext - let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) - - match formatTo with - | COO -> - [ let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | CSR -> - [ let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | CSC -> - [ let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - - let tests = - Utils.listOfUnionCases - |> List.collect testFixtures - |> testList "Convert tests" +let logger = Log.create "Convert.Tests" + +let config = Utils.defaultConfig + +let workGroupSize = Utils.defaultWorkGroupSize + +let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = + let mtx = + Utils.createMatrixFromArray2D formatFrom array isZero + + if mtx.NNZ > 0 then + let actual = + let mBefore = mtx.ToDevice context + let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore + let res = mAfter.ToHost q + mBefore.Dispose q + mAfter.Dispose q + res + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) + + let expected = + Utils.createMatrixFromArray2D formatTo array isZero + + "Matrices should be equal" + |> Expect.equal actual expected + +let testFixtures formatTo = + let getCorrectnessTestName datatype formatFrom = + $"Correctness on %s{datatype}, %A{formatFrom} to %A{formatTo}" + + let context = defaultContext.ClContext + let q = defaultContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + match formatTo with + | COO -> + [ let convertFun = Matrix.toCOO context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) 0) + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Matrix.toCOO context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) false) + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + | CSR -> + [ let convertFun = Matrix.toCSR context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) 0) + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Matrix.toCSR context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) false) + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + | CSC -> + [ let convertFun = Matrix.toCSC context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) 0) + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Matrix.toCSC context workGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun ((=) false) + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + +let tests = + Utils.listOfUnionCases + |> List.collect testFixtures + |> testList "Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index 03b13791..eeb1546f 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Matrix +module GraphBLAS.FSharp.Tests.Backend.Matrix.Map2 open Expecto open Expecto.Logging @@ -15,203 +15,190 @@ open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module Map2 = - let logger = Log.create "Map2.Tests" +let logger = Log.create "Map2.Tests" - let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let config = Utils.defaultConfig +let wgSize = Utils.defaultWorkGroupSize - let getCorrectnessTestName case datatype = - $"Correctness on %s{datatype}, %A{case}" +let getCorrectnessTestName case datatype = + $"Correctness on %s{datatype}, %A{case}" - let checkResult isEqual op zero (baseMtx1: 'a [,]) (baseMtx2: 'a [,]) (actual: Matrix<'a>) = - let rows = Array2D.length1 baseMtx1 - let columns = Array2D.length2 baseMtx1 - 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 checkResult isEqual op zero (baseMtx1: 'a [,]) (baseMtx2: 'a [,]) (actual: Matrix<'a>) = + let rows = Array2D.length1 baseMtx1 + let columns = Array2D.length2 baseMtx1 + 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 + 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 baseMtx1.[i, j] baseMtx2.[i, j] + for i in 0 .. rows - 1 do + for j in 0 .. columns - 1 do + expected2D.[i, j] <- op baseMtx1.[i, j] baseMtx2.[i, j] - let actual2D = Array2D.create rows columns zero + let actual2D = Array2D.create rows columns zero - match actual with - | Matrix.COO actual -> - for i in 0 .. actual.Rows.Length - 1 do - if isEqual zero actual.Values.[i] then - failwith "Resulting zeroes should be filtered." + match actual with + | Matrix.COO actual -> + for i in 0 .. actual.Rows.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." + 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 + "Arrays must be the same" + |> Utils.compare2DArrays isEqual actual2D expected2D - let correctnessGenericTest - zero - op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) - toCOOFun - (isEqual: 'a -> 'a -> bool) - q - (case: OperationCase) - (leftMatrix: 'a [,], rightMatrix: 'a [,]) - = +let correctnessGenericTest + zero + op + (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) + toCOOFun + (isEqual: 'a -> 'a -> bool) + q + (case: OperationCase) + (leftMatrix: 'a [,], rightMatrix: 'a [,]) + = - let mtx1 = - Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) + let mtx1 = + Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) - let mtx2 = - Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) + let mtx2 = + Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) - if mtx1.NNZ > 0 && mtx2.NNZ > 0 then - try - let m1 = mtx1.ToDevice case.TestContext.ClContext + if mtx1.NNZ > 0 && mtx2.NNZ > 0 then + try + let m1 = mtx1.ToDevice case.TestContext.ClContext - let m2 = mtx2.ToDevice case.TestContext.ClContext + let m2 = mtx2.ToDevice case.TestContext.ClContext - let res = addFun q HostInterop m1 m2 + let res = addFun q HostInterop m1 m2 - m1.Dispose q - m2.Dispose q + m1.Dispose q + m2.Dispose q - let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res - let actual = cooRes.ToHost q + let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res + let actual = cooRes.ToHost q - cooRes.Dispose q - res.Dispose q + cooRes.Dispose q + res.Dispose q - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) - checkResult isEqual op zero leftMatrix rightMatrix actual - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual op zero leftMatrix rightMatrix actual + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex - let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = - let getCorrectnessTestName = getCorrectnessTestName case +let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = + let getCorrectnessTestName = getCorrectnessTestName case - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - let map2 = map2 context addQ wgSize + let map2 = map2 context addQ wgSize - let toCOO = Matrix.toCOO context wgSize + let toCOO = Matrix.toCOO context wgSize - case - |> correctnessGenericTest zero add map2 toCOO isEqual q - |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") + case + |> correctnessGenericTest zero add map2 toCOO isEqual q + |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") - let testFixturesMap2Add case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) +let testFixturesMap2Add case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSum Matrix.map2 + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSum Matrix.map2 - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSum Matrix.map2 + if Utils.isFloat64Available context.ClDevice then + creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSum Matrix.map2 - creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32Sum Matrix.map2 - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSum Matrix.map2 ] + creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32Sum Matrix.map2 + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSum Matrix.map2 ] - let addTests = - operationGPUTests "Backend.Matrix.map2 add tests" testFixturesMap2Add +let addTests = + operationGPUTests "Backend.Matrix.map2 add tests" testFixturesMap2Add - let testFixturesMap2AddAtLeastOne case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) +let testFixturesMap2AddAtLeastOne case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOne - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add - case - 0.0 - (+) - Utils.floatIsEqual - ArithmeticOperations.floatSumAtLeastOne - Matrix.map2AtLeastOne + if Utils.isFloat64Available context.ClDevice then + creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSumAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add - case - 0.0f - (+) - Utils.float32IsEqual - ArithmeticOperations.float32SumAtLeastOne - Matrix.map2AtLeastOne - - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOne ] + creatTestMap2Add + case + 0.0f + (+) + Utils.float32IsEqual + ArithmeticOperations.float32SumAtLeastOne + Matrix.map2AtLeastOne + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOne ] - let addAtLeastOneTests = - operationGPUTests "Backend.Matrix.map2AtLeastOne add tests" testFixturesMap2AddAtLeastOne - let testFixturesMap2AddAtLeastOneToCOO case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) +let addAtLeastOneTests = + operationGPUTests "Backend.Matrix.map2AtLeastOne add tests" testFixturesMap2AddAtLeastOne - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOneToCOO - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOneToCOO +let testFixturesMap2AddAtLeastOneToCOO case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add - case - 0.0 - (+) - Utils.floatIsEqual - ArithmeticOperations.floatSumAtLeastOne - Matrix.map2AtLeastOneToCOO + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOneToCOO + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOneToCOO + if Utils.isFloat64Available context.ClDevice then creatTestMap2Add case - 0.0f + 0.0 (+) - Utils.float32IsEqual - ArithmeticOperations.float32SumAtLeastOne + Utils.floatIsEqual + ArithmeticOperations.floatSumAtLeastOne Matrix.map2AtLeastOneToCOO - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOneToCOO ] + creatTestMap2Add + case + 0.0f + (+) + Utils.float32IsEqual + ArithmeticOperations.float32SumAtLeastOne + Matrix.map2AtLeastOneToCOO - let addAtLeastOneToCOOTests = - operationGPUTests "Backend.Matrix.map2AtLeastOneToCOO add tests" testFixturesMap2AddAtLeastOneToCOO + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOneToCOO ] - let testFixturesMap2MulAtLeastOne case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) +let addAtLeastOneToCOOTests = + operationGPUTests "Backend.Matrix.map2AtLeastOneToCOO add tests" testFixturesMap2AddAtLeastOneToCOO - creatTestMap2Add case false (&&) (=) ArithmeticOperations.boolMulAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add case 0 (*) (=) ArithmeticOperations.intMulAtLeastOne Matrix.map2AtLeastOne +let testFixturesMap2MulAtLeastOne case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add - case - 0.0 - (*) - Utils.floatIsEqual - ArithmeticOperations.floatMulAtLeastOne - Matrix.map2AtLeastOne + creatTestMap2Add case false (&&) (=) ArithmeticOperations.boolMulAtLeastOne Matrix.map2AtLeastOne + creatTestMap2Add case 0 (*) (=) ArithmeticOperations.intMulAtLeastOne Matrix.map2AtLeastOne - creatTestMap2Add - case - 0.0f - (*) - Utils.float32IsEqual - ArithmeticOperations.float32MulAtLeastOne - Matrix.map2AtLeastOne + if Utils.isFloat64Available context.ClDevice then + creatTestMap2Add case 0.0 (*) Utils.floatIsEqual ArithmeticOperations.floatMulAtLeastOne Matrix.map2AtLeastOne + + creatTestMap2Add + case + 0.0f + (*) + Utils.float32IsEqual + ArithmeticOperations.float32MulAtLeastOne + Matrix.map2AtLeastOne - creatTestMap2Add case 0uy (*) (=) ArithmeticOperations.byteMulAtLeastOne Matrix.map2AtLeastOne ] + creatTestMap2Add case 0uy (*) (=) ArithmeticOperations.byteMulAtLeastOne Matrix.map2AtLeastOne ] - let mulAtLeastOneTests = - operationGPUTests "Backend.Matrix.map2AtLeastOne multiplication tests" testFixturesMap2MulAtLeastOne +let mulAtLeastOneTests = + operationGPUTests "Backend.Matrix.map2AtLeastOne multiplication tests" testFixturesMap2MulAtLeastOne diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs index 4ce0f52c..236f0973 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Matrix +module GraphBLAS.FSharp.Tests.Backend.Matrix.Mxm open Expecto open Expecto.Logging @@ -11,103 +11,102 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Test -module Mxm = - let logger = Log.create "Mxm.Tests" +let logger = Log.create "Mxm.Tests" - let context = defaultContext.ClContext - let workGroupSize = Utils.defaultWorkGroupSize +let context = defaultContext.ClContext +let workGroupSize = Utils.defaultWorkGroupSize - let makeTest context q zero isEqual plus mul mxmFun (leftMatrix: 'a [,], rightMatrix: 'a [,], mask: bool [,]) = +let makeTest context q zero isEqual plus mul mxmFun (leftMatrix: 'a [,], rightMatrix: 'a [,], mask: bool [,]) = - let m1 = - Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero) + let m1 = + Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero) - let m2 = - Utils.createMatrixFromArray2D CSC rightMatrix (isEqual zero) + let m2 = + Utils.createMatrixFromArray2D CSC rightMatrix (isEqual zero) - let matrixMask = - Utils.createMatrixFromArray2D COO mask ((=) false) + let matrixMask = + Utils.createMatrixFromArray2D COO mask ((=) false) - if m1.NNZ > 0 && m2.NNZ > 0 then - let expected = - Array2D.init - <| Array2D.length1 mask - <| Array2D.length2 mask - <| fun i j -> - if mask.[i, j] then - (leftMatrix.[i, *], rightMatrix.[*, j]) - ||> Array.map2 mul - |> Array.reduce plus - else - zero + if m1.NNZ > 0 && m2.NNZ > 0 then + let expected = + Array2D.init + <| Array2D.length1 mask + <| Array2D.length2 mask + <| fun i j -> + if mask.[i, j] then + (leftMatrix.[i, *], rightMatrix.[*, j]) + ||> Array.map2 mul + |> Array.reduce plus + else + zero - let expected = - Utils.createMatrixFromArray2D COO expected (isEqual zero) + let expected = + Utils.createMatrixFromArray2D COO expected (isEqual zero) - if expected.NNZ > 0 then - let m1 = m1.ToDevice context - let m2 = m2.ToDevice context - let matrixMask = matrixMask.ToDevice context + if expected.NNZ > 0 then + let m1 = m1.ToDevice context + let m2 = m2.ToDevice context + let matrixMask = matrixMask.ToDevice context - let (result: ClMatrix<'a>) = mxmFun q m1 m2 matrixMask - let actual = result.ToHost q + let (result: ClMatrix<'a>) = mxmFun q m1 m2 matrixMask + let actual = result.ToHost q - m1.Dispose q - m2.Dispose q - matrixMask.Dispose q - result.Dispose q + m1.Dispose q + m2.Dispose q + matrixMask.Dispose q + result.Dispose q - // Check result - "Matrices should be equal" - |> Expect.equal actual expected + // Check result + "Matrices should be equal" + |> Expect.equal actual expected - let tests = - let getCorrectnessTestName = sprintf "Correctness on %s" +let tests = + let getCorrectnessTestName = sprintf "Correctness on %s" - let config = - { Utils.defaultConfig with - arbitrary = [ typeof ] } + let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } - let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + let q = defaultContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - [ let add = - <@ fun x y -> - let mutable res = x + y + [ let add = + <@ fun x y -> + let mutable res = x + y - if res = 0 then None else (Some res) @> + if res = 0 then None else (Some res) @> - let mult = <@ fun x y -> Some(x * y) @> + let mult = <@ fun x y -> Some(x * y) @> - let mxmFun = - Matrix.mxm add mult context workGroupSize + let mxmFun = + Matrix.mxm add mult context workGroupSize - makeTest context q 0 (=) (+) (*) mxmFun - |> testPropertyWithConfig config (getCorrectnessTestName "int") + makeTest context q 0 (=) (+) (*) mxmFun + |> testPropertyWithConfig config (getCorrectnessTestName "int") - let logicalOr = - <@ fun x y -> - let mutable res = None + let logicalOr = + <@ fun x y -> + let mutable res = None - match x, y with - | false, false -> res <- None - | _ -> res <- Some true + match x, y with + | false, false -> res <- None + | _ -> res <- Some true - res @> + res @> - let logicalAnd = - <@ fun x y -> - let mutable res = None + let logicalAnd = + <@ fun x y -> + let mutable res = None - match x, y with - | true, true -> res <- Some true - | _ -> res <- None + match x, y with + | true, true -> res <- Some true + | _ -> res <- None - res @> + res @> - let mxmFun = - Matrix.mxm logicalOr logicalAnd context workGroupSize + let mxmFun = + Matrix.mxm logicalOr logicalAnd context workGroupSize - makeTest context q false (=) (||) (&&) mxmFun - |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] - |> testList "Mxm tests" + makeTest context q false (=) (||) (&&) mxmFun + |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] + |> testList "Mxm tests" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs index d7824ea7..4e894609 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Matrix +module GraphBLAS.FSharp.Tests.Backend.Matrix.Transpose open Expecto open Expecto.Logging @@ -12,128 +12,127 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module Transpose = - let logger = Log.create "Transpose.Tests" +let logger = Log.create "Transpose.Tests" - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let getCorrectnessTestName case datatype = - $"Correctness on %s{datatype}, %A{case.Format}, %A{case.TestContext}" +let getCorrectnessTestName case datatype = + $"Correctness on %s{datatype}, %A{case.Format}, %A{case.TestContext}" - let checkResult areEqual zero actual (expected2D: 'a [,]) = - match actual with - | Matrix.COO actual -> - let expected = - Matrix.COO.FromArray2D(expected2D, areEqual zero) +let checkResult areEqual zero actual (expected2D: 'a [,]) = + match actual with + | Matrix.COO actual -> + let expected = + Matrix.COO.FromArray2D(expected2D, areEqual zero) - "The number of rows should be the same" - |> Expect.equal actual.RowCount expected.RowCount + "The number of rows should be the same" + |> Expect.equal actual.RowCount expected.RowCount - "The number of columns should be the same" - |> Expect.equal actual.ColumnCount expected.ColumnCount + "The number of columns should be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount - "Row arrays should be equal" - |> Utils.compareArrays (=) actual.Rows expected.Rows + "Row arrays should be equal" + |> Utils.compareArrays (=) actual.Rows expected.Rows - "Column arrays should be equal" - |> Utils.compareArrays (=) actual.Columns expected.Columns + "Column arrays should be equal" + |> Utils.compareArrays (=) actual.Columns expected.Columns - "Value arrays should be equal" - |> Utils.compareArrays areEqual actual.Values expected.Values - | Matrix.CSR actual -> - let expected = - Matrix.CSR.FromArray2D(expected2D, areEqual zero) + "Value arrays should be equal" + |> Utils.compareArrays areEqual actual.Values expected.Values + | Matrix.CSR actual -> + let expected = + Matrix.CSR.FromArray2D(expected2D, areEqual zero) - "The number of rows should be the same" - |> Expect.equal actual.RowCount expected.RowCount + "The number of rows should be the same" + |> Expect.equal actual.RowCount expected.RowCount - "The number of columns should be the same" - |> Expect.equal actual.ColumnCount expected.ColumnCount + "The number of columns should be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount - "Row pointer arrays should be equal" - |> Utils.compareArrays (=) actual.RowPointers expected.RowPointers + "Row pointer arrays should be equal" + |> Utils.compareArrays (=) actual.RowPointers expected.RowPointers - "Column arrays should be equal" - |> Utils.compareArrays (=) actual.ColumnIndices expected.ColumnIndices + "Column arrays should be equal" + |> Utils.compareArrays (=) actual.ColumnIndices expected.ColumnIndices - "Value arrays should be equal" - |> Utils.compareArrays areEqual actual.Values expected.Values - | Matrix.CSC actual -> - let expected = - Matrix.CSC.FromArray2D(expected2D, areEqual zero) + "Value arrays should be equal" + |> Utils.compareArrays areEqual actual.Values expected.Values + | Matrix.CSC actual -> + let expected = + Matrix.CSC.FromArray2D(expected2D, areEqual zero) - "The number of rows should be the same" - |> Expect.equal actual.RowCount expected.RowCount + "The number of rows should be the same" + |> Expect.equal actual.RowCount expected.RowCount - "The number of columns should be the same" - |> Expect.equal actual.ColumnCount expected.ColumnCount + "The number of columns should be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount - "Row arrays should be equal" - |> Utils.compareArrays (=) actual.RowIndices expected.RowIndices + "Row arrays should be equal" + |> Utils.compareArrays (=) actual.RowIndices expected.RowIndices - "Column pointer arrays should be equal" - |> Utils.compareArrays (=) actual.ColumnPointers expected.ColumnPointers + "Column pointer arrays should be equal" + |> Utils.compareArrays (=) actual.ColumnPointers expected.ColumnPointers - "Value arrays should be equal" - |> Utils.compareArrays areEqual actual.Values expected.Values + "Value arrays should be equal" + |> Utils.compareArrays areEqual actual.Values expected.Values - let makeTestRegular context q transposeFun hostTranspose isEqual zero case (array: 'a [,]) = - let mtx = - Utils.createMatrixFromArray2D case.Format array (isEqual zero) +let makeTestRegular context q transposeFun hostTranspose isEqual zero case (array: 'a [,]) = + let mtx = + Utils.createMatrixFromArray2D case.Format array (isEqual zero) - if mtx.NNZ > 0 then - let actual = - let m = mtx.ToDevice context - let (mT: ClMatrix<'a>) = transposeFun q HostInterop m - let res = mT.ToHost q - m.Dispose q - mT.Dispose q - res + if mtx.NNZ > 0 then + let actual = + let m = mtx.ToDevice context + let (mT: ClMatrix<'a>) = transposeFun q HostInterop m + let res = mT.ToHost q + m.Dispose q + mT.Dispose q + res - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - let expected2D = hostTranspose array + let expected2D = hostTranspose array - checkResult isEqual zero actual expected2D + checkResult isEqual zero actual expected2D - let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue +let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - let transposeFun = Matrix.transpose context wgSize + let transposeFun = Matrix.transpose context wgSize - let twiceTranspose processor allocationFlag matrix = - transposeFun processor allocationFlag matrix - |> transposeFun processor allocationFlag + let twiceTranspose processor allocationFlag matrix = + transposeFun processor allocationFlag matrix + |> transposeFun processor allocationFlag - [ case - |> makeTestRegular context q transposeFun Utils.transpose2DArray isEqual zero - |> testPropertyWithConfig config "single transpose" + [ case + |> makeTestRegular context q transposeFun Utils.transpose2DArray isEqual zero + |> testPropertyWithConfig config "single transpose" - case - |> makeTestRegular context q twiceTranspose id isEqual zero - |> testPropertyWithConfig config "twice transpose" ] + case + |> makeTestRegular context q twiceTranspose id isEqual zero + |> testPropertyWithConfig config "twice transpose" ] - |> testList (getCorrectnessTestName case $"{typeof<'a>}") + |> testList (getCorrectnessTestName case $"{typeof<'a>}") - let testFixtures case = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) +let testFixtures case = + let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest case 0 (=) + [ createTest case 0 (=) - if Utils.isFloat64Available context.ClDevice then - createTest case 0.0 Utils.floatIsEqual + if Utils.isFloat64Available context.ClDevice then + createTest case 0.0 Utils.floatIsEqual - createTest case 0.0f Utils.float32IsEqual - createTest case 0uy (=) - createTest case false (=) ] + createTest case 0.0f Utils.float32IsEqual + createTest case 0uy (=) + createTest case false (=) ] - let tests = - operationGPUTests "Matrix.Transpose tests" testFixtures +let tests = + operationGPUTests "Matrix.Transpose tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs index 31455fd8..c4193eb3 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.AssignByMask open Expecto open Expecto.Logging @@ -13,135 +13,129 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module AssignByMask = - let logger = Log.create "Vector.assignByMask.Tests" +let logger = Log.create "Vector.assignByMask.Tests" - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let getCorrectnessTestName case datatype = - $"Correctness on %s{datatype}, vector: %A{case.Format}" +let getCorrectnessTestName case datatype = + $"Correctness on %s{datatype}, vector: %A{case.Format}" - let checkResult isZero isComplemented (actual: Vector<'a>) (vector: 'a []) (mask: 'a []) (value: 'a) = +let checkResult isZero isComplemented (actual: Vector<'a>) (vector: 'a []) (mask: 'a []) (value: 'a) = - let expectedArray = Array.zeroCreate vector.Length + let expectedArray = Array.zeroCreate vector.Length - let vector = - Utils.createVectorFromArray Dense vector isZero - |> Utils.vectorToDenseVector + let vector = + Utils.createVectorFromArray Dense vector isZero + |> Utils.vectorToDenseVector - let mask = - Utils.createVectorFromArray Dense mask isZero - |> Utils.vectorToDenseVector + let mask = + Utils.createVectorFromArray Dense mask isZero + |> Utils.vectorToDenseVector - for i in 0 .. vector.Length - 1 do - expectedArray.[i] <- - if isComplemented then - match vector.[i], mask.[i] with - | _, None -> Some value - | _ -> vector.[i] - else - match vector.[i], mask.[i] with - | _, Some _ -> Some value - | _ -> vector.[i] + for i in 0 .. vector.Length - 1 do + expectedArray.[i] <- + if isComplemented then + match vector.[i], mask.[i] with + | _, None -> Some value + | _ -> vector.[i] + else + match vector.[i], mask.[i] with + | _, Some _ -> Some value + | _ -> vector.[i] - match actual with - | Vector.Dense actual -> Expect.equal actual expectedArray "Arrays must be equals" - | _ -> failwith "Vector format must be Dense." + match actual with + | Vector.Dense actual -> Expect.equal actual expectedArray "Arrays must be equals" + | _ -> failwith "Vector format must be Dense." - let makeTest<'a when 'a: struct and 'a: equality> - (isZero: 'a -> bool) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (fillVector: MailboxProcessor - -> AllocationFlag - -> ClVector<'a> - -> ClVector<'a> - -> ClCell<'a> - -> ClVector<'a>) - isComplemented - case - (vector: 'a [], mask: 'a [], value: 'a) - = +let makeTest<'a when 'a: struct and 'a: equality> + (isZero: 'a -> bool) + (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (fillVector: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClCell<'a> -> ClVector<'a>) + isComplemented + case + (vector: 'a [], mask: 'a [], value: 'a) + = - let leftVector = - Utils.createVectorFromArray case.Format vector isZero + let leftVector = + Utils.createVectorFromArray case.Format vector isZero - let maskVector = - Utils.createVectorFromArray case.Format mask isZero + let maskVector = + Utils.createVectorFromArray case.Format mask isZero - if leftVector.NNZ > 0 && maskVector.NNZ > 0 then + if leftVector.NNZ > 0 && maskVector.NNZ > 0 then - let q = case.TestContext.Queue - let context = case.TestContext.ClContext + let q = case.TestContext.Queue + let context = case.TestContext.ClContext - let clLeftVector = leftVector.ToDevice context - let clMaskVector = maskVector.ToDevice context + let clLeftVector = leftVector.ToDevice context + let clMaskVector = maskVector.ToDevice context - try - let clValue = context.CreateClCell<'a> value + try + let clValue = context.CreateClCell<'a> value - let clActual = - fillVector q HostInterop clLeftVector clMaskVector clValue + let clActual = + fillVector q HostInterop clLeftVector clMaskVector clValue - let cooClActual = toDense q HostInterop clActual + let cooClActual = toDense q HostInterop clActual - let actual = cooClActual.ToHost q + let actual = cooClActual.ToHost q - clLeftVector.Dispose q - clMaskVector.Dispose q - clActual.Dispose q - cooClActual.Dispose q + clLeftVector.Dispose q + clMaskVector.Dispose q + clActual.Dispose q + cooClActual.Dispose q - checkResult isZero isComplemented actual vector mask value - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isZero isComplemented actual vector mask value + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex - let createTest case (isZero: 'a -> bool) isComplemented fill = - let context = case.TestContext.ClContext - let getCorrectnessTestName = getCorrectnessTestName case +let createTest case (isZero: 'a -> bool) isComplemented fill = + let context = case.TestContext.ClContext + let getCorrectnessTestName = getCorrectnessTestName case - let fill = fill context Mask.assign wgSize + let fill = fill context Mask.assign wgSize - let toCoo = Vector.toDense context wgSize + let toCoo = Vector.toDense context wgSize - case - |> makeTest isZero toCoo fill isComplemented - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> makeTest isZero toCoo fill isComplemented + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") - let testFixtures case = - let context = case.TestContext.ClContext +let testFixtures case = + let context = case.TestContext.ClContext - let isComplemented = false + let isComplemented = false - [ createTest case ((=) 0) isComplemented Vector.assignByMask + [ createTest case ((=) 0) isComplemented Vector.assignByMask - if Utils.isFloat64Available context.ClDevice then - createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMask + if Utils.isFloat64Available context.ClDevice then + createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMask - createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMask - createTest case ((=) 0uy) isComplemented Vector.assignByMask - createTest case ((=) false) isComplemented Vector.assignByMask ] + createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMask + createTest case ((=) 0uy) isComplemented Vector.assignByMask + createTest case ((=) false) isComplemented Vector.assignByMask ] - let tests = - operationGPUTests "Backend.Vector.assignByMask tests" - <| testFixtures +let tests = + operationGPUTests "Backend.Vector.assignByMask tests" + <| testFixtures - let testFixturesComplemented case = - let context = case.TestContext.ClContext +let testFixturesComplemented case = + let context = case.TestContext.ClContext - let isComplemented = true + let isComplemented = true - [ createTest case ((=) 0) isComplemented Vector.assignByMaskComplemented + [ createTest case ((=) 0) isComplemented Vector.assignByMaskComplemented - if Utils.isFloat64Available context.ClDevice then - createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMaskComplemented + if Utils.isFloat64Available context.ClDevice then + createTest case (Utils.floatIsEqual 0) isComplemented Vector.assignByMaskComplemented - createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMaskComplemented - createTest case ((=) 0uy) isComplemented Vector.assignByMaskComplemented - createTest case ((=) false) isComplemented Vector.assignByMaskComplemented ] + createTest case (Utils.float32IsEqual 0.0f) isComplemented Vector.assignByMaskComplemented + createTest case ((=) 0uy) isComplemented Vector.assignByMaskComplemented + createTest case ((=) false) isComplemented Vector.assignByMaskComplemented ] - let complementedTests = - operationGPUTests "Backend.Vector.assignByMaskComplemented tests" - <| testFixturesComplemented +let complementedTests = + operationGPUTests "Backend.Vector.assignByMaskComplemented tests" + <| testFixturesComplemented diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs index 57eccfae..2f586b03 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.Convert open Expecto open Expecto.Logging @@ -12,95 +12,94 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module Convert = - let logger = - Log.create "Backend.Vector.Convert.Tests" +let logger = + Log.create "Backend.Vector.Convert.Tests" - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let makeTest - formatFrom - (convertFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - isZero - case - (array: 'a []) - = +let makeTest + formatFrom + (convertFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + isZero + case + (array: 'a []) + = - let vector = - Utils.createVectorFromArray formatFrom array isZero + let vector = + Utils.createVectorFromArray formatFrom array isZero - if vector.NNZ > 0 then + if vector.NNZ > 0 then - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - let actual = - let clVector = vector.ToDevice context - let convertedVector = convertFun q HostInterop clVector + let actual = + let clVector = vector.ToDevice context + let convertedVector = convertFun q HostInterop clVector - let res = convertedVector.ToHost q + let res = convertedVector.ToHost q - clVector.Dispose q - convertedVector.Dispose q + clVector.Dispose q + convertedVector.Dispose q - res + res - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) - let expected = - Utils.createVectorFromArray case.Format array isZero + let expected = + Utils.createVectorFromArray case.Format array isZero - Expect.equal actual expected "Vectors must be the same" + Expect.equal actual expected "Vectors must be the same" - let testFixtures case = - let getCorrectnessTestName datatype formatFrom = - sprintf $"Correctness on %s{datatype}, %A{formatFrom} -> %A{case.Format}" +let testFixtures case = + let getCorrectnessTestName datatype formatFrom = + sprintf $"Correctness on %s{datatype}, %A{formatFrom} -> %A{case.Format}" - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue + + q.Error.Add(fun e -> failwithf "%A" e) + + match case.Format with + | Sparse -> + [ let convertFun = Vector.toSparse context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) 0) case + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Vector.toSparse context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) false) case + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + | Dense -> + [ let convertFun = Vector.toDense context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) 0) case + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Vector.toDense context wgSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) false) case + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat - q.Error.Add(fun e -> failwithf "%A" e) - - match case.Format with - | Sparse -> - [ let convertFun = Vector.toSparse context wgSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) 0) case - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Vector.toSparse context wgSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) false) case - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | Dense -> - [ let convertFun = Vector.toDense context wgSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) 0) case - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Vector.toDense context wgSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest formatFrom convertFun ((=) false) case - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - - let tests = - operationGPUTests "Backend.Vector.Convert tests" testFixtures +let tests = + operationGPUTests "Backend.Vector.Convert tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs b/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs index 8c9870b0..f5d28ca3 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.Copy open Expecto open Expecto.Logging @@ -11,79 +11,78 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module Copy = - let logger = Log.create "Vector.copy.Tests" +let logger = Log.create "Vector.copy.Tests" - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vector<'a>) = - Expect.equal actual.Size expected.Size "The size should be the same" +let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vector<'a>) = + Expect.equal actual.Size expected.Size "The size should be the same" - match actual, expected with - | Vector.Dense actual, Vector.Dense expected -> - let isEqual left right = - match left, right with - | Some left, Some right -> isEqual left right - | None, None -> true - | _, _ -> false + match actual, expected with + | Vector.Dense actual, Vector.Dense expected -> + let isEqual left right = + match left, right with + | Some left, Some right -> isEqual left right + | None, None -> true + | _, _ -> false - Utils.compareArrays isEqual actual expected "The values array must contain the default value" - | Vector.Sparse actual, Vector.Sparse expected -> - Utils.compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" - Utils.compareArrays (=) actual.Indices expected.Indices "The index array must contain the 0" - | _ -> failwith "Copy format must be the same" + Utils.compareArrays isEqual actual expected "The values array must contain the default value" + | Vector.Sparse actual, Vector.Sparse expected -> + Utils.compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" + Utils.compareArrays (=) actual.Indices expected.Indices "The index array must contain the 0" + | _ -> failwith "Copy format must be the same" - let correctnessGenericTest<'a when 'a: struct> - isEqual - zero - (copy: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (case: OperationCase) - (array: 'a []) - = +let correctnessGenericTest<'a when 'a: struct> + isEqual + zero + (copy: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (case: OperationCase) + (array: 'a []) + = - let expected = - Utils.createVectorFromArray case.Format array (isEqual zero) + let expected = + Utils.createVectorFromArray case.Format array (isEqual zero) - if array.Length > 0 && expected.NNZ > 0 then + if array.Length > 0 && expected.NNZ > 0 then - let q = case.TestContext.Queue - let context = case.TestContext.ClContext + let q = case.TestContext.Queue + let context = case.TestContext.ClContext - let clVector = expected.ToDevice context - let clVectorCopy = copy q HostInterop clVector - let actual = clVectorCopy.ToHost q + let clVector = expected.ToDevice context + let clVectorCopy = copy q HostInterop clVector + let actual = clVectorCopy.ToHost q - clVector.Dispose q - clVectorCopy.Dispose q + clVector.Dispose q + clVectorCopy.Dispose q - checkResult isEqual actual expected + checkResult isEqual actual expected - let createTest<'a when 'a: struct> case isEqual zero = - let context = case.TestContext.ClContext +let createTest<'a when 'a: struct> case isEqual zero = + let context = case.TestContext.ClContext - let getCorrectnessTestName datatype = - $"Correctness on %s{datatype}, %A{case.Format}" + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, %A{case.Format}" - let intCopy = Vector.copy context wgSize + let intCopy = Vector.copy context wgSize - case - |> correctnessGenericTest<'a> isEqual zero intCopy - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> correctnessGenericTest<'a> isEqual zero intCopy + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") - let testFixtures (case: OperationCase) = - let context = case.TestContext.ClContext +let testFixtures (case: OperationCase) = + let context = case.TestContext.ClContext - [ createTest case (=) 0 + [ createTest case (=) 0 - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 - createTest case Utils.float32IsEqual 0.0f - createTest case (=) false - createTest case (=) 0uy ] + createTest case Utils.float32IsEqual 0.0f + createTest case (=) false + createTest case (=) 0uy ] - let tests = - operationGPUTests "Backend.Vector.copy tests" testFixtures +let tests = + operationGPUTests "Backend.Vector.copy tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index 909f6ceb..33f4a693 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.Map2 open Expecto open Expecto.Logging @@ -12,199 +12,191 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module Map2 = - let logger = Log.create "Vector.ElementWise.Tests" +let logger = Log.create "Vector.ElementWise.Tests" - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let getCorrectnessTestName<'a> (case: OperationCase<'a>) dataType = - $"Correctness on '{dataType} option -> '{dataType} option -> '{dataType} option, {case.Format}" +let getCorrectnessTestName<'a> (case: OperationCase<'a>) dataType = + $"Correctness on '{dataType} option -> '{dataType} option -> '{dataType} option, {case.Format}" - let checkResult - isEqual - resultZero - (op: 'a -> 'b -> 'c) - (actual: Vector<'c>) - (leftArray: 'a []) - (rightArray: 'b []) - = +let checkResult isEqual resultZero (op: 'a -> 'b -> 'c) (actual: Vector<'c>) (leftArray: 'a []) (rightArray: 'b []) = - let expectedArrayLength = leftArray.Length + let expectedArrayLength = leftArray.Length - let expectedArray = - Array.create expectedArrayLength resultZero + let expectedArray = + Array.create expectedArrayLength resultZero - for i in 0 .. expectedArrayLength - 1 do - expectedArray.[i] <- op leftArray.[i] rightArray.[i] + for i in 0 .. expectedArrayLength - 1 do + expectedArray.[i] <- op leftArray.[i] rightArray.[i] - let expected = - Utils.createVectorFromArray Dense expectedArray (isEqual resultZero) - |> Utils.vectorToDenseVector + let expected = + Utils.createVectorFromArray Dense expectedArray (isEqual resultZero) + |> Utils.vectorToDenseVector - match actual with - | Vector.Dense actual -> - "arrays must have the same values" - |> Expect.equal actual expected - | _ -> failwith "Vector format must be Sparse." + match actual with + | Vector.Dense actual -> + "arrays must have the same values" + |> Expect.equal actual expected + | _ -> failwith "Vector format must be Sparse." - let correctnessGenericTest - isEqual - zero - op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a>) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - case - (leftArray: 'a [], rightArray: 'a []) - = +let correctnessGenericTest + isEqual + zero + op + (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a>) + (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + case + (leftArray: 'a [], rightArray: 'a []) + = - let isZero = (isEqual zero) + let isZero = (isEqual zero) - let firstVectorHost = - Utils.createVectorFromArray case.Format leftArray isZero + let firstVectorHost = + Utils.createVectorFromArray case.Format leftArray isZero - let secondVectorHost = - Utils.createVectorFromArray case.Format rightArray isZero + let secondVectorHost = + Utils.createVectorFromArray case.Format rightArray isZero - if firstVectorHost.NNZ > 0 - && secondVectorHost.NNZ > 0 then + if firstVectorHost.NNZ > 0 + && secondVectorHost.NNZ > 0 then - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - let firstVector = firstVectorHost.ToDevice context - let secondVector = secondVectorHost.ToDevice context + let firstVector = firstVectorHost.ToDevice context + let secondVector = secondVectorHost.ToDevice context - try - let res = - addFun q HostInterop firstVector secondVector + try + let res = + addFun q HostInterop firstVector secondVector - firstVector.Dispose q - secondVector.Dispose q + firstVector.Dispose q + secondVector.Dispose q - let denseActual = toDense q HostInterop res + let denseActual = toDense q HostInterop res - let actual = denseActual.ToHost q + let actual = denseActual.ToHost q - res.Dispose q - denseActual.Dispose q + res.Dispose q + denseActual.Dispose q - checkResult isEqual zero op actual leftArray rightArray - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual zero op actual leftArray rightArray + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex - let createTest case isEqual (zero: 'a) plus plusQ map2 = - let context = case.TestContext.ClContext +let createTest case isEqual (zero: 'a) plus plusQ map2 = + let context = case.TestContext.ClContext - let map2 = map2 context plusQ wgSize + let map2 = map2 context plusQ wgSize - let intToDense = Vector.toDense context wgSize + let intToDense = Vector.toDense context wgSize - case - |> correctnessGenericTest isEqual zero plus map2 intToDense - |> testPropertyWithConfig config (getCorrectnessTestName case $"%A{typeof<'a>}") + case + |> correctnessGenericTest isEqual zero plus map2 intToDense + |> testPropertyWithConfig config (getCorrectnessTestName case $"%A{typeof<'a>}") - let addTestFixtures case = - let context = case.TestContext.ClContext +let addTestFixtures case = + let context = case.TestContext.ClContext - [ createTest case (=) 0 (+) ArithmeticOperations.intSum Vector.map2 + [ createTest case (=) 0 (+) ArithmeticOperations.intSum Vector.map2 - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSum Vector.map2 + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSum Vector.map2 - createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32Sum Vector.map2 - createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 - createTest case (=) 0uy (+) ArithmeticOperations.byteSum Vector.map2 ] + createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32Sum Vector.map2 + createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 + createTest case (=) 0uy (+) ArithmeticOperations.byteSum Vector.map2 ] - let addTests = - operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures +let addTests = + operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures - let mulTestFixtures case = - let context = case.TestContext.ClContext +let mulTestFixtures case = + let context = case.TestContext.ClContext - [ createTest case (=) 0 (*) ArithmeticOperations.intMul Vector.map2 + [ createTest case (=) 0 (*) ArithmeticOperations.intMul Vector.map2 - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMul Vector.map2 + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMul Vector.map2 - createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32Mul Vector.map2 - createTest case (=) false (&&) ArithmeticOperations.boolMul Vector.map2 - createTest case (=) 0uy (*) ArithmeticOperations.byteMul Vector.map2 ] + createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32Mul Vector.map2 + createTest case (=) false (&&) ArithmeticOperations.boolMul Vector.map2 + createTest case (=) 0uy (*) ArithmeticOperations.byteMul Vector.map2 ] - let mulTests = - operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures +let mulTests = + operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures - let addAtLeastOneTestFixtures case = - let context = case.TestContext.ClContext +let addAtLeastOneTestFixtures case = + let context = case.TestContext.ClContext - [ createTest case (=) 0 (+) ArithmeticOperations.intSumAtLeastOne Vector.map2AtLeastOne + [ createTest case (=) 0 (+) ArithmeticOperations.intSumAtLeastOne Vector.map2AtLeastOne - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumAtLeastOne Vector.map2AtLeastOne + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumAtLeastOne Vector.map2AtLeastOne - createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumAtLeastOne Vector.map2AtLeastOne - createTest case (=) false (||) ArithmeticOperations.boolSumAtLeastOne Vector.map2AtLeastOne - createTest case (=) 0uy (+) ArithmeticOperations.byteSumAtLeastOne Vector.map2AtLeastOne ] + createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumAtLeastOne Vector.map2AtLeastOne + createTest case (=) false (||) ArithmeticOperations.boolSumAtLeastOne Vector.map2AtLeastOne + createTest case (=) 0uy (+) ArithmeticOperations.byteSumAtLeastOne Vector.map2AtLeastOne ] - let addAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2LeastOne add tests" addTestFixtures +let addAtLeastOneTests = + operationGPUTests "Backend.Vector.Map2LeastOne add tests" addTestFixtures - let mulAtLeastOneTestFixtures case = - let context = case.TestContext.ClContext - - [ createTest case (=) 0 (*) ArithmeticOperations.intMulAtLeastOne Vector.map2AtLeastOne +let mulAtLeastOneTestFixtures case = + let context = case.TestContext.ClContext - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMulAtLeastOne Vector.map2AtLeastOne + [ createTest case (=) 0 (*) ArithmeticOperations.intMulAtLeastOne Vector.map2AtLeastOne - createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32MulAtLeastOne Vector.map2AtLeastOne - createTest case (=) false (&&) ArithmeticOperations.boolMulAtLeastOne Vector.map2AtLeastOne - createTest case (=) 0uy (*) ArithmeticOperations.byteMulAtLeastOne Vector.map2AtLeastOne ] + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMulAtLeastOne Vector.map2AtLeastOne - let mulAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2AtLeasOne mul tests" mulTestFixtures + createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32MulAtLeastOne Vector.map2AtLeastOne + createTest case (=) false (&&) ArithmeticOperations.boolMulAtLeastOne Vector.map2AtLeastOne + createTest case (=) 0uy (*) ArithmeticOperations.byteMulAtLeastOne Vector.map2AtLeastOne ] - let fillSubVectorComplementedQ<'a, 'b> value = - <@ fun (left: 'a option) (right: 'b option) -> - match left with - | None -> Some value - | _ -> right @> +let mulAtLeastOneTests = + operationGPUTests "Backend.Vector.Map2AtLeasOne mul tests" mulTestFixtures - let fillSubVectorFun value zero isEqual = - fun left right -> - if isEqual left zero then - value - else - right +let fillSubVectorComplementedQ<'a, 'b> value = + <@ fun (left: 'a option) (right: 'b option) -> + match left with + | None -> Some value + | _ -> right @> - let complementedGeneralTestFixtures case = - let context = case.TestContext.ClContext +let fillSubVectorFun value zero isEqual = + fun left right -> + if isEqual left zero then + value + else + right - [ createTest case (=) 0 (fillSubVectorFun 1 0 (=)) (fillSubVectorComplementedQ 1) Vector.map2 +let complementedGeneralTestFixtures case = + let context = case.TestContext.ClContext - if Utils.isFloat64Available context.ClDevice then - createTest - case - Utils.floatIsEqual - 0.0 - (fillSubVectorFun 1.0 0.0 Utils.floatIsEqual) - (fillSubVectorComplementedQ 1.0) - Vector.map2 + [ createTest case (=) 0 (fillSubVectorFun 1 0 (=)) (fillSubVectorComplementedQ 1) Vector.map2 + if Utils.isFloat64Available context.ClDevice then createTest case - Utils.float32IsEqual - 0.0f - (fillSubVectorFun 1.0f 0.0f Utils.float32IsEqual) - (fillSubVectorComplementedQ 1.0f) + Utils.floatIsEqual + 0.0 + (fillSubVectorFun 1.0 0.0 Utils.floatIsEqual) + (fillSubVectorComplementedQ 1.0) Vector.map2 - createTest case (=) false (fillSubVectorFun true false (=)) (fillSubVectorComplementedQ true) Vector.map2 + createTest + case + Utils.float32IsEqual + 0.0f + (fillSubVectorFun 1.0f 0.0f Utils.float32IsEqual) + (fillSubVectorComplementedQ 1.0f) + Vector.map2 + + createTest case (=) false (fillSubVectorFun true false (=)) (fillSubVectorComplementedQ true) Vector.map2 - createTest case (=) 0uy (fillSubVectorFun 1uy 0uy (=)) (fillSubVectorComplementedQ 1uy) Vector.map2 ] + createTest case (=) 0uy (fillSubVectorFun 1uy 0uy (=)) (fillSubVectorComplementedQ 1uy) Vector.map2 ] - let complementedGeneralTests = - operationGPUTests "Backend.Vector.Map2Gen mask tests" complementedGeneralTestFixtures +let complementedGeneralTests = + operationGPUTests "Backend.Vector.Map2Gen mask tests" complementedGeneralTestFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs index 59fab292..6bc5a392 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.OfList open Expecto open Expecto.Logging @@ -12,94 +12,93 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module OfList = - let logger = Log.create "Vector.ofList.Tests" +let logger = Log.create "Vector.ofList.Tests" - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let checkResult - (isEqual: 'a -> 'a -> bool) - (expectedIndices: int []) - (expectedValues: 'a []) - (actual: Vector<'a>) - actualSize - = +let checkResult + (isEqual: 'a -> 'a -> bool) + (expectedIndices: int []) + (expectedValues: 'a []) + (actual: Vector<'a>) + actualSize + = - Expect.equal actual.Size actualSize "lengths must be the same" + Expect.equal actual.Size actualSize "lengths must be the same" - match actual with - | Vector.Sparse actual -> - Utils.compareArrays (=) actual.Indices expectedIndices "indices must be the same" - Utils.compareArrays isEqual actual.Values expectedValues "values must be the same" - | _ -> failwith "Vector format must be Sparse." + match actual with + | Vector.Sparse actual -> + Utils.compareArrays (=) actual.Indices expectedIndices "indices must be the same" + Utils.compareArrays isEqual actual.Values expectedValues "values must be the same" + | _ -> failwith "Vector format must be Sparse." - let correctnessGenericTest<'a when 'a: struct> - (isEqual: 'a -> 'a -> bool) - (ofList: MailboxProcessor<_> -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) - (toCoo: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (case: OperationCase) - (elements: (int * 'a) []) - (sizeDelta: int) - = +let correctnessGenericTest<'a when 'a: struct> + (isEqual: 'a -> 'a -> bool) + (ofList: MailboxProcessor<_> -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) + (toCoo: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (case: OperationCase) + (elements: (int * 'a) []) + (sizeDelta: int) + = - let elements = - elements |> Array.distinctBy fst |> List.ofArray + let elements = + elements |> Array.distinctBy fst |> List.ofArray - if elements.Length > 0 then + if elements.Length > 0 then - let q = case.TestContext.Queue + let q = case.TestContext.Queue - let indices, values = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip + let indices, values = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip - let actualSize = (Array.max indices) + abs sizeDelta + 1 + let actualSize = (Array.max indices) + abs sizeDelta + 1 - let clActual = - ofList q HostInterop case.Format actualSize elements + let clActual = + ofList q HostInterop case.Format actualSize elements - let clCooActual = toCoo q HostInterop clActual + let clCooActual = toCoo q HostInterop clActual - let actual = clCooActual.ToHost q + let actual = clCooActual.ToHost q - clActual.Dispose q - clCooActual.Dispose q + clActual.Dispose q + clCooActual.Dispose q - checkResult isEqual indices values actual actualSize + checkResult isEqual indices values actual actualSize - let creatTest<'a> case = - let getCorrectnessTestName datatype = - $"Correctness on %s{datatype}, %A{datatype}, %A{case.Format}" +let creatTest<'a> case = + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, %A{datatype}, %A{case.Format}" - let context = case.TestContext.ClContext + let context = case.TestContext.ClContext - let boolOfList = Vector.ofList context wgSize + let boolOfList = Vector.ofList context wgSize - let toCoo = Vector.toSparse context wgSize + let toCoo = Vector.toSparse context wgSize - case - |> correctnessGenericTest (=) boolOfList toCoo - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> correctnessGenericTest (=) boolOfList toCoo + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") - let testFixtures (case: OperationCase) = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue +let testFixtures (case: OperationCase) = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf $"%A{e}") + q.Error.Add(fun e -> failwithf $"%A{e}") - creatTest case - creatTest case - creatTest case + creatTest case + creatTest case + creatTest case - if Utils.isFloat64Available context.ClDevice then - creatTest case + if Utils.isFloat64Available context.ClDevice then + creatTest case - creatTest case ] + creatTest case ] - let tests = - operationGPUTests "Backend.Vector.ofList tests" testFixtures +let tests = + operationGPUTests "Backend.Vector.ofList tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs index 3c759387..cfbca46b 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.Reduce open Expecto open Expecto.Logging @@ -10,87 +10,86 @@ open TestCases open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Vector -module Reduce = - let logger = Log.create "Vector.reduce.Tests" +let logger = Log.create "Vector.reduce.Tests" - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let checkResult zero op (actual: 'a) (vector: 'a []) = - let expected = Array.fold op zero vector +let checkResult zero op (actual: 'a) (vector: 'a []) = + let expected = Array.fold op zero vector - "Results should be the same" - |> Expect.equal actual expected + "Results should be the same" + |> Expect.equal actual expected - let correctnessGenericTest - isEqual - zero - op - opQ - (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) - case - (array: 'a []) - = +let correctnessGenericTest + isEqual + zero + op + opQ + (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) + case + (array: 'a []) + = - let vector = - Utils.createVectorFromArray case.Format array (isEqual zero) + let vector = + Utils.createVectorFromArray case.Format array (isEqual zero) - if vector.NNZ > 0 then - let q = case.TestContext.Queue - let context = case.TestContext.ClContext + if vector.NNZ > 0 then + let q = case.TestContext.Queue + let context = case.TestContext.ClContext - let clVector = vector.ToDevice context + let clVector = vector.ToDevice context - let resultCell = reduce opQ q clVector + let resultCell = reduce opQ q clVector - let result = Array.zeroCreate 1 + let result = Array.zeroCreate 1 - let result = - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) + let result = + let res = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - q.Post(Msg.CreateFreeMsg<_>(resultCell)) + q.Post(Msg.CreateFreeMsg<_>(resultCell)) - res.[0] + res.[0] - checkResult zero op result array + checkResult zero op result array - let createTest<'a when 'a: equality and 'a: struct> case isEqual (zero: 'a) plus plusQ name = - let context = case.TestContext.ClContext +let createTest<'a when 'a: equality and 'a: struct> case isEqual (zero: 'a) plus plusQ name = + let context = case.TestContext.ClContext - let reduce = Vector.reduce context wgSize + let reduce = Vector.reduce context wgSize - case - |> correctnessGenericTest isEqual zero plus plusQ reduce - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}, %s{name} %A{case.Format}" + case + |> correctnessGenericTest isEqual zero plus plusQ reduce + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}, %s{name} %A{case.Format}" - let testFixtures case = +let testFixtures case = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest case (=) 0 (+) <@ (+) @> "add" - createTest case (=) 0uy (+) <@ (+) @> "add" - createTest case (=) System.Int32.MinValue max <@ max @> "max" + [ createTest case (=) 0 (+) <@ (+) @> "add" + createTest case (=) 0uy (+) <@ (+) @> "add" + createTest case (=) System.Int32.MinValue max <@ max @> "max" - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual System.Double.MinValue max <@ max @> "max" + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual System.Double.MinValue max <@ max @> "max" - createTest case Utils.float32IsEqual System.Single.MinValue max <@ max @> "max" - createTest case (=) System.Byte.MinValue max <@ max @> "max" - createTest case (=) System.Int32.MaxValue min <@ min @> "min" + createTest case Utils.float32IsEqual System.Single.MinValue max <@ max @> "max" + createTest case (=) System.Byte.MinValue max <@ max @> "max" + createTest case (=) System.Int32.MaxValue min <@ min @> "min" - if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual System.Double.MaxValue min <@ min @> "min" + if Utils.isFloat64Available context.ClDevice then + createTest case Utils.floatIsEqual System.Double.MaxValue min <@ min @> "min" - createTest case Utils.float32IsEqual System.Single.MaxValue min <@ min @> "min" - createTest case (=) System.Byte.MaxValue min <@ min @> "min" - createTest case (=) false (||) <@ (||) @> "add" - createTest case (=) true (&&) <@ (&&) @> "multiply" ] + createTest case Utils.float32IsEqual System.Single.MaxValue min <@ min @> "min" + createTest case (=) System.Byte.MaxValue min <@ min @> "min" + createTest case (=) false (||) <@ (||) @> "add" + createTest case (=) true (&&) <@ (&&) @> "multiply" ] - let tests = - operationGPUTests "Reduce tests" testFixtures +let tests = + operationGPUTests "Reduce tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index e4880d9a..90d90ef4 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.SpMV open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Expecto @@ -14,123 +14,120 @@ open GraphBLAS.FSharp.Backend.Vector open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects.ClContext -module SpMV = - let config = Utils.defaultConfig - - let wgSize = Utils.defaultWorkGroupSize - - let checkResult isEqual sumOp mulOp zero (baseMtx: 'a [,]) (baseVtr: 'a []) (actual: 'a option []) = - let rows = Array2D.length1 baseMtx - let columns = Array2D.length2 baseMtx - - let expected = Array.create rows zero - - for i in 0 .. rows - 1 do - let mutable sum = zero - - for v in 0 .. columns - 1 do - sum <- sumOp sum (mulOp baseMtx.[i, v] baseVtr.[v]) - - expected.[i] <- sum - - for i in 0 .. actual.Size - 1 do - match actual.[i] with - | Some v -> - if isEqual zero v then - failwith "Resulting zeroes should be implicit." - | None -> () - - for i in 0 .. actual.Size - 1 do - match actual.[i] with - | Some v -> - Expect.isTrue - (isEqual v expected.[i]) - $"Values should be the same. Actual is {v}, expected {expected.[i]}." - | None -> - Expect.isTrue - (isEqual zero expected.[i]) - $"Values should be the same. Actual is {zero}, expected {expected.[i]}." - - let correctnessGenericTest - zero - sumOp - mulOp - (spMV: MailboxProcessor<_> -> AllocationFlag -> ClMatrix.CSR<'a> -> ClArray<'a option> -> ClArray<'a option>) - (isEqual: 'a -> 'a -> bool) - q - (testContext: TestContext) - (matrix: 'a [,], vector: 'a [], _: bool []) - = - - let mtx = - Utils.createMatrixFromArray2D CSR matrix (isEqual zero) - - let vtr = - Utils.createVectorFromArray Dense vector (isEqual zero) - - if mtx.NNZ > 0 && vtr.Size > 0 then - try - let m = mtx.ToDevice testContext.ClContext - - match vtr, m with - | Vector.Dense vtr, ClMatrix.CSR m -> - let v = vtr.ToDevice testContext.ClContext - - let res = spMV testContext.Queue HostInterop m v - - (ClMatrix.CSR m).Dispose q - v.Dispose q - let hostRes = res.ToHost q - res.Dispose q - - checkResult isEqual sumOp mulOp zero matrix vector hostRes - | _ -> failwith "Impossible" - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex - - let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = - let context = testContext.ClContext - let q = testContext.Queue - - let getCorrectnessTestName datatype = - $"Correctness on %s{datatype}, %A{testContext.ClContext}" - - let spMV = SpMV.run context addQ mulQ wgSize - - testContext - |> correctnessGenericTest zero add mul spMV isEqual q - |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") - - - let testFixturesSpMV (testContext: TestContext) = - [ let context = testContext.ClContext - let q = testContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) - - createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMul - createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSum ArithmeticOperations.intMul - - if Utils.isFloat64Available context.ClDevice then - createTest - testContext - 0.0 - Utils.floatIsEqual - (+) - (*) - ArithmeticOperations.floatSum - ArithmeticOperations.floatMul +let config = Utils.defaultConfig +let wgSize = Utils.defaultWorkGroupSize + +let checkResult isEqual sumOp mulOp zero (baseMtx: 'a [,]) (baseVtr: 'a []) (actual: 'a option []) = + let rows = Array2D.length1 baseMtx + let columns = Array2D.length2 baseMtx + + let expected = Array.create rows zero + + for i in 0 .. rows - 1 do + let mutable sum = zero + + for v in 0 .. columns - 1 do + sum <- sumOp sum (mulOp baseMtx.[i, v] baseVtr.[v]) + + expected.[i] <- sum + + for i in 0 .. actual.Size - 1 do + match actual.[i] with + | Some v -> + if isEqual zero v then + failwith "Resulting zeroes should be implicit." + | None -> () + + for i in 0 .. actual.Size - 1 do + match actual.[i] with + | Some v -> + Expect.isTrue (isEqual v expected.[i]) $"Values should be the same. Actual is {v}, expected {expected.[i]}." + | None -> + Expect.isTrue + (isEqual zero expected.[i]) + $"Values should be the same. Actual is {zero}, expected {expected.[i]}." + +let correctnessGenericTest + zero + sumOp + mulOp + (spMV: MailboxProcessor<_> -> AllocationFlag -> ClMatrix.CSR<'a> -> ClArray<'a option> -> ClArray<'a option>) + (isEqual: 'a -> 'a -> bool) + q + (testContext: TestContext) + (matrix: 'a [,], vector: 'a [], _: bool []) + = + + let mtx = + Utils.createMatrixFromArray2D CSR matrix (isEqual zero) + + let vtr = + Utils.createVectorFromArray Dense vector (isEqual zero) + + if mtx.NNZ > 0 && vtr.Size > 0 then + try + let m = mtx.ToDevice testContext.ClContext + + match vtr, m with + | Vector.Dense vtr, ClMatrix.CSR m -> + let v = vtr.ToDevice testContext.ClContext + + let res = spMV testContext.Queue HostInterop m v + + (ClMatrix.CSR m).Dispose q + v.Dispose q + let hostRes = res.ToHost q + res.Dispose q + + checkResult isEqual sumOp mulOp zero matrix vector hostRes + | _ -> failwith "Impossible" + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex + +let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = + let context = testContext.ClContext + let q = testContext.Queue + + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, %A{testContext.ClContext}" + + let spMV = SpMV.run context addQ mulQ wgSize + + testContext + |> correctnessGenericTest zero add mul spMV isEqual q + |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") + + +let testFixturesSpMV (testContext: TestContext) = + [ let context = testContext.ClContext + let q = testContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMul + createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSum ArithmeticOperations.intMul + + if Utils.isFloat64Available context.ClDevice then createTest testContext - 0.0f - Utils.float32IsEqual + 0.0 + Utils.floatIsEqual (+) (*) - ArithmeticOperations.float32Sum - ArithmeticOperations.float32Mul - - createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSum ArithmeticOperations.byteMul ] - - let tests = - gpuTests "Backend.Vector.SpMV tests" testFixturesSpMV + ArithmeticOperations.floatSum + ArithmeticOperations.floatMul + + createTest + testContext + 0.0f + Utils.float32IsEqual + (+) + (*) + ArithmeticOperations.float32Sum + ArithmeticOperations.float32Mul + + createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSum ArithmeticOperations.byteMul ] + +let tests = + gpuTests "Backend.Vector.SpMV tests" testFixturesSpMV diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs index a7e59b7a..313e0066 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Vector +module GraphBLAS.FSharp.Tests.Backend.Vector.ZeroCreate open Expecto open Expecto.Logging @@ -12,71 +12,70 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext -module ZeroCreate = - let logger = Log.create "Vector.zeroCreate.Tests" +let logger = Log.create "Vector.zeroCreate.Tests" - let config = Utils.defaultConfig +let config = Utils.defaultConfig - let wgSize = Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize - let checkResult size (actual: Vector<'a>) = - Expect.equal actual.Size size "The size should be the same" +let checkResult size (actual: Vector<'a>) = + Expect.equal actual.Size size "The size should be the same" - match actual with - | Vector.Dense vector -> - Array.iter - <| (fun item -> Expect.equal item None "values must be None") - <| vector - | Vector.Sparse vector -> - Expect.equal vector.Values [| Unchecked.defaultof<'a> |] "The values array must contain the default value" - Expect.equal vector.Indices [| 0 |] "The index array must contain the 0" + match actual with + | Vector.Dense vector -> + Array.iter + <| (fun item -> Expect.equal item None "values must be None") + <| vector + | Vector.Sparse vector -> + Expect.equal vector.Values [| Unchecked.defaultof<'a> |] "The values array must contain the default value" + Expect.equal vector.Indices [| 0 |] "The index array must contain the 0" - let correctnessGenericTest<'a when 'a: struct and 'a: equality> - (zeroCreate: MailboxProcessor<_> -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) - (case: OperationCase) - (vectorSize: int) - = +let correctnessGenericTest<'a when 'a: struct and 'a: equality> + (zeroCreate: MailboxProcessor<_> -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) + (case: OperationCase) + (vectorSize: int) + = - let vectorSize = abs vectorSize + let vectorSize = abs vectorSize - if vectorSize > 0 then - let q = case.TestContext.Queue + if vectorSize > 0 then + let q = case.TestContext.Queue - let clVector = - zeroCreate q HostInterop vectorSize case.Format + let clVector = + zeroCreate q HostInterop vectorSize case.Format - let hostVector = clVector.ToHost q + let hostVector = clVector.ToHost q - clVector.Dispose q + clVector.Dispose q - checkResult vectorSize hostVector + checkResult vectorSize hostVector - let createTest<'a> case = - let getCorrectnessTestName dataType = - $"Correctness on %A{dataType}, %A{case.Format}" +let createTest<'a> case = + let getCorrectnessTestName dataType = + $"Correctness on %A{dataType}, %A{case.Format}" - let context = case.TestContext.ClContext + let context = case.TestContext.ClContext - let intZeroCreate = Vector.zeroCreate context wgSize + let intZeroCreate = Vector.zeroCreate context wgSize - case - |> correctnessGenericTest intZeroCreate - |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") + case + |> correctnessGenericTest intZeroCreate + |> testPropertyWithConfig config (getCorrectnessTestName $"%A{typeof<'a>}") - let testFixtures case = - let context = case.TestContext.ClContext - let q = case.TestContext.Queue +let testFixtures case = + let context = case.TestContext.ClContext + let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + q.Error.Add(fun e -> failwithf "%A" e) - [ createTest case - createTest case + [ createTest case + createTest case - if Utils.isFloat64Available context.ClDevice then - createTest case + if Utils.isFloat64Available context.ClDevice then + createTest case - createTest case - createTest case ] + createTest case + createTest case ] - let tests = - operationGPUTests "Backend.Vector.zeroCreate tests" testFixtures +let tests = + operationGPUTests "Backend.Vector.zeroCreate tests" testFixtures From 647d19dc26e481f2d7d7b46914de20f3e1da1e4d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 25 Mar 2023 13:09:51 +0300 Subject: [PATCH 028/143] refactor: Search.Bin.byKey2D --- src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs | 4 ++-- src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs index 9cd4433d..567bc993 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -27,10 +27,10 @@ module internal Map2 = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) let leftValue = - (%Search.Bin.byKey2) leftValuesLength index leftRows leftColumns leftValues + (%Search.Bin.byKey2D) leftValuesLength index leftRows leftColumns leftValues let rightValue = - (%Search.Bin.byKey2) rightValuesLength index rightRows rightColumn rightValues + (%Search.Bin.byKey2D) rightValuesLength index rightRows rightColumn rightValues match (%op) leftValue rightValue with | Some value -> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index 00cd8e0a..a61d4fd1 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -35,7 +35,7 @@ module Search = /// Searches value in array by two keys. /// In case there is a value at the given keys position, it is returned. /// - let byKey2<'a> = + let byKey2D<'a> = <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> let mutable leftEdge = 0 From 953be9b25eaf7ec1fce2c288a6fdb7cc19218436 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Sat, 25 Mar 2023 15:45:39 +0300 Subject: [PATCH 029/143] refactor: rename functions in binSearch module --- src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs | 3 +-- src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs | 4 ++-- src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs | 2 +- src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs | 4 ++-- src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs | 4 ++-- 5 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs index 7352785d..26df8f65 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs @@ -9,7 +9,6 @@ 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 = @@ -27,7 +26,7 @@ module internal Map = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) let value = - (%BinSearch.searchCOO) valuesLength index rows columns values + (%BinSearch.byKey2D) valuesLength index rows columns values match (%op) value with | Some resultValue -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs index cccef30a..adf5fdeb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -26,10 +26,10 @@ module internal Map2 = (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) let leftValue = - (%BinSearch.searchCOO) leftValuesLength index leftRows leftColumns leftValues + (%BinSearch.byKey2D) leftValuesLength index leftRows leftColumns leftValues let rightValue = - (%BinSearch.searchCOO) rightValuesLength index rightRows rightColumn rightValues + (%BinSearch.byKey2D) rightValuesLength index rightRows rightColumn rightValues match (%op) leftValue rightValue with | Some value -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs index c61cf19f..c75daf90 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs @@ -27,7 +27,7 @@ module internal Map = let lastIndex = rowPointers.[rowIndex + 1] - 1 let value = - (%BinSearch.searchInRange) startIndex lastIndex columnIndex columns values + (%BinSearch.inRange) startIndex lastIndex columnIndex columns values match (%op) value with | Some resultValue -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs index cc0883d4..e65c870e 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs @@ -30,10 +30,10 @@ module internal Map2 = let rightLastIndex = rightRowPointers.[rowIndex + 1] - 1 let leftValue = - (%BinSearch.searchInRange) leftStartIndex leftLastIndex columnIndex leftColumns leftValues + (%BinSearch.inRange) leftStartIndex leftLastIndex columnIndex leftColumns leftValues let rightValue = - (%BinSearch.searchInRange) rightStartIndex rightLastIndex columnIndex rightColumn rightValues + (%BinSearch.inRange) rightStartIndex rightLastIndex columnIndex rightColumn rightValues match (%op) leftValue rightValue with | Some value -> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs index 2dcf421f..c645f2af 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/BinSearch.fs @@ -12,7 +12,7 @@ module BinSearch = /// 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 searchInRange<'a> = + let inRange<'a> = <@ fun leftEdge rightEdge sourceIndex (indices: ClArray) (values: ClArray<'a>) -> let mutable leftEdge = leftEdge @@ -43,7 +43,7 @@ module BinSearch = /// /// Position is uint64 and it should be written in such format: first 32 bits is row, second 32 bits is column. /// - let searchCOO<'a> = + let byKey2D<'a> = <@ fun lenght sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) (values: ClArray<'a>) -> let mutable leftEdge = 0 From 02b702fdce6c11489c7fa26a901ead6e7d554fd8 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Sat, 25 Mar 2023 15:46:31 +0300 Subject: [PATCH 030/143] add: map tests for integer support --- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index 07c05f30..fb4dbf28 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -118,6 +118,8 @@ let testFixturesMapAdd case = 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 @@ -133,6 +135,8 @@ let testFixturesMapMul case = 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 From edfa3ff672913e1bc7509cfce89ef8c65b28022c Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Sat, 25 Mar 2023 16:28:11 +0300 Subject: [PATCH 031/143] fix: map tests --- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index fb4dbf28..229271b7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -135,7 +135,7 @@ let testFixturesMapMul case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - createTestMap case 0 10 (+) (=) ArithmeticOperations.mulLeftConst + createTestMap case 0 10 (*) (=) ArithmeticOperations.mulLeftConst if Utils.isFloat64Available context.ClDevice then createTestMap case 0.0 10.0 (*) Utils.floatIsEqual ArithmeticOperations.mulLeftConst From b2384b9c84c606e1b3523d6cb63f54c842673c7e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 25 Mar 2023 18:20:32 +0300 Subject: [PATCH 032/143] refactor: tests float shift --- tests/GraphBLAS-sharp.Tests/Generators.fs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) 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 = From 6da457b53008d03a4e1fb5578253e5aceb8e2305 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 27 Mar 2023 23:18:45 +0300 Subject: [PATCH 033/143] add: reduceByKey2D --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 146 +++++++++++++++++ .../Matrix/CSRMatrix/Matrix.fs | 49 ++++++ .../Common/Reduce/ReduceByKey.fs | 154 ++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Helpers.fs | 10 +- tests/GraphBLAS-sharp.Tests/Program.fs | 19 +-- 5 files changed, 366 insertions(+), 12 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index bbfa8af9..ca84fab9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -470,3 +470,149 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) reducedKeys, reducedValues + + module ByKey2D = + /// + /// Reduce an array of values by 2D keys using a single work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + + let kernel = + <@ fun (ndRange: Range1D) length (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + let mutable firstCurrentKey = firstKeys.[0] + let mutable secondCurrentKey = secondKeys.[0] + + let mutable segmentResult = values.[0] + let mutable segmentCount = 0 + + for i in 1 .. length - 1 do + if firstCurrentKey = firstKeys.[i] + && secondCurrentKey = secondKeys.[i] then + segmentResult <- (%reduceOp) segmentResult values.[i] + else + reducedValues.[segmentCount] <- segmentResult + + firstReducedKeys.[segmentCount] <- firstCurrentKey + secondReducedKeys.[segmentCount] <- secondCurrentKey + + segmentCount <- segmentCount + 1 + firstCurrentKey <- firstKeys.[i] + secondCurrentKey <- secondKeys.[i] + segmentResult <- values.[i] + + firstReducedKeys.[segmentCount] <- firstCurrentKey + secondReducedKeys.[segmentCount] <- secondCurrentKey + + reducedValues.[segmentCount] <- segmentResult @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange firstKeys.Length firstKeys secondKeys values reducedValues firstReducedKeys secondReducedKeys) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + firstReducedKeys, secondReducedKeys, reducedValues + + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] + + let firstSourceKey = firstKeys.[startPosition] + let secondSourceKey = secondKeys.[startPosition] + + let mutable sum = values.[startPosition] + + let mutable currentPosition = startPosition + 1 + + while currentPosition < keysLength + && firstSourceKey = firstKeys.[currentPosition] + && secondSourceKey = secondKeys.[currentPosition] do + + sum <- (%reduceOp) sum values.[currentPosition] + currentPosition <- currentPosition + 1 + + reducedValues.[gid] <- sum + firstReducedKeys.[gid] <- firstSourceKey + secondReducedKeys.[gid] <- secondSourceKey @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + firstReducedKeys, secondReducedKeys, reducedValues diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index ebb33542..2dcccb74 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -8,6 +8,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Matrix = let private expandRowPointers (clContext: ClContext) workGroupSize = @@ -153,3 +154,51 @@ module Matrix = fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> run queue matrixLeft matrixRight mask + + let spgemm + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c>) + (opMul: Expr<'a -> 'b -> 'c>) + = + + let expand = SpGEMM.Expand.run clContext workGroupSize opMul + + let expandRowPointers = expandRowPointers clContext workGroupSize + + let sortData = Sort.Radix.runByKeysStandard clContext workGroupSize + + let sortKeys = Sort.Radix.runByKeysStandard clContext workGroupSize + + let reduceByKey = Reduce.ByKey.segmentSequential clContext workGroupSize opAdd + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let multiplicationResult, columns, rowPointers = + expand processor leftMatrix rightMatrix + + let rows = + expandRowPointers processor DeviceOnly rowPointers columns.Length leftMatrix.RowCount + + rowPointers.Free processor + + // sorting + let sortData = sortData processor + let sortKeys = sortKeys processor + + // by columns + let valuesSortedByColumns = sortData columns multiplicationResult + let byKeSortedRows = sortKeys columns rows + + multiplicationResult.Free processor + rows.Free processor + + // by rows + let values = sortData byKeSortedRows valuesSortedByColumns + let columns = sortKeys byKeSortedRows columns + + // reduce + + + + () + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 6ef76e26..b0f24510 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -2,6 +2,7 @@ module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.ByKey open Expecto open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp @@ -185,3 +186,156 @@ let sequentialSegmentTests = createTestSequentialSegments (=) (&&) <@ (&&) @> ] testList "Sequential segments" [ addTests; mulTests ] + +let checkResult2D isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp = + + let expectedFirstKeys, expectedSecondKeys, expectedValues = + HostPrimitives.reduceByKey2D firstKeys secondKeys values reduceOp + + "First keys must be the same" + |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys + + "Second keys must be the same" + |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys + + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + +let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = + let firstKeys, secondKeys, values = + array + |> Array.sortBy (fun (fst, snd, _) -> fst, snd) + |> Array.unzip3 + + if firstKeys.Length > 0 then + let clFirstKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, firstKeys) + + let clSecondKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, secondKeys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let resultLength = Array.length <| Array.distinctBy (fun (fst, snd, _) -> (fst, snd)) array + + let clFirstActualKeys, clSecondActualKeys, clActualValues: ClArray * ClArray * ClArray<'a> = + reduce processor HostInterop resultLength clFirstKeys clSecondKeys clValues + + clValues.Free processor + clFirstKeys.Free processor + clSecondKeys.Free processor + + let actualValues = clActualValues.ToHostAndFree processor + let firstActualKeys = clFirstActualKeys.ToHostAndFree processor + let secondActualKeys = clSecondActualKeys.ToHostAndFree processor + + checkResult2D isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp + +let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + + let reduce = + Reduce.ByKey2D.sequential context Utils.defaultWorkGroupSize reduceOpQ + + makeTest2D isEqual reduce reduceOp + |> testPropertyWithConfig { config with arbitrary = [ typeof ]; endSize = 10 } $"test on {typeof<'a>}" + +let sequential2DTest = + let addTests = + testList + "add tests" + [ createTestSequential2D (=) (+) <@ (+) @> + createTestSequential2D (=) (+) <@ (+) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequential2D Utils.floatIsEqual (+) <@ (+) @> + + createTestSequential2D Utils.float32IsEqual (+) <@ (+) @> + createTestSequential2D (=) (||) <@ (||) @> ] + + let mulTests = + testList + "mul tests" + [ createTestSequential2D (=) (*) <@ (*) @> + createTestSequential2D (=) (*) <@ (*) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequential2D Utils.floatIsEqual (*) <@ (*) @> + + createTestSequential2D Utils.float32IsEqual (*) <@ (*) @> + createTestSequential2D (=) (&&) <@ (&&) @> ] + + testList "Sequential 2D" [ addTests; mulTests ] + +let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a) []) = + + let firstKeys, secondKeys, values = + array + |> Array.sortBy (fun (fst, snd, _) -> fst, snd) + |> Array.unzip3 + + if firstKeys.Length > 0 then + let offsets = + array + |> Array.map (fun (fst, snd, _) -> fst, snd) + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions + + let resultLength = offsets.Length + + let firstKeys, secondKeys, values = Array.unzip3 array + + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + let clFirstKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, firstKeys) + + let clSecondKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, secondKeys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = + reduce processor DeviceOnly resultLength clOffsets clFirstKeys clSecondKeys clValues + + let reducedFirsKeys = clFirstActualKeys.ToHostAndFree processor + let reducesSecondKeys = clSecondActualKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor + + checkResult2D isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp + +let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey2D.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + + makeTestSequentialSegments2D isEqual reduce reduceOp + |> testPropertyWithConfig { config with arbitrary = [ typeof ] } $"test on {typeof<'a>}" + +let sequentialSegmentTests2D = + let addTests = + testList + "add tests" + [ createTestSequentialSegments2D (=) (+) <@ (+) @> + createTestSequentialSegments2D (=) (+) <@ (+) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments2D Utils.floatIsEqual (+) <@ (+) @> + + createTestSequentialSegments2D Utils.float32IsEqual (+) <@ (+) @> + createTestSequentialSegments2D (=) (||) <@ (||) @> ] + + let mulTests = + testList + "mul tests" + [ createTestSequentialSegments2D (=) (*) <@ (*) @> + createTestSequentialSegments2D (=) (*) <@ (*) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments2D Utils.floatIsEqual (*) <@ (*) @> + + createTestSequentialSegments2D Utils.float32IsEqual (*) <@ (*) @> + createTestSequentialSegments2D (=) (&&) <@ (&&) @> ] + + testList "Sequential segments 2D" [ addTests; mulTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index bde711fb..ca38bf69 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -233,8 +233,8 @@ module HostPrimitives = |> Array.mapi (fun index bit -> if bit = 1 then Some index else None) |> Array.choose id - let reduceByKey keys value reduceOp = - let zipped = Array.zip keys value + let reduceByKey keys values reduceOp = + let zipped = Array.zip keys values Array.distinct keys |> Array.map @@ -247,6 +247,12 @@ module HostPrimitives = |> Array.map (fun (key, values) -> key, Array.reduce reduceOp values) |> Array.unzip + let reduceByKey2D firstKeys secondKeys values reduceOp = + Array.zip firstKeys secondKeys + |> fun compactedKeys -> reduceByKey compactedKeys values reduceOp + ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) + |> Array.unzip3 + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 491f3935..3f47eaa1 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -90,17 +90,16 @@ open GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM // testList "Algorithms tests" [ Algorithms.BFS.tests ] // |> testSequenced // -// [] -// let allTests = -// testList -// "All tests" -// [ matrixTests -// commonTests -// vectorTests -// algorithmsTests ] -// |> testSequenced +[] +let allTests = + testList + "All tests" + [ Common.Reduce.ByKey.sequential2DTest + Common.Reduce.ByKey.sequentialSegmentTests2D ] + + |> testSequenced [] -let main argv = Expand.testFixtures |> runTestsWithCLIArgs [] argv +let main argv = allTests |> runTestsWithCLIArgs [] argv From 66c2711cf23ba85b71a7ff666b26aa70ed3e4d28 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 1 Apr 2023 17:08:40 +0300 Subject: [PATCH 034/143] refactor: wip --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 54 +-- .../Matrix/CSRMatrix/Matrix.fs | 48 +-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 375 ++---------------- src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 4 + 4 files changed, 76 insertions(+), 405 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 8b241511..fe562625 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -5,6 +5,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module ClArray = let init (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = @@ -33,30 +34,6 @@ module ClArray = outputArray - let assignManyInit (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = - - let init = - <@ fun (range: Range1D) indicesLength (indices: ClArray) (outputBuffer: ClArray<'a>) -> - - let gid = range.GlobalID0 - - if gid < indicesLength then - let targetIndex = indices.[gid] - - outputBuffer.[targetIndex] <- (%initializer) gid @> - - let program = clContext.Compile(init) - - fun (processor: MailboxProcessor<_>) (indices: ClArray) (result: ClArray<'a>) -> - - let kernel = program.GetKernel() - - let ndRange = - Range1D.CreateValid(indices.Length, workGroupSize) - - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange indices.Length indices result)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - let create (clContext: ClContext) workGroupSize = let create = @@ -315,6 +292,24 @@ module ClArray = resultArray + let getUniqueBitmap2<'a when 'a: equality> (clContext: ClContext) workGroupSize = + + let map = map2 clContext workGroupSize <@ fun x y -> if x = 1 && y = 1 then 1 else 0 @> + + let getUniqueBitmap = getUniqueBitmap clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> + let firstBitmap = getUniqueBitmap processor DeviceOnly firstArray + + let secondBitmap = getUniqueBitmap processor DeviceOnly secondArray + + let result = map processor allocationMode firstBitmap secondBitmap + + firstBitmap.Free processor + secondBitmap.Free processor + + result + let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = let getBitmap = map<'a, int> clContext workGroupSize @@ -353,3 +348,14 @@ module ClArray = scatter processor positions values result result + + let iterate (clContext: ClContext) workGroupSize iterator = + + let create = create clContext workGroupSize iterator + + let scatter = Scatter.runInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> + + let positions = create processor allocationMode + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index 2dcccb74..f23db2f4 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -9,6 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell module Matrix = let private expandRowPointers (clContext: ClContext) workGroupSize = @@ -155,50 +156,3 @@ module Matrix = run queue matrixLeft matrixRight mask - let spgemm - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c>) - (opMul: Expr<'a -> 'b -> 'c>) - = - - let expand = SpGEMM.Expand.run clContext workGroupSize opMul - - let expandRowPointers = expandRowPointers clContext workGroupSize - - let sortData = Sort.Radix.runByKeysStandard clContext workGroupSize - - let sortKeys = Sort.Radix.runByKeysStandard clContext workGroupSize - - let reduceByKey = Reduce.ByKey.segmentSequential clContext workGroupSize opAdd - - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let multiplicationResult, columns, rowPointers = - expand processor leftMatrix rightMatrix - - let rows = - expandRowPointers processor DeviceOnly rowPointers columns.Length leftMatrix.RowCount - - rowPointers.Free processor - - // sorting - let sortData = sortData processor - let sortKeys = sortKeys processor - - // by columns - let valuesSortedByColumns = sortData columns multiplicationResult - let byKeSortedRows = sortKeys columns rows - - multiplicationResult.Free processor - rows.Free processor - - // by rows - let values = sortData byKeSortedRows valuesSortedByColumns - let columns = sortKeys byKeSortedRows columns - - // reduce - - - - () - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 14a97111..da373352 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -2,390 +2,97 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell -open FSharp.Quotations -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions type Indices = ClArray type Values<'a> = ClArray<'a> module Expand = - /// - /// Get the number of non-zero elements for each row of the right matrix for non-zero item in left matrix. - /// - let requiredRawsLengths = - <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> - let columnIndex = leftMatrixColumnsIndices.[gid] - let startRawIndex = rightMatrixRawPointers.[columnIndex] - let exclusiveRawEndIndex = rightMatrixRawPointers.[columnIndex + 1] - - exclusiveRawEndIndex - startRawIndex @> - - /// - /// Get the pointer to right matrix raw for each non-zero in left matrix. - /// - let requiredRawPointers = - <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> - let columnIndex = leftMatrixColumnsIndices.[gid] - let startRawIndex = rightMatrixRawPointers.[columnIndex] - - startRawIndex @> - - let processLeftMatrixColumnsAndRightMatrixRawPointers (clContext: ClContext) workGroupSize writeOperation = - - let kernel = - <@ fun (ndRange: Range1D) columnsLength (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - if gid < columnsLength then - result.[gid] <- (%writeOperation) gid leftMatrixColumnsIndices rightMatrixRawPointers @> - - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> - let resultLength = leftMatrixColumnsIndices.Length - - let requiredRawsLengths = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - leftMatrixColumnsIndices - rightMatrixRawPointers - requiredRawsLengths) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - requiredRawsLengths - - let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = - - let getUniqueBitmap = - ClArray.getUniqueBitmap clContext workGroupSize - - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext workGroupSize - - let indicesScatter = - Scatter.runInplace clContext workGroupSize - - let dataScatter = - Scatter.runInplace clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> + let getRowsLengths (clContext: ClContext) workGroupSize = - let leftMatrixRequiredPositions, resultLength = - let bitmap = - getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions + let create = + ClArray.init clContext workGroupSize Map.inc - let length = (prefixSumExclude processor bitmap).ToHostAndFree processor + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - bitmap, length + let scatter = Scatter.runInplace clContext workGroupSize - let requiredLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let subtraction = ClArray.map2 clContext workGroupSize Map.subtraction - indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues + fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: Indices) -> - let requiredLeftMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let positions = create processor DeviceOnly rowPointers.Length - dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns + let shiftedPointers = zeroCreate processor DeviceOnly rowPointers.Length - leftMatrixRequiredPositions.Free processor + scatter processor positions rowPointers shiftedPointers - requiredLeftMatrixColumns, requiredLeftMatrixValues - - let getGlobalMap (clContext: ClContext) workGroupSize = - - let zeroCreate = ClArray.zeroCreate clContext workGroupSize - - let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> - - let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> - - /// We get an array of zeros - let globalPositions = zeroCreate processor DeviceOnly resultLength - - // Insert units at the beginning of new lines (source positions) - assignUnits processor globalRightMatrixValuesPositions globalPositions - - // Apply the prefix sum, SIDE EFFECT!!! - // get an array where different sub-arrays of pointers to elements of the same row differ in values - (prefixSum processor globalPositions).Free processor - - globalPositions - - let getResultRowPointers (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - // do not touch the last element - if gid < length - 1 then - let rowPointer = leftMatrixRowPointers.[gid] - let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] - - result.[gid] <- globalPointer @> - - let kernel = clContext.Compile kernel - - let createResultPointersBuffer = ClArray.create clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (globalLength: int) (leftMatrixRowPointers: Indices) (globalRightMatrixRowPointers: Indices) -> - - // The last element must be equal to the length of the global array. let result = - createResultPointersBuffer processor DeviceOnly leftMatrixRowPointers.Length globalLength - - let kernel = kernel.GetKernel() - - // do not touch the last element - let ndRange = - Range1D.CreateValid(leftMatrixRowPointers.Length - 1, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftMatrixRowPointers.Length - leftMatrixRowPointers - globalRightMatrixRowPointers - result) - ) + subtraction processor allocationMode shiftedPointers rowPointers - processor.Post <| Msg.CreateRunMsg<_, _> kernel + positions.Free processor + rowPointers.Free processor result - let processPositions (clContext: ClContext) workGroupSize = + let expand (clContext: ClContext) workGroupSize = + let init = ClArray.init clContext workGroupSize Map.id - let getRequiredRawsLengths = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + let scatter = Scatter.runInplace clContext workGroupSize - let removeDuplications = ClArray.removeDuplications clContext workGroupSize + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext workGroupSize + let maxPrefixSum = PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize - let extractLeftMatrixRequiredValuesAndColumns = - extractLeftMatrixRequiredValuesAndColumns clContext workGroupSize + let initWithUnits = ClArray.init clContext workGroupSize <@ fun _ -> 1 @> - let getGlobalPositions = getGlobalMap clContext workGroupSize + fun (processor: MailboxProcessor<_>) lengths (segmentLengths: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let getRowPointers = getResultRowPointers clContext workGroupSize + // Compute A positions + let sequence = init processor DeviceOnly segmentLengths.Length - let getRequiredRightMatrixValuesPointers = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + let APositions = zeroCreate processor DeviceOnly lengths - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - // array of required right matrix rows length obtained by left matrix columns - let requiredRawsLengths = - getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers - - // global expanded array length (sum of previous length) SIDE EFFECT!!! - let globalLength = - (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor - - // rename array after side effect of prefix sum include - // positions in global array for right matrix raws with duplicates - let globalRightMatrixRowsStartPositions = requiredRawsLengths - - /// Extract required left matrix columns and values by global right matrix pointers. - /// Then get required right matrix rows (pointers to rows) by required left matrix columns. - - // extract required left matrix columns and rows by right matrix rows positions - let requiredLeftMatrixColumns, requiredLeftMatrixValues = - extractLeftMatrixRequiredValuesAndColumns processor leftMatrix globalRightMatrixRowsStartPositions - - // pointers to required raws in right matrix values - // rows to be placed by globalRightMatrixRowsStartPositionsWithoutDuplicates - let requiredRightMatrixRawPointers = - getRequiredRightMatrixValuesPointers processor requiredLeftMatrixColumns rightMatrix.RowPointers - - requiredLeftMatrixColumns.Free processor - - // remove duplications in right matrix rows positions in global extended array - let globalRightMatrixRawsPointersWithoutDuplicates = - removeDuplications processor globalRightMatrixRowsStartPositions - - // RESULT row pointers into result expanded (obtained by multiplication) array - let resultRowPointers = - getRowPointers processor globalLength leftMatrix.RowPointers globalRightMatrixRowsStartPositions - - globalRightMatrixRowsStartPositions.Free processor - - // int map to distinguish different raws in a general array. 1 for first, 2 for second and so forth... - let globalMap = - getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates - - globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers, resultRowPointers - - let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - if gid < length then - // index corresponding to the position of pointers - let positionIndex = globalPositions.[gid] - 1 // TODO() - - // the position of the beginning of a new line of pointers - let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] - - // offset from the source pointer - let offsetFromSourcePosition = gid - sourcePosition - - // pointer to the first element in the row of the right matrix from which - // the offset will be counted to get pointers to subsequent elements in this row - let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] - - // adding up the mix with the source pointer, - // we get a pointer to a specific element in the raw - result.[gid] <- sourcePointer + offsetFromSourcePosition @> - - let kernel = clContext.Compile kernel + scatter processor segmentLengths sequence APositions - fun (processor: MailboxProcessor<_>) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalMap: Indices) -> + sequence.Free processor - let globalRightMatrixValuesPointers = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) + maxPrefixSum processor APositions 0 - let kernel = kernel.GetKernel() + // Compute B positions - let ndRange = - Range1D.CreateValid(globalMap.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - globalMap.Length - globalRightMatrixRawsStartPositions - requiredRightMatrixValuesPointers - globalMap - globalRightMatrixValuesPointers) - ) - processor.Post <| Msg.CreateRunMsg<_, _> kernel - globalRightMatrixValuesPointers - let expandLeftMatrixValues (clContext: ClContext) workGroupSize = + let run (clContext: ClContext) workGroupSize = - let kernel = - <@ fun (ndRange: Range1D) resultLength (globalBitmap: Indices) (leftMatrixValues: Values<'a>) (resultValues: Values<'a>) -> + let getRowsLengths = getRowsLengths clContext workGroupSize - let gid = ndRange.GlobalID0 + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - // globalBitmap.Length == resultValues.Length - if gid < resultLength then - let valueIndex = globalBitmap.[gid] - 1 //TODO() + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - resultValues.[gid] <- leftMatrixValues.[valueIndex] @> + let gather = Gather.run clContext workGroupSize - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (globalMap: Indices) (leftMatrixValues: Values<'a>) -> - - let expandedLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) - - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(globalMap.Length, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - globalMap.Length - globalMap - leftMatrixValues - expandedLeftMatrixValues) - ) - - processor.Post <| Msg.CreateRunMsg<_, _> kernel - - expandedLeftMatrixValues - - let getRightMatrixColumnsAndValues (clContext: ClContext) workGroupSize = - let gatherRightMatrixData = Gather.run clContext workGroupSize - - let gatherIndices = Gather.run clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (globalPositions: Indices) (rightMatrix: ClMatrix.CSR<'a>) -> - // gather all required right matrix values - let extendedRightMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - - gatherRightMatrixData processor globalPositions rightMatrix.Values extendedRightMatrixValues - - // gather all required right matrix column indices - let extendedRightMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - - gatherIndices processor globalPositions rightMatrix.Columns extendedRightMatrixColumns - - extendedRightMatrixValues, extendedRightMatrixColumns - - let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = - - let processPositions = processPositions clContext workGroupSize - - let expandLeftMatrixValues = - expandLeftMatrixValues clContext workGroupSize - - let expandRightMatrixValuesPointers = - expandRightMatrixValuesIndices clContext workGroupSize - - let getRightMatrixColumnsAndValues = - getRightMatrixColumnsAndValues clContext workGroupSize + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let map2 = ClArray.map2 clContext workGroupSize multiplication + let bRowsLengths = getRowsLengths processor DeviceOnly rightMatrix.RowPointers - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let segmentsLengths = zeroCreate processor DeviceOnly leftMatrix.Columns.Length + gather processor leftMatrix.Columns bRowsLengths segmentsLengths - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPositions processor leftMatrix rightMatrix + bRowsLengths.Free processor - // left matrix values correspondingly to right matrix values - let extendedLeftMatrixValues = - expandLeftMatrixValues processor globalMap requiredLeftMatrixValues + let length = (prefixSum processor segmentsLengths).ToHostAndFree processor - // extended pointers to all required right matrix numbers - let globalRightMatrixValuesPointers = - expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap - let extendedRightMatrixValues, extendedRightMatrixColumns = - getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers rightMatrix - /// Multiplication - let multiplicationResult = - map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues + () - multiplicationResult, extendedRightMatrixColumns, resultRowPointers diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 2ec988d5..483c6c80 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -21,3 +21,7 @@ module Map = match (%map) item with | Some _ -> 1 | None -> 0 @> + + let inc = <@ fun item -> item + 1 @> + + let subtraction = <@ fun first second -> first - second @> From fa392b00acc8e6ea7bb427ac41ae4573362a6915 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 1 Apr 2023 21:17:39 +0300 Subject: [PATCH 035/143] refactor: prefix sum --- .../Common/PrefixSum.fs | 179 ++++++++++++++---- src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs | 74 +++++++- 2 files changed, 213 insertions(+), 40 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index b25cd85e..2ca44f81 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -3,6 +3,9 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp open FSharp.Quotations open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ClContext module PrefixSum = let private update (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = @@ -38,7 +41,7 @@ module PrefixSum = ) processor.Post(Msg.CreateRunMsg<_, _> kernel) - processor.Post(Msg.CreateFreeMsg(mirror)) + mirror.Free processor let private scanGeneral beforeLocalSumClear @@ -48,10 +51,8 @@ module PrefixSum = workGroupSize = - let subSum = SubSum.treeSum opAdd - let scan = - <@ fun (ndRange: Range1D) inputArrayLength verticesLength (resultBuffer: ClArray<'a>) (verticesBuffer: ClArray<'a>) (totalSumBuffer: ClCell<'a>) (zero: ClCell<'a>) (mirror: ClCell) -> + <@ fun (ndRange: Range1D) inputArrayLength verticesLength (inputArray: ClArray<'a>) (verticesBuffer: ClArray<'a>) (totalSumBuffer: ClCell<'a>) (zero: ClCell<'a>) (mirror: ClCell) -> let mirror = mirror.Value @@ -62,46 +63,34 @@ module PrefixSum = if mirror then i <- inputArrayLength - 1 - i - let localID = ndRange.LocalID0 + let lid = ndRange.LocalID0 let zero = zero.Value if gid < inputArrayLength then - resultLocalBuffer.[localID] <- resultBuffer.[i] + resultLocalBuffer.[lid] <- inputArray.[i] else - resultLocalBuffer.[localID] <- zero + resultLocalBuffer.[lid] <- zero barrierLocal () - (%subSum) workGroupSize localID resultLocalBuffer - - if localID = workGroupSize - 1 then - if verticesLength <= 1 && localID = gid then - totalSumBuffer.Value <- resultLocalBuffer.[localID] - - verticesBuffer.[gid / workGroupSize] <- resultLocalBuffer.[localID] - (%beforeLocalSumClear) resultBuffer resultLocalBuffer.[localID] inputArrayLength gid i - resultLocalBuffer.[localID] <- zero - - let mutable step = workGroupSize - - while step > 1 do - barrierLocal () + // Local tree reduce + (%SubSum.upSweep opAdd) workGroupSize lid resultLocalBuffer - if localID < workGroupSize / step then - let i = step * (localID + 1) - 1 - let j = i - (step >>> 1) + if lid = workGroupSize - 1 then + // if last iteration + if verticesLength <= 1 && lid = gid then + totalSumBuffer.Value <- resultLocalBuffer.[lid] - let tmp = resultLocalBuffer.[i] - let buff = (%opAdd) tmp resultLocalBuffer.[j] - resultLocalBuffer.[i] <- buff - resultLocalBuffer.[j] <- tmp + verticesBuffer.[gid / workGroupSize] <- resultLocalBuffer.[lid] + (%beforeLocalSumClear) inputArray resultLocalBuffer.[lid] inputArrayLength gid i + resultLocalBuffer.[lid] <- zero - step <- step >>> 1 + (%SubSum.downSweep opAdd) workGroupSize lid resultLocalBuffer barrierLocal () - (%writeData) resultBuffer resultLocalBuffer inputArrayLength workGroupSize gid i localID @> + (%writeData) inputArray resultLocalBuffer inputArrayLength workGroupSize gid i lid @> let program = clContext.Compile(scan) @@ -132,13 +121,14 @@ module PrefixSum = ) processor.Post(Msg.CreateRunMsg<_, _> kernel) - processor.Post(Msg.CreateFreeMsg(zero)) - processor.Post(Msg.CreateFreeMsg(mirror)) + + zero.Free processor + mirror.Free processor let private scanExclusive<'a when 'a: struct> = scanGeneral <@ fun (_: ClArray<'a>) (_: 'a) (_: int) (_: int) (_: int) -> () @> - <@ fun (resultBuffer: ClArray<'a>) (resultLocalBuffer: 'a []) (inputArrayLength: int) (smth: int) (gid: int) (i: int) (localID: int) -> + <@ fun (resultBuffer: ClArray<'a>) (resultLocalBuffer: 'a []) (inputArrayLength: int) (_: int) (gid: int) (i: int) (localID: int) -> if gid < inputArrayLength then resultBuffer.[i] <- resultLocalBuffer.[localID] @> @@ -147,8 +137,7 @@ module PrefixSum = scanGeneral <@ fun (resultBuffer: ClArray<'a>) (value: 'a) (inputArrayLength: int) (gid: int) (i: int) -> - if gid < inputArrayLength then - resultBuffer.[i] <- value @> + if gid < inputArrayLength then resultBuffer.[i] <- value @> <@ fun (resultBuffer: ClArray<'a>) (resultLocalBuffer: 'a []) (inputArrayLength: int) (workGroupSize: int) (gid: int) (i: int) (localID: int) -> if gid < inputArrayLength @@ -206,8 +195,8 @@ module PrefixSum = verticesArrays <- swap verticesArrays verticesLength <- (verticesLength - 1) / workGroupSize + 1 - processor.Post(Msg.CreateFreeMsg(firstVertices)) - processor.Post(Msg.CreateFreeMsg(secondVertices)) + firstVertices.Free processor + secondVertices.Free processor totalSum @@ -270,3 +259,119 @@ module PrefixSum = fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> scan processor inputArray 0 + + + module ByKey = + let private oneWorkGroup + writeZero + zero + uniqueKey + (opAdd: Expr<'a -> 'a -> 'a>) + (clContext: ClContext) + workGroupSize + = + + let scan = + <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (keys: ClArray) -> + + let localValues = localArray<'a> workGroupSize + let localKeys = localArray workGroupSize + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + if gid < length then + // only one workgroup + localValues.[lid] <- values.[lid] + localKeys.[lid] <- keys.[gid] + else + localValues.[lid] <- zero + localKeys.[lid] <- uniqueKey + + barrierLocal () + + // Local tree reduce + (%SubSum.upSweepByKey opAdd) workGroupSize lid localValues localKeys + + // if root item + if lid = workGroupSize - 1 + || localValues.[lid] <> localValues.[lid + 1] then + + (%writeZero) localValues lid zero + + (%SubSum.downSweepByKey opAdd) workGroupSize lid localValues localKeys + + barrierLocal () + + values.[lid] <- localValues.[lid] @> + + let program = clContext.Compile(scan) + + fun (processor: MailboxProcessor<_>) (keys: ClArray) (values: ClArray<'a>) -> + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + values.Length + values + keys) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + let sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = + + let kernel = + <@ fun (ndRange: Range1D) lenght uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + let gid = ndRange.GlobalID0 + + if gid < uniqueKeysCount then + let sourcePosition = offsets.[gid] + let sourceKey = keys.[sourcePosition] + + let mutable currentSum = values.[sourcePosition] + let mutable previousSum = zero + + values.[gid] <- (%opWrite) previousSum currentSum + + let mutable currentPosition = sourcePosition + 1 + + while currentPosition < lenght + && keys.[currentPosition] = sourceKey do + + previousSum <- currentSum + currentSum <- (%opAdd) currentSum values.[currentPosition] + + values.[gid] <- (%opWrite) previousSum currentSum + + currentPosition <- currentPosition + 1 @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + values.Length + uniqueKeysCount + values + keys + offsets) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs index 3aa5c894..69cde02b 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs @@ -31,10 +31,76 @@ module SubSum = barrierLocal () @> - let sequentialSum<'a> opAdd = - sumGeneral<'a> <| sequentialAccess<'a> opAdd + let sequentialSum<'a> = sumGeneral<'a> << sequentialAccess<'a> - let treeSum<'a> opAdd = sumGeneral<'a> <| treeAccess<'a> opAdd + let upSweep<'a> = sumGeneral<'a> << treeAccess<'a> + + let downSweep opAdd = + <@ fun wgSize lid (localBuffer: 'a []) -> + let mutable step = wgSize + + while step > 1 do + barrierLocal () + + if lid < wgSize / step then + let i = step * (lid + 1) - 1 + let j = i - (step >>> 1) + + let tmp = localBuffer.[i] + let buff = (%opAdd) tmp localBuffer.[j] + localBuffer.[i] <- buff + localBuffer.[j] <- tmp + + step <- step >>> 1 @> + + let upSweepByKey opAdd = + <@ fun wgSize lid (localBuffer: 'a []) (localKeys: 'b [])-> + let mutable step = 2 + + while step <= wgSize do + let i = step * (lid + 1) - 1 + + let firstIndex = i - (step >>> 1) // TODO() + let secondIndex = i + + let firstKey = localKeys.[firstIndex] + let secondKey = localKeys.[secondIndex] + + if lid < wgSize / step + && firstKey = secondKey then + + let firstValue = localBuffer.[firstIndex] + let secondValue = localBuffer.[secondIndex] + + localBuffer.[secondIndex] <- (%opAdd) firstValue secondValue + + step <- step <<< 1 + + barrierLocal () @> + + let downSweepByKey opAdd = + <@ fun wgSize lid (localBuffer: 'a []) (localKeys: int []) -> + let mutable step = wgSize + + while step > 1 do + barrierLocal () + + let rightIndex = step * (lid + 1) - 1 + let leftIndex = rightIndex - (step >>> 1) + + let rightKey = localKeys.[rightIndex] + let leftKey = localKeys.[leftIndex] + + if lid < wgSize / step + && rightKey = leftKey then + + let tmp = localBuffer.[rightIndex] + let buff = (%opAdd) tmp localBuffer.[leftIndex] + + localBuffer.[rightIndex] <- buff + localBuffer.[leftIndex] <- tmp + + step <- step >>> 1 @> let localPrefixSum opAdd = <@ fun (lid: int) (workGroupSize: int) (array: 'a []) -> @@ -52,4 +118,6 @@ module SubSum = barrierLocal () array.[lid] <- value @> + + let localIntPrefixSum = localPrefixSum <@ (+) @> From bc7ebdf4ae436f0f5eafa0a34957c64bad899571 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 2 Apr 2023 17:03:45 +0300 Subject: [PATCH 036/143] add: segment sequential scan --- .../Common/PrefixSum.fs | 22 ++- src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 4 + src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs | 11 +- .../Common/Scan/ByKey.fs | 174 ++++++++++++++++++ .../Common/{ClArray => Scan}/PrefixSum.fs | 4 +- .../GraphBLAS-sharp.Tests.fsproj | 3 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 12 +- tests/GraphBLAS-sharp.Tests/Program.fs | 170 ++++++++--------- 8 files changed, 296 insertions(+), 104 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs rename tests/GraphBLAS-sharp.Tests/Common/{ClArray => Scan}/PrefixSum.fs (95%) diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index 2ca44f81..70cbdc23 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -5,7 +5,6 @@ open FSharp.Quotations open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects.ClCell -open GraphBLAS.FSharp.Backend.Objects.ClContext module PrefixSum = let private update (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = @@ -326,7 +325,11 @@ module PrefixSum = processor.Post(Msg.CreateRunMsg<_, _> kernel) - let sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = + let oneWorkGroupExclude zero = oneWorkGroup <@ (fun _ _ _ -> ()) @> zero + + let onwWorkGroupInclude zero = oneWorkGroup <@ (fun localValues lid zero -> localValues.[lid] <- zero) @> zero + + let private sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = let kernel = <@ fun (ndRange: Range1D) lenght uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> @@ -336,12 +339,10 @@ module PrefixSum = let sourcePosition = offsets.[gid] let sourceKey = keys.[sourcePosition] - let mutable currentSum = values.[sourcePosition] + let mutable currentSum = zero let mutable previousSum = zero - values.[gid] <- (%opWrite) previousSum currentSum - - let mutable currentPosition = sourcePosition + 1 + let mutable currentPosition = sourcePosition while currentPosition < lenght && keys.[currentPosition] = sourceKey do @@ -349,7 +350,7 @@ module PrefixSum = previousSum <- currentSum currentSum <- (%opAdd) currentSum values.[currentPosition] - values.[gid] <- (%opWrite) previousSum currentSum + values.[currentPosition] <- (%opWrite) previousSum currentSum currentPosition <- currentPosition + 1 @> @@ -375,3 +376,10 @@ module PrefixSum = ) processor.Post(Msg.CreateRunMsg<_, _> kernel) + + + let sequentialExclude clContext = sequentialSegments (Map.fst ()) clContext + + let sequentialInclude clContext = sequentialSegments (Map.snd ()) clContext + + diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 2ec988d5..58ad1026 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -21,3 +21,7 @@ module Map = match (%map) item with | Some _ -> 1 | None -> 0 @> + + let fst () = <@ fun fst _ -> fst @> + + let snd () = <@ fun _ snd -> snd @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs index 69cde02b..19b9e6ac 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs @@ -47,7 +47,10 @@ module SubSum = let j = i - (step >>> 1) let tmp = localBuffer.[i] - let buff = (%opAdd) tmp localBuffer.[j] + + let operand = localBuffer.[j] // brahma error + let buff = (%opAdd) tmp operand + localBuffer.[i] <- buff localBuffer.[j] <- tmp @@ -60,7 +63,7 @@ module SubSum = while step <= wgSize do let i = step * (lid + 1) - 1 - let firstIndex = i - (step >>> 1) // TODO() + let firstIndex = i - (step >>> 1) // TODO(work ?) let secondIndex = i let firstKey = localKeys.[firstIndex] @@ -95,7 +98,9 @@ module SubSum = && rightKey = leftKey then let tmp = localBuffer.[rightIndex] - let buff = (%opAdd) tmp localBuffer.[leftIndex] + + let rightOperand = localBuffer.[leftIndex] // Brahma error + let buff = (%opAdd) tmp rightOperand localBuffer.[rightIndex] <- buff localBuffer.[leftIndex] <- tmp diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs new file mode 100644 index 00000000..256ec268 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs @@ -0,0 +1,174 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.Scan.ByKey + +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ClContext +open Expecto +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let scanByKey scan keysAndValues = + // select keys + Array.map fst keysAndValues + // get unique keys + |> Array.distinct + |> Array.map (fun key -> + // select with certain key + Array.filter (fst >> ((=) key)) keysAndValues + // get values + |> Array.map snd + // scan values and get only values without sum + |> (fst << scan)) + |> Array.concat + +let checkResult isEqual keysAndValues actual hostScan = + + let expected = scanByKey hostScan keysAndValues + + let keys, values = Array.unzip keysAndValues + printfn "---------------" + + printfn "keys: %A" keys + printfn "values: %A" values + printfn $"expected: %A{expected}" + + printfn "-----------" + + "Results must be the same" + |> Utils.compareArrays isEqual actual expected + +let makeTestSequentialSegments isEqual scanHost scanDevice (keysAndValues: (int * 'a) []) = + if keysAndValues.Length > 0 then + let keys, values = + Array.sortBy fst keysAndValues + |> Array.unzip + + let offsets = + HostPrimitives.getUniqueBitmapFirstOccurrence keys + |> HostPrimitives.getBitPositions + + let uniqueKeysCount = Array.distinct keys |> Array.length + + let clKeys = context.CreateClArrayWithSpecificAllocationMode(HostInterop, keys) + + let clValues = context.CreateClArrayWithSpecificAllocationMode(HostInterop, values) + + let clOffsets = context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + scanDevice processor uniqueKeysCount clValues clKeys clOffsets + + let actual = clValues.ToHostAndFree processor + clKeys.Free processor + clOffsets.Free processor + + let keysAndValues = Array.zip keys values + + checkResult isEqual keysAndValues actual scanHost + +let createTest (zero: 'a) opAddQ opAdd isEqual deviceScan hostScan = + + let hostScan = hostScan zero opAdd + + let deviceScan = + deviceScan context Utils.defaultWorkGroupSize opAddQ zero + + makeTestSequentialSegments isEqual hostScan deviceScan + |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" + +let sequentialSegmentsTests = + let excludeTests = + [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + + if Utils.isFloat64Available context.ClDevice then + createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + + createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + + createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude ] + |> testList "exclude" + + let includeTests = + [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + + if Utils.isFloat64Available context.ClDevice then + createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + + createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + + createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude ] + + |> testList "include" + + testList "Sequential segments" [ excludeTests; includeTests ] + +let makeTestOneWorkGroup isEqual scanHost scanDevice (keysAndValues: (int * 'a) []) = + if keysAndValues.Length > 0 then + let keys, values = + Array.sortBy fst keysAndValues + |> Array.unzip + + let uniqueKeysCount = Array.distinct keys |> Array.length + + let clKeys = context.CreateClArrayWithSpecificAllocationMode(HostInterop, keys) + + let clValues = context.CreateClArrayWithSpecificAllocationMode(HostInterop, values) + + scanDevice processor uniqueKeysCount clValues clKeys + + let actual = clValues.ToHostAndFree processor + clKeys.Free processor + + let keysAndValues = Array.zip keys values + + checkResult isEqual keysAndValues actual scanHost + +let oneWorkGroupCreateTest (zero: 'a) opAddQ opAdd isEqual deviceScan hostScan = + + let workGroupSize = 256 + + let hostScan = hostScan zero opAdd + + let deviceScan = + deviceScan context workGroupSize opAddQ zero + + makeTestSequentialSegments isEqual hostScan deviceScan + |> testPropertyWithConfig { Utils.defaultConfig with endSize = workGroupSize } $"test on {typeof<'a>}" + +let oneWorkGroupTests = + let excludeTests = + [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + + if Utils.isFloat64Available context.ClDevice then + createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + + createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + + createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude ] + |> testList "exclude" + + let includeTests = + [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + + if Utils.isFloat64Available context.ClDevice then + createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + + createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + + createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude ] + + |> testList "include" + + testList "Sequential segments" [ excludeTests; includeTests ] + + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs similarity index 95% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs rename to tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs index 3c8bedee..c8ce588a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.PrefixSum +module GraphBLAS.FSharp.Tests.Backend.Common.Scan.PrefixSum open Expecto open Expecto.Logging @@ -62,7 +62,7 @@ let makeTest plus zero isEqual scan (array: 'a []) = let testFixtures plus plusQ zero isEqual name = PrefixSum.runIncludeInplace plusQ context wgSize |> makeTest plus zero isEqual - |> testPropertyWithConfig config (sprintf "Correctness on %s" name) + |> testPropertyWithConfig config $"Correctness on %s{name}" let tests = q.Error.Add(fun e -> failwithf "%A" e) diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index b67154c2..fbfa6f3a 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -24,12 +24,13 @@ - + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index d29dfe3e..30300542 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -141,13 +141,13 @@ module Utils = result module HostPrimitives = - let prefixSumInclude array = - Array.scan (+) 0 array - |> fun scanned -> scanned.[1..] + let prefixSumInclude zero add array = + Array.scan add zero array + |> fun scanned -> scanned.[1..], Array.last scanned - let prefixSumExclude sourceArray = - prefixSumInclude sourceArray - |> Array.insertAt 0 0 + let prefixSumExclude zero add sourceArray = + prefixSumInclude zero add sourceArray + |> (fst >> Array.insertAt 0 zero) |> fun array -> Array.take sourceArray.Length array, Array.last array let getUniqueBitmapLastOccurrence array = diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index b46c375c..a7422c60 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,90 +1,90 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Map.notTests - Matrix.Map.addTests - Matrix.Map.mulTests - Matrix.Mxm.tests - Matrix.Transpose.tests ] - |> testSequenced - -let commonTests = - let reduceTests = - testList - "Reduce" - [ Common.Reduce.ByKey.sequentialTest - Common.Reduce.ByKey.sequentialSegmentTests - Common.Reduce.ByKey.oneWorkGroupTest - Common.Reduce.Reduce.tests - Common.Reduce.Sum.tests ] - - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.PrefixSum.tests - Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests ] - - let sortTests = - testList - "Sort" - [ Common.Sort.Bitonic.tests - Common.Sort.Radix.testsByKeys - Common.Sort.Radix.testKeysOnly ] - - testList - "Common tests" - [ clArrayTests - sortTests - reduceTests - Common.Scatter.tests ] - |> testSequenced - -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced - -[] -let allTests = - testList - "All tests" - [ matrixTests - commonTests - vectorTests - algorithmsTests ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Map.notTests +// Matrix.Map.addTests +// Matrix.Map.mulTests +// Matrix.Mxm.tests +// Matrix.Transpose.tests ] +// |> testSequenced +// +// let commonTests = +// let reduceTests = +// testList +// "Reduce" +// [ Common.Reduce.ByKey.sequentialTest +// Common.Reduce.ByKey.sequentialSegmentTests +// Common.Reduce.ByKey.oneWorkGroupTest +// Common.Reduce.Reduce.tests +// Common.Reduce.Sum.tests ] +// +// let clArrayTests = +// testList +// "ClArray" +// [ Common.Scan.PrefixSum.tests +// Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.tests ] +// +// let sortTests = +// testList +// "Sort" +// [ Common.Sort.Bitonic.tests +// Common.Sort.Radix.testsByKeys +// Common.Sort.Radix.testKeysOnly ] +// +// testList +// "Common tests" +// [ clArrayTests +// sortTests +// reduceTests +// Common.Scatter.tests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced +// +// [] +// let allTests = +// testList +// "All tests" +// [ matrixTests +// commonTests +// vectorTests +// algorithmsTests ] +// |> testSequenced [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = testList "" [ Common.Scan.ByKey.sequentialSegmentsTests ] |> runTestsWithCLIArgs [] argv From 3bb2e9ae4f4cb034818ed61d675bbb617d6af670 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 2 Apr 2023 17:47:48 +0300 Subject: [PATCH 037/143] refactor: formatting --- .../Common/PrefixSum.fs | 120 ++++-------- src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs | 8 +- .../Common/Scan/ByKey.fs | 141 ++++---------- .../GraphBLAS-sharp.Tests.fsproj | 4 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 15 ++ tests/GraphBLAS-sharp.Tests/Program.fs | 176 +++++++++--------- 6 files changed, 183 insertions(+), 281 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index 70cbdc23..3e030589 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -136,7 +136,8 @@ module PrefixSum = scanGeneral <@ fun (resultBuffer: ClArray<'a>) (value: 'a) (inputArrayLength: int) (gid: int) (i: int) -> - if gid < inputArrayLength then resultBuffer.[i] <- value @> + if gid < inputArrayLength then + resultBuffer.[i] <- value @> <@ fun (resultBuffer: ClArray<'a>) (resultLocalBuffer: 'a []) (inputArrayLength: int) (workGroupSize: int) (gid: int) (i: int) (localID: int) -> if gid < inputArrayLength @@ -214,7 +215,7 @@ module PrefixSum = /// /// let arr = [| 1; 1; 1; 1 |] /// let sum = [| 0 |] - /// runExcludeInplace clContext workGroupSize processor arr sum <@ (+) @> 0 + /// runExcludeInplace clContext workGroupSize processor arr sum (+) 0 /// |> ignore /// ... /// > val arr = [| 0; 1; 2; 3 |] @@ -240,7 +241,7 @@ module PrefixSum = /// /// let arr = [| 1; 1; 1; 1 |] /// let sum = [| 0 |] - /// runExcludeInplace clContext workGroupSize processor arr sum <@ (+) @> 0 + /// runExcludeInplace clContext workGroupSize processor arr sum (+) 0 /// |> ignore /// ... /// > val arr = [| 1; 2; 3; 4 |] @@ -259,76 +260,7 @@ module PrefixSum = scan processor inputArray 0 - module ByKey = - let private oneWorkGroup - writeZero - zero - uniqueKey - (opAdd: Expr<'a -> 'a -> 'a>) - (clContext: ClContext) - workGroupSize - = - - let scan = - <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (keys: ClArray) -> - - let localValues = localArray<'a> workGroupSize - let localKeys = localArray workGroupSize - - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 - - if gid < length then - // only one workgroup - localValues.[lid] <- values.[lid] - localKeys.[lid] <- keys.[gid] - else - localValues.[lid] <- zero - localKeys.[lid] <- uniqueKey - - barrierLocal () - - // Local tree reduce - (%SubSum.upSweepByKey opAdd) workGroupSize lid localValues localKeys - - // if root item - if lid = workGroupSize - 1 - || localValues.[lid] <> localValues.[lid + 1] then - - (%writeZero) localValues lid zero - - (%SubSum.downSweepByKey opAdd) workGroupSize lid localValues localKeys - - barrierLocal () - - values.[lid] <- localValues.[lid] @> - - let program = clContext.Compile(scan) - - fun (processor: MailboxProcessor<_>) (keys: ClArray) (values: ClArray<'a>) -> - - let kernel = program.GetKernel() - - let ndRange = - Range1D.CreateValid(values.Length, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - values.Length - values - keys) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - let oneWorkGroupExclude zero = oneWorkGroup <@ (fun _ _ _ -> ()) @> zero - - let onwWorkGroupInclude zero = oneWorkGroup <@ (fun localValues lid zero -> localValues.[lid] <- zero) @> zero - let private sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = let kernel = @@ -345,7 +277,7 @@ module PrefixSum = let mutable currentPosition = sourcePosition while currentPosition < lenght - && keys.[currentPosition] = sourceKey do + && keys.[currentPosition] = sourceKey do previousSum <- currentSum currentSum <- (%opAdd) currentSum values.[currentPosition] @@ -365,21 +297,35 @@ module PrefixSum = processor.Post( Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - values.Length - uniqueKeysCount - values - keys - offsets) + (fun () -> kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets) ) processor.Post(Msg.CreateRunMsg<_, _> kernel) - - let sequentialExclude clContext = sequentialSegments (Map.fst ()) clContext - - let sequentialInclude clContext = sequentialSegments (Map.snd ()) clContext - - + /// + /// Exclude scan by key. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1; 1; 1|] + /// let keys = [| 1; 2; 2; 2; 3; 3 |] + /// ... + /// > val result = [| 0; 0; 1; 2; 0; 1 |] + /// + /// + let sequentialExclude clContext = + sequentialSegments (Map.fst ()) clContext + + /// + /// Include scan by key. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1; 1; 1|] + /// let keys = [| 1; 2; 2; 2; 3; 3 |] + /// ... + /// > val result = [| 1; 1; 2; 3; 1; 2 |] + /// + /// + let sequentialInclude clContext = + sequentialSegments (Map.snd ()) clContext diff --git a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs index 19b9e6ac..51e8ede1 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs @@ -57,7 +57,7 @@ module SubSum = step <- step >>> 1 @> let upSweepByKey opAdd = - <@ fun wgSize lid (localBuffer: 'a []) (localKeys: 'b [])-> + <@ fun wgSize lid (localBuffer: 'a []) (localKeys: 'b []) -> let mutable step = 2 while step <= wgSize do @@ -69,8 +69,7 @@ module SubSum = let firstKey = localKeys.[firstIndex] let secondKey = localKeys.[secondIndex] - if lid < wgSize / step - && firstKey = secondKey then + if lid < wgSize / step && firstKey = secondKey then let firstValue = localBuffer.[firstIndex] let secondValue = localBuffer.[secondIndex] @@ -94,8 +93,7 @@ module SubSum = let rightKey = localKeys.[rightIndex] let leftKey = localKeys.[leftIndex] - if lid < wgSize / step - && rightKey = leftKey then + if lid < wgSize / step && rightKey = leftKey then let tmp = localBuffer.[rightIndex] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs index 256ec268..1cb81709 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs @@ -10,32 +10,10 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let scanByKey scan keysAndValues = - // select keys - Array.map fst keysAndValues - // get unique keys - |> Array.distinct - |> Array.map (fun key -> - // select with certain key - Array.filter (fst >> ((=) key)) keysAndValues - // get values - |> Array.map snd - // scan values and get only values without sum - |> (fst << scan)) - |> Array.concat - let checkResult isEqual keysAndValues actual hostScan = - let expected = scanByKey hostScan keysAndValues - - let keys, values = Array.unzip keysAndValues - printfn "---------------" - - printfn "keys: %A" keys - printfn "values: %A" values - printfn $"expected: %A{expected}" - - printfn "-----------" + let expected = + HostPrimitives.scanByKey hostScan keysAndValues "Results must be the same" |> Utils.compareArrays isEqual actual expected @@ -43,8 +21,7 @@ let checkResult isEqual keysAndValues actual hostScan = let makeTestSequentialSegments isEqual scanHost scanDevice (keysAndValues: (int * 'a) []) = if keysAndValues.Length > 0 then let keys, values = - Array.sortBy fst keysAndValues - |> Array.unzip + Array.sortBy fst keysAndValues |> Array.unzip let offsets = HostPrimitives.getUniqueBitmapFirstOccurrence keys @@ -52,11 +29,14 @@ let makeTestSequentialSegments isEqual scanHost scanDevice (keysAndValues: (int let uniqueKeysCount = Array.distinct keys |> Array.length - let clKeys = context.CreateClArrayWithSpecificAllocationMode(HostInterop, keys) + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, keys) - let clValues = context.CreateClArrayWithSpecificAllocationMode(HostInterop, values) + let clValues = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, values) - let clOffsets = context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) scanDevice processor uniqueKeysCount clValues clKeys clOffsets @@ -83,70 +63,21 @@ let sequentialSegmentsTests = [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude if Utils.isFloat64Available context.ClDevice then - createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude - - createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude - - createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude - createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude ] - |> testList "exclude" - - let includeTests = - [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude - - if Utils.isFloat64Available context.ClDevice then - createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude - - createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude - - createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude - createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude ] - - |> testList "include" - - testList "Sequential segments" [ excludeTests; includeTests ] - -let makeTestOneWorkGroup isEqual scanHost scanDevice (keysAndValues: (int * 'a) []) = - if keysAndValues.Length > 0 then - let keys, values = - Array.sortBy fst keysAndValues - |> Array.unzip - - let uniqueKeysCount = Array.distinct keys |> Array.length - - let clKeys = context.CreateClArrayWithSpecificAllocationMode(HostInterop, keys) - - let clValues = context.CreateClArrayWithSpecificAllocationMode(HostInterop, values) - - scanDevice processor uniqueKeysCount clValues clKeys - - let actual = clValues.ToHostAndFree processor - clKeys.Free processor - - let keysAndValues = Array.zip keys values - - checkResult isEqual keysAndValues actual scanHost - -let oneWorkGroupCreateTest (zero: 'a) opAddQ opAdd isEqual deviceScan hostScan = - - let workGroupSize = 256 - - let hostScan = hostScan zero opAdd - - let deviceScan = - deviceScan context workGroupSize opAddQ zero - - makeTestSequentialSegments isEqual hostScan deviceScan - |> testPropertyWithConfig { Utils.defaultConfig with endSize = workGroupSize } $"test on {typeof<'a>}" - -let oneWorkGroupTests = - let excludeTests = - [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude - - if Utils.isFloat64Available context.ClDevice then - createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude - - createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude + createTest + 0.0 + <@ (+) @> + (+) + Utils.floatIsEqual + PrefixSum.ByKey.sequentialExclude + HostPrimitives.prefixSumExclude + + createTest + 0.0f + <@ (+) @> + (+) + Utils.float32IsEqual + PrefixSum.ByKey.sequentialExclude + HostPrimitives.prefixSumExclude createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialExclude HostPrimitives.prefixSumExclude ] @@ -156,9 +87,21 @@ let oneWorkGroupTests = [ createTest 0 <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude if Utils.isFloat64Available context.ClDevice then - createTest 0.0 <@ (+) @> (+) Utils.floatIsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude - - createTest 0.0f <@ (+) @> (+) Utils.float32IsEqual PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude + createTest + 0.0 + <@ (+) @> + (+) + Utils.floatIsEqual + PrefixSum.ByKey.sequentialInclude + HostPrimitives.prefixSumInclude + + createTest + 0.0f + <@ (+) @> + (+) + Utils.float32IsEqual + PrefixSum.ByKey.sequentialInclude + HostPrimitives.prefixSumInclude createTest false <@ (||) @> (||) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude createTest 0u <@ (+) @> (+) (=) PrefixSum.ByKey.sequentialInclude HostPrimitives.prefixSumInclude ] @@ -166,9 +109,3 @@ let oneWorkGroupTests = |> testList "include" testList "Sequential segments" [ excludeTests; includeTests ] - - - - - - diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index fbfa6f3a..234c76a1 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -29,8 +29,8 @@ - - + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 30300542..6c0f779a 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -190,6 +190,21 @@ module HostPrimitives = |> Array.map (fun (key, values) -> key, Array.reduce reduceOp values) |> Array.unzip + let scanByKey scan keysAndValues = + // select keys + Array.map fst keysAndValues + // get unique keys + |> Array.distinct + |> Array.map + (fun key -> + // select with certain key + Array.filter (fst >> ((=) key)) keysAndValues + // get values + |> Array.map snd + // scan values and get only values without sum + |> (fst << scan)) + |> Array.concat + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index a7422c60..8532df05 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,90 +1,96 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Map.notTests -// Matrix.Map.addTests -// Matrix.Map.mulTests -// Matrix.Mxm.tests -// Matrix.Transpose.tests ] -// |> testSequenced -// -// let commonTests = -// let reduceTests = -// testList -// "Reduce" -// [ Common.Reduce.ByKey.sequentialTest -// Common.Reduce.ByKey.sequentialSegmentTests -// Common.Reduce.ByKey.oneWorkGroupTest -// Common.Reduce.Reduce.tests -// Common.Reduce.Sum.tests ] -// -// let clArrayTests = -// testList -// "ClArray" -// [ Common.Scan.PrefixSum.tests -// Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.tests ] -// -// let sortTests = -// testList -// "Sort" -// [ Common.Sort.Bitonic.tests -// Common.Sort.Radix.testsByKeys -// Common.Sort.Radix.testKeysOnly ] -// -// testList -// "Common tests" -// [ clArrayTests -// sortTests -// reduceTests -// Common.Scatter.tests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced -// -// [] -// let allTests = -// testList -// "All tests" -// [ matrixTests -// commonTests -// vectorTests -// algorithmsTests ] -// |> testSequenced +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Map.notTests + Matrix.Map.addTests + Matrix.Map.mulTests + Matrix.Mxm.tests + Matrix.Transpose.tests ] + |> testSequenced + +let commonTests = + let scanTests = + testList + "Scan" + [ Common.Scan.ByKey.sequentialSegmentsTests + Common.Scan.PrefixSum.tests ] + + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.sequentialTest + Common.Reduce.ByKey.sequentialSegmentTests + Common.Reduce.ByKey.oneWorkGroupTest + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] + + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.tests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.testsByKeys + Common.Sort.Radix.testKeysOnly ] + + testList + "Common tests" + [ clArrayTests + sortTests + reduceTests + scanTests + Common.Scatter.tests ] + |> testSequenced + +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced + +[] +let allTests = + testList + "All tests" + [ matrixTests + commonTests + vectorTests + algorithmsTests ] + |> testSequenced [] -let main argv = testList "" [ Common.Scan.ByKey.sequentialSegmentsTests ] |> runTestsWithCLIArgs [] argv +let main argv = allTests |> runTestsWithCLIArgs [] argv From ab870bd04317be31146af03330d078c0484d4dff Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 2 Apr 2023 17:51:13 +0300 Subject: [PATCH 038/143] refactor --- src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs | 49 -------------------- 1 file changed, 49 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs index 51e8ede1..b16d4ebc 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs @@ -56,55 +56,6 @@ module SubSum = step <- step >>> 1 @> - let upSweepByKey opAdd = - <@ fun wgSize lid (localBuffer: 'a []) (localKeys: 'b []) -> - let mutable step = 2 - - while step <= wgSize do - let i = step * (lid + 1) - 1 - - let firstIndex = i - (step >>> 1) // TODO(work ?) - let secondIndex = i - - let firstKey = localKeys.[firstIndex] - let secondKey = localKeys.[secondIndex] - - if lid < wgSize / step && firstKey = secondKey then - - let firstValue = localBuffer.[firstIndex] - let secondValue = localBuffer.[secondIndex] - - localBuffer.[secondIndex] <- (%opAdd) firstValue secondValue - - step <- step <<< 1 - - barrierLocal () @> - - let downSweepByKey opAdd = - <@ fun wgSize lid (localBuffer: 'a []) (localKeys: int []) -> - let mutable step = wgSize - - while step > 1 do - barrierLocal () - - let rightIndex = step * (lid + 1) - 1 - let leftIndex = rightIndex - (step >>> 1) - - let rightKey = localKeys.[rightIndex] - let leftKey = localKeys.[leftIndex] - - if lid < wgSize / step && rightKey = leftKey then - - let tmp = localBuffer.[rightIndex] - - let rightOperand = localBuffer.[leftIndex] // Brahma error - let buff = (%opAdd) tmp rightOperand - - localBuffer.[rightIndex] <- buff - localBuffer.[leftIndex] <- tmp - - step <- step >>> 1 @> - let localPrefixSum opAdd = <@ fun (lid: int) (workGroupSize: int) (array: 'a []) -> let mutable offset = 1 From 91a72e21889fceaaf81345874df497479a8a17df Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 3 Apr 2023 20:15:25 +0300 Subject: [PATCH 039/143] add: Gather tests --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 10 - src/GraphBLAS-sharp.Backend/Common/Gather.fs | 18 +- .../Common/PrefixSum.fs | 72 +++++ src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 2 + .../Matrix/CSRMatrix/Matrix.fs | 42 +-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 241 ++++++++++++++--- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 37 +++ src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 4 + tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 63 +++++ .../Common/Reduce/ReduceByKey.fs | 7 +- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 24 +- .../GraphBLAS-sharp.Tests.fsproj | 4 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 79 ++---- .../Matrix/SpGEMM/Example.fs | 185 ------------- .../Matrix/SpGEMM/Expand.fs | 252 ------------------ tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 89 +++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 6 +- 17 files changed, 529 insertions(+), 606 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Gather.fs delete mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs delete mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index fe562625..e8fba339 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -349,13 +349,3 @@ module ClArray = result - let iterate (clContext: ClContext) workGroupSize iterator = - - let create = create clContext workGroupSize iterator - - let scatter = Scatter.runInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> - - let positions = create processor allocationMode - diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 65d5968d..3f980651 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -17,28 +17,28 @@ module internal Gather = let run (clContext: ClContext) workGroupSize = let gather = - <@ fun (ndRange: Range1D) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> + <@ fun (ndRange: Range1D) positionsLength valuesLength (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> let i = ndRange.GlobalID0 - if i < size then + if i < positionsLength then let position = positions.[i] - let value = values.[position] - outputArray.[i] <- value @> + if position >= 0 && position < valuesLength then + outputArray.[i] <- values.[position] @> - let program = clContext.Compile(gather) + let program = clContext.Compile gather - fun (processor: MailboxProcessor<_>) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> - let size = outputArray.Length + if positions.Length <> outputArray.Length then failwith "Lengths must be the same" let kernel = program.GetKernel() - let ndRange = Range1D.CreateValid(size, workGroupSize) + let ndRange = Range1D.CreateValid(positions.Length, workGroupSize) processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions inputArray outputArray size) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index b25cd85e..591b9a28 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -270,3 +270,75 @@ module PrefixSum = fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> scan processor inputArray 0 + + + module ByKey = + let private sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = + + let kernel = + <@ fun (ndRange: Range1D) lenght uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + let gid = ndRange.GlobalID0 + + if gid < uniqueKeysCount then + let sourcePosition = offsets.[gid] + let sourceKey = keys.[sourcePosition] + + let mutable currentSum = zero + let mutable previousSum = zero + + let mutable currentPosition = sourcePosition + + while currentPosition < lenght + && keys.[currentPosition] = sourceKey do + + previousSum <- currentSum + currentSum <- (%opAdd) currentSum values.[currentPosition] + + values.[currentPosition] <- (%opWrite) previousSum currentSum + + currentPosition <- currentPosition + 1 @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + /// + /// Exclude scan by key. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1; 1; 1|] + /// let keys = [| 1; 2; 2; 2; 3; 3 |] + /// ... + /// > val result = [| 0; 0; 1; 2; 0; 1 |] + /// + /// + let sequentialExclude clContext = + sequentialSegments (Map.fst ()) clContext + + /// + /// Include scan by key. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1; 1; 1|] + /// let keys = [| 1; 2; 2; 2; 3; 3 |] + /// ... + /// > val result = [| 1; 1; 2; 3; 1; 2 |] + /// + /// + let sequentialInclude clContext = + sequentialSegments (Map.snd ()) clContext + diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 840f024f..e8c8b737 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -43,6 +43,8 @@ module internal Scatter = fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> + if positions.Length <> values.Length then failwith "Lengths must be the same" + let positionsLength = positions.Length let ndRange = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index f23db2f4..4f3f0f09 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -12,47 +12,9 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects.ClCell module Matrix = - let private expandRowPointers (clContext: ClContext) workGroupSize = - - let expandRowPointers = - <@ fun (ndRange: Range1D) (rowPointers: ClArray) (rowCount: int) (rows: ClArray) -> - - let i = ndRange.GlobalID0 - - if i < rowCount then - let rowPointer = rowPointers.[i] - - if rowPointer <> rowPointers.[i + 1] then - rows.[rowPointer] <- i @> - - let program = clContext.Compile(expandRowPointers) - - let create = - ClArray.zeroCreate clContext workGroupSize - - let scan = - PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> - - let rows = create processor allocationMode nnz - - let kernel = program.GetKernel() - - let ndRange = - Range1D.CreateValid(rowCount, workGroupSize) - - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowPointers rowCount rows)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - let total = scan processor rows 0 - processor.Post(Msg.CreateFreeMsg(total)) - - rows - let toCOO (clContext: ClContext) workGroupSize = let prepare = - expandRowPointers clContext workGroupSize + Common.expandRowPointers clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -77,7 +39,7 @@ module Matrix = let toCOOInplace (clContext: ClContext) workGroupSize = let prepare = - expandRowPointers clContext workGroupSize + Common.expandRowPointers clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index da373352..035f2758 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -1,7 +1,9 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Common.Sort +open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions @@ -13,35 +15,82 @@ type Indices = ClArray type Values<'a> = ClArray<'a> module Expand = - - let getRowsLengths (clContext: ClContext) workGroupSize = + let getSegmentPointers (clContext: ClContext) workGroupSize = let create = + ClArray.init clContext workGroupSize Map.id + + let createShifted = ClArray.init clContext workGroupSize Map.inc - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + let subtract = ClArray.map2 clContext workGroupSize Map.subtraction - let scatter = Scatter.runInplace clContext workGroupSize + let gather = Gather.run clContext workGroupSize - let subtraction = ClArray.map2 clContext workGroupSize Map.subtraction + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: Indices) -> + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let positions = create processor DeviceOnly rowPointers.Length + let positionsLength = rightMatrix.RowPointers.Length - 1 - let shiftedPointers = zeroCreate processor DeviceOnly rowPointers.Length + // extract first rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers + // (right matrix row pointers without last item) + let positions = // TODO(fuse) + create processor DeviceOnly positionsLength - scatter processor positions rowPointers shiftedPointers + let firstPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - let result = - subtraction processor allocationMode shiftedPointers rowPointers + gather processor positions rightMatrix.RowPointers firstPointers positions.Free processor - rowPointers.Free processor - result + printfn $"first pointers gpu: %A{firstPointers.ToHost processor}" + + // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers + // (right matrix row pointers without first item) + let shiftedPositions = // TODO(fuse) + createShifted processor DeviceOnly positionsLength + + printfn "shifted positions gpu: %A" <| shiftedPositions.ToHost processor + + let lastPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) + + gather processor shiftedPositions rightMatrix.RowPointers lastPointers + + printfn $"last pointers gpu: %A{lastPointers.ToHost processor}" + + shiftedPositions.Free processor + + // subtract + let rightMatrixRowsLengths = + subtract processor DeviceOnly lastPointers firstPointers + + printfn $"subtract result gpu: %A{rightMatrixRowsLengths.ToHost processor}" + + firstPointers.Free processor + lastPointers.Free processor + + let segmentsLengths = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.Columns.Length) + + // extract needed lengths by left matrix nnz + gather processor leftMatrix.Columns rightMatrixRowsLengths segmentsLengths + + printfn $"subtract after gather result gpu: %A{segmentsLengths.ToHost processor}" + + rightMatrixRowsLengths.Free processor + + // compute pointers + let length = (prefixSum processor segmentsLengths).ToHostAndFree processor + + printfn $"subtract after prefix sum gpu: %A{segmentsLengths.ToHost processor}" + + length, segmentsLengths + + let expand (clContext: ClContext) workGroupSize opMul = - let expand (clContext: ClContext) workGroupSize = let init = ClArray.init clContext workGroupSize Map.id let scatter = Scatter.runInplace clContext workGroupSize @@ -50,49 +99,179 @@ module Expand = let maxPrefixSum = PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize - let initWithUnits = ClArray.init clContext workGroupSize <@ fun _ -> 1 @> + let create = ClArray.create clContext workGroupSize + + let gather = Gather.run clContext workGroupSize + + let segmentPrefixSum = PrefixSum.ByKey.sequentialInclude clContext workGroupSize <@ (+) @> 0 + + let removeDuplicates = ClArray.removeDuplications clContext workGroupSize + + let expandRowPointers = Common.expandRowPointers clContext workGroupSize - fun (processor: MailboxProcessor<_>) lengths (segmentLengths: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let AGather = Gather.run clContext workGroupSize + + let BGather = Gather.run clContext workGroupSize + + let mul = ClArray.map2 clContext workGroupSize opMul + + fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute A positions - let sequence = init processor DeviceOnly segmentLengths.Length + let sequence = init processor DeviceOnly segmentsPointers.Length // TODO(fuse) let APositions = zeroCreate processor DeviceOnly lengths - scatter processor segmentLengths sequence APositions + scatter processor segmentsPointers sequence APositions sequence.Free processor - maxPrefixSum processor APositions 0 + (maxPrefixSum processor APositions 0).Free processor // Compute B positions + let BPositions = create processor DeviceOnly lengths 1 // TODO(fuse) + let requiredBPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length + gather processor leftMatrix.Columns rightMatrix.RowPointers requiredBPointers + scatter processor segmentsPointers requiredBPointers BPositions + requiredBPointers.Free processor - let run (clContext: ClContext) workGroupSize = + // another way to get offsets ??? + let offsets = removeDuplicates processor segmentsPointers - let getRowsLengths = getRowsLengths clContext workGroupSize + segmentPrefixSum processor offsets.Length BPositions APositions offsets // TODO(offsets lengths in scan) - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + offsets.Free processor + + // compute columns + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor BPositions rightMatrix.Columns columns + + // compute rows + let ARows = expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor APositions ARows rows + + ARows.Free processor + + // compute leftMatrix values + let AValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + AGather processor APositions leftMatrix.Values AValues + + APositions.Free processor + + // compute right matrix values + let BValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + BGather processor BPositions rightMatrix.Values BValues + + BPositions.Free processor + + // multiply values TODO(filter values) + let values = mul processor DeviceOnly AValues BValues + + AValues.Free processor + BValues.Free processor + + values, columns, rows + + let sortByColumnsAndRows (clContext: ClContext) workGroupSize = + + let sortByKeyIndices = Radix.runByKeysStandard clContext workGroupSize + + let sortByKeyValues = Radix.runByKeysStandard clContext workGroupSize + + let sortKeys = Radix.standardRunKeysOnly clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> + // sort by columns + let valuesSortedByColumns = sortByKeyValues processor columns values + + let rowsSortedByColumns = sortByKeyIndices processor columns rows + + let sortedColumns = sortKeys processor columns + + // sort by rows + let valuesSortedByRows = sortByKeyValues processor rows valuesSortedByColumns + + let columnsSortedByRows = sortByKeyIndices processor rows sortedColumns + + let sortedRows = sortKeys processor rowsSortedByColumns + + valuesSortedByColumns.Free processor + rowsSortedByColumns.Free processor + sortedColumns.Free processor + + valuesSortedByRows, columnsSortedByRows, sortedRows + + let reduce (clContext: ClContext) workGroupSize opAdd = + + let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd + + let getUniqueBitmap = + ClArray.getUniqueBitmap2 clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - let gather = Gather.run clContext workGroupSize + let removeDuplicates = ClArray.removeDuplications clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> - let bRowsLengths = getRowsLengths processor DeviceOnly rightMatrix.RowPointers + let bitmap = getUniqueBitmap processor DeviceOnly columns rows - let segmentsLengths = zeroCreate processor DeviceOnly leftMatrix.Columns.Length - gather processor leftMatrix.Columns bRowsLengths segmentsLengths + let uniqueKeysCount = (prefixSum processor bitmap).ToHostAndFree processor - bRowsLengths.Free processor + let offsets = removeDuplicates processor bitmap - let length = (prefixSum processor segmentsLengths).ToHostAndFree processor + bitmap.Free processor + + let reducedColumns, reducedRows, reducedValues = + reduce processor allocationMode uniqueKeysCount offsets columns rows values + + offsets.Free processor + + reducedValues, reducedColumns, reducedRows + + let run (clContext: ClContext) workGroupSize opMul opAdd = + + let getSegmentPointers = getSegmentPointers clContext workGroupSize + + let expand = expand clContext workGroupSize opMul + + let sort = sortByColumnsAndRows clContext workGroupSize + + let reduce = reduce clContext workGroupSize opAdd + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let length, segmentPointers = getSegmentPointers processor leftMatrix rightMatrix + + let values, columns, rows = + expand processor length segmentPointers leftMatrix rightMatrix + + let sortedValues, sortedColumns, sortedRows = + sort processor values columns rows + values.Free processor + columns.Free processor + rows.Free processor + let reducedValues, reducedColumns, reducedRows = + reduce processor allocationMode sortedValues sortedColumns sortedRows - () + sortedValues.Free processor + sortedColumns.Free processor + sortedRows.Free processor + reducedValues, reducedColumns, reducedRows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index 1300b3cb..eaca8906 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -40,3 +40,40 @@ module Common = valuesScatter processor positions allValues resultValues resultRows, resultColumns, resultValues, resultLength + + let expandRowPointers (clContext: ClContext) workGroupSize = + + let expandRowPointers = + <@ fun (ndRange: Range1D) (rowPointers: ClArray) (rowCount: int) (rows: ClArray) -> + + let i = ndRange.GlobalID0 + + if i < rowCount then + let rowPointer = rowPointers.[i] + + if rowPointer <> rowPointers.[i + 1] then + rows.[rowPointer] <- i @> + + let program = clContext.Compile expandRowPointers + + let create = + ClArray.zeroCreate clContext workGroupSize + + let scan = + PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> + + let rows = create processor allocationMode nnz + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(rowCount, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowPointers rowCount rows)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + (scan processor rows 0).Free processor + + rows diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 483c6c80..a697d5e0 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -25,3 +25,7 @@ module Map = let inc = <@ fun item -> item + 1 @> let subtraction = <@ fun first second -> first - second @> + + let fst () = <@ fun fst _ -> fst @> + + let snd () = <@ fun _ snd -> snd @> diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs new file mode 100644 index 00000000..a3569ab5 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -0,0 +1,63 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.Gather + +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Tests +open Expecto +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let check isEqual actual positions values target = + + HostPrimitives.gather positions values target + + "Results must be the same" + |> Utils.compareArrays isEqual actual target + +let makeTest isEqual testFun (array: (uint * 'a * 'a) []) = + + if array.Length > 0 then + + let positions, values, target = + Array.unzip3 array + |> fun (fst, snd, thd) -> Array.map int fst, snd, thd + + let clPositions = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positions) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clTarget = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, target) + + testFun processor clPositions clValues clTarget + + clPositions.Free processor + clValues.Free processor + + let actual = clTarget.ToHostAndFree processor + + check isEqual actual positions values target + +let createTest<'a> (isEqual: 'a -> 'a -> bool) testFun = + + let testFun = testFun context Utils.defaultWorkGroupSize + + makeTest isEqual testFun + |> testPropertyWithConfig Utils.defaultConfig $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) Gather.run + + if Utils.isFloat64Available context.ClDevice then + createTest Utils.floatIsEqual Gather.run + + createTest Utils.float32IsEqual Gather.run + createTest (=) Gather.run + createTest (=) Gather.run ] + |> testList "Gather" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index b0f24510..6a7f66f3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -269,12 +269,9 @@ let sequential2DTest = let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a) []) = - let firstKeys, secondKeys, values = - array - |> Array.sortBy (fun (fst, snd, _) -> fst, snd) - |> Array.unzip3 + if array.Length > 0 then + let array = Array.sortBy (fun (fst, snd, _) -> fst, snd) array - if firstKeys.Length > 0 then let offsets = array |> Array.map (fun (fst, snd, _) -> fst, snd) diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 5730ca2e..9bb976b3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -3,9 +3,11 @@ module GraphBLAS.FSharp.Tests.Backend.Common.Scatter open Expecto open Expecto.Logging open Brahma.FSharp +open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "Scatter.Tests" @@ -21,22 +23,12 @@ let q = defaultContext.Queue let makeTest scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then - let expected = Array.copy result - - array - |> Array.pairwise - |> Array.iter - (fun ((i, u), (j, _)) -> - if i <> j && 0 <= i && i < expected.Length then - expected.[i] <- u) - - let i, u = array.[array.Length - 1] - - if 0 <= i && i < expected.Length then - expected.[i] <- u - let positions, values = Array.unzip array + let expected = + Array.copy result + |> HostPrimitives.scatter positions values + let actual = use clPositions = context.CreateClArray positions use clValues = context.CreateClArray values @@ -44,7 +36,7 @@ let makeTest scatter (array: (int * 'a) []) (result: 'a []) = scatter q clPositions clValues clResult - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, Array.zeroCreate result.Length, ch)) + clResult.ToHostAndFree q $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" |> Tests.Utils.compareArrays (=) actual expected @@ -52,7 +44,7 @@ let makeTest scatter (array: (int * 'a) []) (result: 'a []) = let testFixtures<'a when 'a: equality> = Scatter.runInplace<'a> context wgSize |> makeTest - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" + |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" let tests = q.Error.Add(fun e -> failwithf $"%A{e}") diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 17381aca..502969bf 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -17,6 +17,7 @@ + @@ -47,9 +48,8 @@ - - + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index ca38bf69..370155b2 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -140,59 +140,6 @@ module Utils = result - let prefixSumExclude (array: 'a []) zero plus = - let mutable sum = zero - - for i in 0 .. array.Length - 1 do - let currentItem = array.[i] - array.[i] <- sum - - sum <- plus currentItem sum - - sum - - let prefixSumInclude (array: 'a []) zero plus = - let mutable sum = zero - - for i in 0 .. array.Length - 1 do - sum <- plus array.[i] sum - - array.[i] <- sum - - sum - - let getUniqueBitmap<'a when 'a: equality> (array: 'a []) = - let bitmap = Array.zeroCreate array.Length - - for i in 0 .. array.Length - 2 do - if array.[i] <> array.[i + 1] then bitmap.[i] <- 1 - - // set last 1 - bitmap.[bitmap.Length - 1] <- 1 - - bitmap - - let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = - for i in 0 .. positions.Length - 2 do - if positions.[i] <> positions.[i + 1] then - let valuePosition = positions.[i] - let value = values.[i] - - resultValues.[valuePosition] <- value - - // set last value - let lastPosition = positions.[positions.Length - 1] - let lastValue = values.[values.Length - 1] - - resultValues.[lastPosition] <- lastValue - - let gather (positions: int []) (values: 'a []) (result: 'a []) = - for i in 0 .. positions.Length do - let position = positions.[i] - let value = values.[position] - - result.[position] <- value - let castMatrixToCSR = function | Matrix.CSR matrix -> matrix | _ -> failwith "matrix format must be CSR" @@ -253,6 +200,32 @@ module HostPrimitives = ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) |> Array.unzip3 + let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = + + if positions.Length <> values.Length then failwith "Lengths must be the same" + + let bitmap = getUniqueBitmapLastOccurrence positions + + Array.iteri2 + (fun index bit key -> + if bit = 1 + && 0 <= key + && key < resultValues.Length then + resultValues.[key] <- values.[index]) bitmap positions + + resultValues + + let gather (positions: int []) (values: 'a []) (result: 'a []) = + if positions.Length <> result.Length then + failwith "Lengths must be the same" + + Array.iteri (fun index position -> + if position >= 0 && position < values.Length then + result.[index] <- values.[position]) positions + + result + + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs deleted file mode 100644 index 332c2c82..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs +++ /dev/null @@ -1,185 +0,0 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Example - -open GraphBLAS.FSharp.Objects.Matrix -open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open Expecto -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Objects.ClContext - -let context = Context.defaultContext - -let clContext = context.ClContext -let processor = context.Queue - -/// -/// Left matrix -/// -/// -/// [ 0 0 2 3 0 -/// 0 0 0 0 0 -/// 0 8 0 5 4 -/// 0 0 2 0 0 -/// 1 7 0 0 0 ] -/// -let leftMatrix = - { RowCount = 5 - ColumnCount = 5 - RowPointers = [| 0; 2; 2; 5; 6; 8 |] - ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] - Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } - -/// -/// Right matrix -/// -/// -/// [ 0 0 0 0 0 0 0 -/// 0 3 0 0 4 0 4 -/// 0 0 2 0 0 2 0 -/// 0 5 0 0 0 9 1 -/// 0 0 0 0 1 0 8 ] -/// -let rightMatrix = - { RowCount = 5 - ColumnCount = 7 - RowPointers = [| 0; 0; 3; 5; 8; 10 |] - ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] - Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } - -let deviceLeftMatrix = leftMatrix.ToDevice clContext -let deviceRightMatrix = rightMatrix.ToDevice clContext - -let processPosition () = - let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize - - processPositions processor deviceLeftMatrix deviceRightMatrix - -let processPositionsTest = - testCase "ProcessPositions test" - <| fun () -> - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () - - "Global map must be the same" - |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] - - "global right matrix rows pointers must be the same" - |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] - - "required left matrix values must be the same" - |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] - - "required right matrix row pointers" - |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] - - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] - -let expandLeftMatrixValues () = - let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize - - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () - - let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues - - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor - - result - -let expandLeftMatrixValuesTest = - testCase "expandLeftMatrixValues test" - <| fun () -> - let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor - - "Expand left matrix values must be the same" - |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] - -let expandGlobalRightMatrixPointers () = - let expandRightMatrixValuesPointers = - Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize - - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () - - let globalRightMatrixValuesPointers = - expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap - - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor - - globalRightMatrixValuesPointers - -let extendGlobalRightMatrixPointersTest = - testCase "expandRightMatrixRowPointers test " - <| fun () -> - let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor - - "row pointers must be the same" - |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] - -let getRightMatrixValuesAndColumns () = - let getRightMatrixColumnsAndValues = - Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize - - let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () - - getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix - -let getRightMatrixValuesAndPointersTest = - testCase "expandRightMatrixValuesAndColumns" - <| fun () -> - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - - "extendedRightMatrixValues must be the same" - |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] - - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] - -let multiplication () = - let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> - - let expandedLeftMatrixValues = expandLeftMatrixValues () - - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - extendedRightMatrixColumns.Free processor - - let multiplicationResult = - map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues - - expandedLeftMatrixValues.Free processor - extendedRightMatrixValues.Free processor - - multiplicationResult - -let multiplicationTest = - testCase "multiplication test" <| fun () -> - let result = (multiplication ()).ToHostAndFree processor - - "Results must be the same" - |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] - -let runExtendTest = - testCase "Expand.run test" <| fun () -> - let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> - - let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = - run processor deviceLeftMatrix deviceRightMatrix - - "Results must be the same" - |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] - - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] - - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] - diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs deleted file mode 100644 index 8defec14..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ /dev/null @@ -1,252 +0,0 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Expand - -open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Test -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Objects.Matrix -open Expecto -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open Brahma.FSharp - -/// -/// Left matrix -/// -/// -/// [ 0 0 2 3 0 -/// 0 0 0 0 0 -/// 0 8 0 5 4 -/// 0 0 2 0 0 -/// 1 7 0 0 0 ] -/// -let leftMatrix = - { RowCount = 5 - ColumnCount = 5 - RowPointers = [| 0; 2; 2; 5; 6; 8 |] - ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] - Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } - -/// -/// Right matrix -/// -/// -/// [ 0 0 0 0 0 0 0 -/// 0 3 0 0 4 0 4 -/// 0 0 2 0 0 2 0 -/// 0 5 0 0 0 9 1 -/// 0 0 0 0 1 0 8 ] -/// -let rightMatrix = - { RowCount = 5 - ColumnCount = 7 - RowPointers = [| 0; 0; 3; 5; 8; 10 |] - ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] - Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } - -type ExpandedResult<'a> = - { Values: 'a [] - Columns: int [] - RowPointers: int [] } - -let config = { Utils.defaultConfig with arbitrary = [ typeof ] } - -let context = Context.defaultContext.ClContext - -let processor = Context.defaultContext.Queue - -let hostExpand multiplication (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'a>) = - // Pointers to start positions for right matrix rows in global array - // With duplicates which means that there is no string in the global array - let rowsPointersToGlobalArray, globalLength = - let requiredRightMatrixRowsLength = - (fun index -> - let columnIndex = leftMatrix.ColumnIndices.[index] - - let startPointer = rightMatrix.RowPointers.[columnIndex] - let endPointer = rightMatrix.RowPointers.[columnIndex + 1] - - endPointer - startPointer) - |> Array.init leftMatrix.ColumnIndices.Length - - //printfn "requiredRightMatrixRowsLength: %A" requiredRightMatrixRowsLength - - // Get right matrix row positions in global array by side effect - let globalLength = - Utils.prefixSumExclude requiredRightMatrixRowsLength 0 (+) - - //printfn "requiredRightMatrixRowsLength after prefix sum: %A" requiredRightMatrixRowsLength - - requiredRightMatrixRowsLength, globalLength - - //printfn "global length: %A" globalLength - - let resultGlobalRowPointers = - (fun index -> - if index < leftMatrix.RowPointers.Length - 1 then - let rowPointer = leftMatrix.RowPointers.[index] - - // printfn "index: %A; lenght: %A" rowPointer rowsPointersToGlobalArray.Length - - rowsPointersToGlobalArray.[rowPointer] - else - globalLength) - |> Array.init leftMatrix.RowPointers.Length - - // Right matrix row positions in global array without duplicates - let globalRightMatrixRowPositions = Array.distinct rowsPointersToGlobalArray - - //printfn "global right matrix row positions without pointers: %A" globalRightMatrixRowPositions - - // Create global map - let globalMap = - let array = - (fun index -> if Array.contains index globalRightMatrixRowPositions then 1 else 0) - |> Array.init globalLength - - Utils.prefixSumInclude array 0 (+) |> ignore - - array - - //printfn "%A" globalMap - - // get required left matrix columns and values - let requiredLeftMatrixColumns, requireLeftMatrixValues = - let positions = - Utils.getUniqueBitmap rowsPointersToGlobalArray - - let length = Utils.prefixSumExclude positions 0 (+) - - let requiredLeftMatrixColumns = Array.zeroCreate length - - Utils.scatter positions leftMatrix.ColumnIndices requiredLeftMatrixColumns - - // printfn "required left matrix columns: %A" requiredLeftMatrixColumns - - let requiredLeftMatrixValues = Array.zeroCreate length - - Utils.scatter positions leftMatrix.Values requiredLeftMatrixValues - - // printfn "required left matrix values: %A" requiredLeftMatrixValues - - requiredLeftMatrixColumns, requiredLeftMatrixValues - - // right matrix required row pointers - let rightMatrixRequiredRowsPointers = - (fun index -> - let requiredLeftMatrixColumn = requiredLeftMatrixColumns.[index] - - rightMatrix.RowPointers.[requiredLeftMatrixColumn]) - |> Array.init globalRightMatrixRowPositions.Length - - //printfn "right matrix required row pointers: %A" rightMatrixRequiredRowsPointers - - let globalRequiredRightMatrixValuesIndices = - (fun index -> - let rowID = globalMap.[index] - 1 - let sourcePosition = globalRightMatrixRowPositions.[rowID] - let offset = index - sourcePosition - - rightMatrixRequiredRowsPointers.[rowID] + offset) - |> Array.init globalLength - - //printfn "global required right matrix values: %A" globalRequiredRightMatrixValuesIndices - - let globalRightMatrixRequiredValues = - (fun index -> - let valueIndex = globalRequiredRightMatrixValuesIndices.[index] - rightMatrix.Values.[valueIndex]) - |> Array.init globalLength - - let globalRightMatrixRequiredColumnIndices = - (fun index -> - let valueIndex = globalRequiredRightMatrixValuesIndices.[index] - rightMatrix.ColumnIndices.[valueIndex]) - |> Array.init globalLength - - //printfn "global required right matrix columns: %A" globalRightMatrixRequiredColumnIndices - - let globalLeftMatrixRequiredValues = - (fun index -> - let valueIndex = globalMap.[index] - 1 - - requireLeftMatrixValues.[valueIndex]) - |> Array.init globalLength - - let resultValues = - Array.map2 multiplication globalRightMatrixRequiredValues globalLeftMatrixRequiredValues - - { Values = resultValues - Columns = globalRightMatrixRequiredColumnIndices - RowPointers = resultGlobalRowPointers } - -let checkResult multiplication leftMatrix rightMatrix actualResult = - let expected = - hostExpand multiplication leftMatrix rightMatrix - - "Values must be the same" - |> Expect.sequenceEqual expected.Values actualResult.Values - - "Columns must be the same" - |> Expect.sequenceEqual expected.Columns actualResult.Columns - - "Row pointers must be the same" - |> Expect.sequenceEqual expected.RowPointers actualResult.RowPointers - - printfn "SUCCESS" - -let makeTest isZero multiplication expand (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray isZero - |> Utils.castMatrixToCSR - - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray isZero - |> Utils.castMatrixToCSR - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - try - //printfn $"left matrix: %A{leftArray}" - //printfn $"right matrix: %A{rightArray}" - - if leftMatrix.ColumnCount <> rightMatrix.RowCount then - failwith "LOLO" - - hostExpand multiplication leftMatrix rightMatrix |> ignore - - let deviceLeftMatrix = - leftMatrix.ToDevice context - - let deviceRightMatrix = - rightMatrix.ToDevice context - - let (multiplicationResult: ClArray<'a>), - (extendedRightMatrixColumns: ClArray), - (resultRowPointers: ClArray) = - expand processor deviceLeftMatrix deviceRightMatrix - - { Values = multiplicationResult.ToHostAndFree processor - Columns = extendedRightMatrixColumns.ToHostAndFree processor - RowPointers = resultRowPointers.ToHostAndFree processor } - |> checkResult multiplication leftMatrix rightMatrix - with - | ex when ex.Message = "InvalidBufferSize" -> () - | _ -> reraise () - -let creatTest<'a when 'a : struct and 'a : equality> (isZero: 'a -> bool) multiplicationQ multiplication = - Expand.run context Utils.defaultWorkGroupSize multiplicationQ - |> makeTest isZero multiplication - |> testPropertyWithConfig config $"Expand.run on %A{typeof<'a>}" - -let testFixtures = - creatTest ((=) 0) <@ (*) @> (*) - -let check = - let leftMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[-2; 3; -1; -3]; [2; -1; 3; -1]] - - let rightMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[3; 0; 3; 4]; [1; -4; 1; 0]] - - () - diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs new file mode 100644 index 00000000..181df0c9 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -0,0 +1,89 @@ +module GraphBLAS.FSharp.Tests.Matrix.SpGeMM + +open Expecto +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + printfn $"all: %A{rightMatrix.RowPointers}" + + let firstRowPointers = + rightMatrix.RowPointers.[..rightMatrix.RowPointers.Length - 2] + + printfn $"first pointers: %A{firstRowPointers}" + + let lastRowPointers = rightMatrix.RowPointers.[1..] + + printfn $"last pointers: %A{lastRowPointers}" + + let rowsLengths = Array.map2 (-) lastRowPointers firstRowPointers + + printfn $"all row lengths %A{rowsLengths}" + + let neededLengths = Array.init leftMatrix.ColumnIndices.Length (fun index -> Array.item index rowsLengths) + + printfn $"needed lengths %A{neededLengths}" + + HostPrimitives.prefixSumExclude neededLengths + +let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,], _: bool [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray isZero + |> Utils.castMatrixToCSR + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray isZero + |> Utils.castMatrixToCSR + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + + let clRightMatrix = rightMatrix.ToDevice context + + let actualLength, (clActual: ClArray) = + testFun processor clLeftMatrix clRightMatrix + + let actualPointers = clActual.ToHostAndFree processor + + let expectedPointers, expectedLength = + getSegmentsPointers leftMatrix rightMatrix + + "Results lengths must be the same" + |> Expect.equal actualLength expectedLength + + "Result pointers must be the same" + |> Expect.sequenceEqual actualPointers expectedPointers + +let createTest<'a when 'a : struct> (isZero: 'a -> bool) testFun = + + let testFun = testFun context Utils.defaultWorkGroupSize + + makeTest isZero testFun + |> testPropertyWithConfig { Utils.defaultConfig with endSize = 10 } $"test on {typeof<'a>}" + +let getSegmentsTests = + [ createTest ((=) 0) Expand.getSegmentPointers + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) Expand.getSegmentPointers + + createTest ((=) 0f) Expand.getSegmentPointers + createTest ((=) false) Expand.getSegmentPointers + createTest ((=) 0u) Expand.getSegmentPointers ] + |> testList "get segment pointers" + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 3f47eaa1..f773301e 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,6 +1,6 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM +open GraphBLAS.FSharp.Tests.Matrix // [] @@ -94,8 +94,8 @@ open GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM let allTests = testList "All tests" - [ Common.Reduce.ByKey.sequential2DTest - Common.Reduce.ByKey.sequentialSegmentTests2D ] + [ Common.Scatter.tests + Common.Gather.tests ] |> testSequenced From b6796500836a81bb4aa7cee30818e1b29d539a31 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 4 Apr 2023 15:09:21 +0300 Subject: [PATCH 040/143] wip: segments computing tests --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 14 +---- src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 14 ++++- tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 1 + tests/GraphBLAS-sharp.Tests/Generators.fs | 3 - tests/GraphBLAS-sharp.Tests/Helpers.fs | 1 - tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 58 ++++++++++++------- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- 7 files changed, 51 insertions(+), 43 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 035f2758..b94de138 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -45,30 +45,22 @@ module Expand = positions.Free processor - printfn $"first pointers gpu: %A{firstPointers.ToHost processor}" - // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers // (right matrix row pointers without first item) let shiftedPositions = // TODO(fuse) createShifted processor DeviceOnly positionsLength - printfn "shifted positions gpu: %A" <| shiftedPositions.ToHost processor - let lastPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) gather processor shiftedPositions rightMatrix.RowPointers lastPointers - printfn $"last pointers gpu: %A{lastPointers.ToHost processor}" - shiftedPositions.Free processor // subtract let rightMatrixRowsLengths = subtract processor DeviceOnly lastPointers firstPointers - printfn $"subtract result gpu: %A{rightMatrixRowsLengths.ToHost processor}" - firstPointers.Free processor lastPointers.Free processor @@ -78,17 +70,15 @@ module Expand = // extract needed lengths by left matrix nnz gather processor leftMatrix.Columns rightMatrixRowsLengths segmentsLengths - printfn $"subtract after gather result gpu: %A{segmentsLengths.ToHost processor}" - rightMatrixRowsLengths.Free processor // compute pointers let length = (prefixSum processor segmentsLengths).ToHostAndFree processor - printfn $"subtract after prefix sum gpu: %A{segmentsLengths.ToHost processor}" - length, segmentsLengths + let + let expand (clContext: ClContext) workGroupSize opMul = let init = ClArray.init clContext workGroupSize Map.id diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 957c5fe3..1603a010 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -23,6 +23,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.RowPointers)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length member this.ToCSC = @@ -48,6 +50,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.ColumnPointers)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length member this.ToCSR = @@ -73,6 +77,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.Rows)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length type Tuple<'elem when 'elem: struct> = @@ -88,6 +94,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.Values)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length [] @@ -110,9 +118,9 @@ type ClMatrix<'a when 'a: struct> = member this.Dispose q = match this with - | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.CSR matrix -> matrix.Dispose q + | ClMatrix.COO matrix -> matrix.Dispose q + | ClMatrix.CSC matrix -> matrix.Dispose q member this.NNZ = match this with diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs index a3569ab5..f991d0a4 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -14,6 +14,7 @@ let processor = Context.defaultContext.Queue let check isEqual actual positions values target = HostPrimitives.gather positions values target + |> ignore "Results must be the same" |> Utils.compareArrays isEqual actual target diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 42e28f3e..5144f0c7 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -389,9 +389,6 @@ module Generators = valuesGenerator |> Gen.array2DOfDim (nColsA, nColsB) - printf $"left matrix column count: %A{Array2D.length1 matrixA}" - printf $"right matrix row count: %A{Array2D.length2 matrixA}" - return (matrixA, matrixB) } diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 370155b2..ebd82453 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -225,7 +225,6 @@ module HostPrimitives = result - module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 181df0c9..bf277298 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -2,6 +2,7 @@ module GraphBLAS.FSharp.Tests.Matrix.SpGeMM open Expecto open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +open GraphBLAS.FSharp.Test open Microsoft.FSharp.Collections open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Matrix @@ -16,29 +17,14 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - printfn $"all: %A{rightMatrix.RowPointers}" - - let firstRowPointers = - rightMatrix.RowPointers.[..rightMatrix.RowPointers.Length - 2] - - printfn $"first pointers: %A{firstRowPointers}" - - let lastRowPointers = rightMatrix.RowPointers.[1..] - - printfn $"last pointers: %A{lastRowPointers}" - - let rowsLengths = Array.map2 (-) lastRowPointers firstRowPointers - - printfn $"all row lengths %A{rowsLengths}" - - let neededLengths = Array.init leftMatrix.ColumnIndices.Length (fun index -> Array.item index rowsLengths) - - printfn $"needed lengths %A{neededLengths}" +let config = { Utils.defaultConfig with arbitrary = [ typeof ] } - HostPrimitives.prefixSumExclude neededLengths +let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + Array.map (fun item -> + rightMatrix.RowPointers.[item + 1] - rightMatrix.RowPointers.[item]) leftMatrix.ColumnIndices + |> HostPrimitives.prefixSumExclude -let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,], _: bool [,]) = +let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let leftMatrix = Utils.createMatrixFromArray2D CSR leftArray isZero @@ -57,6 +43,8 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,], _: bool [,]) let actualLength, (clActual: ClArray) = testFun processor clLeftMatrix clRightMatrix + clLeftMatrix.Dispose processor + let actualPointers = clActual.ToHostAndFree processor let expectedPointers, expectedLength = @@ -73,7 +61,7 @@ let createTest<'a when 'a : struct> (isZero: 'a -> bool) testFun = let testFun = testFun context Utils.defaultWorkGroupSize makeTest isZero testFun - |> testPropertyWithConfig { Utils.defaultConfig with endSize = 10 } $"test on {typeof<'a>}" + |> testPropertyWithConfig { config with endSize = 10 } $"test on {typeof<'a>}" let getSegmentsTests = [ createTest ((=) 0) Expand.getSegmentPointers @@ -86,4 +74,30 @@ let getSegmentsTests = createTest ((=) 0u) Expand.getSegmentPointers ] |> testList "get segment pointers" +let makeExpandTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray isZero + |> Utils.castMatrixToCSR + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray isZero + |> Utils.castMatrixToCSR + + if leftMatrix.NNZ > 0 + && rightMatrix.NNZ > 0 then + + let segmentPointers, length = + getSegmentsPointers leftMatrix rightMatrix + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + let clSegmentPointers = context.CreateClArray segmentPointers + + let (actualValues: ClArray<'a>), (actualColumns: ClArray), (actualRows: ClArray) = + testFun processor length clSegmentPointers clLeftMatrix clRightMatrix + + clLeftMatrix.Free processor + clRightMatrix. processor + clSegmentPointers diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f773301e..d49deff2 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ Common.Scatter.tests - Common.Gather.tests ] + [ SpGeMM.getSegmentsTests ] |> testSequenced From 7e09219f7e2fb3d37b76c177fa0a38bb3cef29b8 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 4 Apr 2023 18:56:10 +0300 Subject: [PATCH 041/143] wip: expand tests passed --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 2 - tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 102 ++++++++++++++---- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 3 files changed, 84 insertions(+), 22 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index b94de138..a5e8f90f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -77,8 +77,6 @@ module Expand = length, segmentsLengths - let - let expand (clContext: ClContext) workGroupSize opMul = let init = ClArray.init clContext workGroupSize Map.id diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index bf277298..8ded29f0 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -19,6 +19,10 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with arbitrary = [ typeof ] } +let createCSRMatrix array isZero = + Utils.createMatrixFromArray2D CSR array isZero + |> Utils.castMatrixToCSR + let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = Array.map (fun item -> rightMatrix.RowPointers.[item + 1] - rightMatrix.RowPointers.[item]) leftMatrix.ColumnIndices @@ -26,13 +30,9 @@ let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray isZero - |> Utils.castMatrixToCSR + let leftMatrix = createCSRMatrix leftArray isZero - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray isZero - |> Utils.castMatrixToCSR + let rightMatrix = createCSRMatrix rightArray isZero if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then @@ -44,6 +44,7 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = testFun processor clLeftMatrix clRightMatrix clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor let actualPointers = clActual.ToHostAndFree processor @@ -61,7 +62,7 @@ let createTest<'a when 'a : struct> (isZero: 'a -> bool) testFun = let testFun = testFun context Utils.defaultWorkGroupSize makeTest isZero testFun - |> testPropertyWithConfig { config with endSize = 10 } $"test on {typeof<'a>}" + |> testPropertyWithConfig config $"test on {typeof<'a>}" let getSegmentsTests = [ createTest ((=) 0) Expand.getSegmentPointers @@ -71,18 +72,48 @@ let getSegmentsTests = createTest ((=) 0f) Expand.getSegmentPointers createTest ((=) false) Expand.getSegmentPointers - createTest ((=) 0u) Expand.getSegmentPointers ] + createTest ((=) 0uy) Expand.getSegmentPointers ] |> testList "get segment pointers" -let makeExpandTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = +let expand length segmentPointers mulOp (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + let extendPointers pointers = + Array.pairwise pointers + |> Array.map (fun (fst, snd) -> snd - fst) + |> Array.mapi (fun index length -> Array.create length index) + |> Array.concat + + let segmentsLengths = + Array.append segmentPointers [| length |] + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let leftMatrixValues, expectedRows = + let tripleFst (fst, _, _) = fst + + Array.zip3 segmentsLengths leftMatrix.Values <| extendPointers leftMatrix.RowPointers // TODO(expand row pointers) + // select items each segment length not zero + |> Array.filter (tripleFst >> ((=) 0) >> not) + |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) + |> Array.unzip + + let rightMatrixValues, expectedColumns = + let valuesAndColumns = Array.zip rightMatrix.Values rightMatrix.ColumnIndices - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray isZero - |> Utils.castMatrixToCSR + Array.map2 (fun column length -> + let rowStart = rightMatrix.RowPointers.[column] + Array.take length valuesAndColumns.[rowStart..]) leftMatrix.ColumnIndices segmentsLengths + |> Array.concat + |> Array.unzip - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray isZero - |> Utils.castMatrixToCSR + let expectedValues = Array.map2 mulOp leftMatrixValues rightMatrixValues + + expectedValues, expectedColumns, expectedRows + +let makeExpandTest isEqual zero opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = createCSRMatrix leftArray <| isEqual zero + + let rightMatrix = createCSRMatrix rightArray <| isEqual zero if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then @@ -94,10 +125,43 @@ let makeExpandTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let clRightMatrix = rightMatrix.ToDevice context let clSegmentPointers = context.CreateClArray segmentPointers - let (actualValues: ClArray<'a>), (actualColumns: ClArray), (actualRows: ClArray) = + let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = testFun processor length clSegmentPointers clLeftMatrix clRightMatrix - clLeftMatrix.Free processor - clRightMatrix. processor - clSegmentPointers + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + clSegmentPointers.Free processor + + let actualValues = clActualValues.ToHostAndFree processor + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor + + let expectedValues, expectedColumns, expectedRows = + expand length segmentPointers opMul leftMatrix rightMatrix + + "Values must be the same" + |> Utils.compareArrays isEqual actualValues expectedValues + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expectedColumns + + "Rows must be the same" + |> Utils.compareArrays (=) actualRows expectedRows + +let createExpandTest isEqual (zero: 'a) opMul opMulQ testFun = + + let testFun = testFun context Utils.defaultWorkGroupSize opMulQ + + makeExpandTest isEqual zero opMul testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let expandTests = + [ createExpandTest (=) 0 (*) <@ (*) @> Expand.expand + + if Utils.isFloat64Available context.ClDevice then + createExpandTest Utils.floatIsEqual 0.0 (*) <@ (*) @> Expand.expand + createExpandTest Utils.float32IsEqual 0f (*) <@ (*) @> Expand.expand + createExpandTest (=) false (&&) <@ (&&) @> Expand.expand + createExpandTest (=) 0uy (*) <@ (*) @> Expand.expand ] + |> testList "Expand.expand" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index d49deff2..befa7b96 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,7 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.getSegmentsTests ] + [ SpGeMM.expandTests ] |> testSequenced From 84fb950071c50a64c710097ca4be36304c351389 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 5 Apr 2023 21:53:02 +0300 Subject: [PATCH 042/143] wip: getUniqueBitmap{first/last} occurrence --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 49 ++++++++++---- .../Common/Sort/Radix.fs | 11 ++-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 44 ++++++++++--- .../Common/Sort/Radix.fs | 14 ++-- tests/GraphBLAS-sharp.Tests/Helpers.fs | 12 ++++ tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 65 +++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 7 files changed, 162 insertions(+), 35 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index e8fba339..761e56ea 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -130,18 +130,20 @@ module ClArray = outputArray - let getUniqueBitmap (clContext: ClContext) workGroupSize = + let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize = let getUniqueBitmap = <@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray) -> - let i = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if i < inputLength - 1 - && inputArray.[i] = inputArray.[i + 1] then - isUniqueBitmap.[i] <- 0 - else - isUniqueBitmap.[i] <- 1 @> + if gid < inputLength then + let isUnique = (%predicate) gid inputLength inputArray // brahma error + + if isUnique then + isUniqueBitmap.[gid] <- 1 + else + isUniqueBitmap.[gid] <- 0 @> let kernel = clContext.Compile(getUniqueBitmap) @@ -163,6 +165,18 @@ module ClArray = bitmap + let getUniqueBitmapFirstOccurrence clContext = + getUniqueBitmapGeneral + <| <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> + gid = 0 || inputArray.[gid - 1] <> inputArray.[gid] @> + <| clContext + + let getUniqueBitmapLastOccurrence clContext = + getUniqueBitmapGeneral + <| <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> + gid = length - 1 || inputArray.[gid] <> inputArray.[gid + 1] @> + <| clContext + ///Remove duplicates form the given array. ///Computational context ///Should be a power of 2 and greater than 1. @@ -172,7 +186,7 @@ module ClArray = let scatter = Scatter.runInplace clContext workGroupSize - let getUniqueBitmap = getUniqueBitmap clContext workGroupSize + let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSumExclude = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize @@ -292,24 +306,33 @@ module ClArray = resultArray - let getUniqueBitmap2<'a when 'a: equality> (clContext: ClContext) workGroupSize = + let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = - let map = map2 clContext workGroupSize <@ fun x y -> if x = 1 && y = 1 then 1 else 0 @> + let map = map2 clContext workGroupSize <@ fun x y -> x ||| y @> - let getUniqueBitmap = getUniqueBitmap clContext workGroupSize + let firstGetBitmap = getUniqueBitmap clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> - let firstBitmap = getUniqueBitmap processor DeviceOnly firstArray + let firstBitmap = firstGetBitmap processor DeviceOnly firstArray - let secondBitmap = getUniqueBitmap processor DeviceOnly secondArray + let secondBitmap = firstGetBitmap processor DeviceOnly secondArray let result = map processor allocationMode firstBitmap secondBitmap + printfn $"first bitmap: %A{firstBitmap.ToHost processor}" + printfn $"second bitmap: %A{secondBitmap.ToHost processor}" + firstBitmap.Free processor secondBitmap.Free processor result + let getUniqueBitmap2FirstOccurrence clContext = + getUniqueBitmap2General getUniqueBitmapFirstOccurrence clContext + + let getUniqueBitmap2LastOccurrence clContext = + getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext + let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = let getBitmap = map<'a, int> clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index d2055b6e..5b9e606e 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -264,25 +264,28 @@ module Radix = let scatterByKey = scatterByKey clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) (keys: Indices) (values: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (keys: Indices) (values: ClArray<'a>) -> if values.Length <> keys.Length then failwith "Mismatch of key lengths and value. Lengths must be the same" if values.Length <= 1 then - values + dataCopy processor allocationMode values else let firstKeys = copy processor DeviceOnly keys let secondKeys = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) - let secondValues = dataCopy processor DeviceOnly values + let firstValues = dataCopy processor DeviceOnly values + + let secondValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values.Length) let workGroupCount = clContext.CreateClCell((keys.Length - 1) / workGroupSize + 1) let mutable keysPair = (firstKeys, secondKeys) - let mutable valuesPair = (values, secondValues) + let mutable valuesPair = (firstValues, secondValues) let swap (x, y) = y, x // compute bound of iterations diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index a5e8f90f..4e46dbbb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -184,16 +184,16 @@ module Expand = fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> // sort by columns - let valuesSortedByColumns = sortByKeyValues processor columns values + let valuesSortedByColumns = sortByKeyValues processor DeviceOnly columns values - let rowsSortedByColumns = sortByKeyIndices processor columns rows + let rowsSortedByColumns = sortByKeyIndices processor DeviceOnly columns rows let sortedColumns = sortKeys processor columns // sort by rows - let valuesSortedByRows = sortByKeyValues processor rows valuesSortedByColumns + let valuesSortedByRows = sortByKeyValues processor DeviceOnly rows valuesSortedByColumns - let columnsSortedByRows = sortByKeyIndices processor rows sortedColumns + let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rows sortedColumns let sortedRows = sortKeys processor rowsSortedByColumns @@ -208,21 +208,36 @@ module Expand = let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd let getUniqueBitmap = - ClArray.getUniqueBitmap2 clContext workGroupSize + ClArray.getUniqueBitmap2FirstOccurrence clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - let removeDuplicates = ClArray.removeDuplications clContext workGroupSize + let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) + + let scatter = Scatter.runInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> let bitmap = getUniqueBitmap processor DeviceOnly columns rows + printfn $"key bitmap: %A{bitmap.ToHost processor}" + let uniqueKeysCount = (prefixSum processor bitmap).ToHostAndFree processor - let offsets = removeDuplicates processor bitmap + printfn $"key bitmap after prefix sum: %A{bitmap.ToHost processor}" + + let positions = init processor DeviceOnly bitmap.Length + + printfn $"positions: %A{positions.ToHost processor}" + + let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + scatter processor bitmap positions offsets + + printfn $"offsets: %A{offsets.ToHost processor}" bitmap.Free processor + positions.Free processor let reducedColumns, reducedRows, reducedValues = reduce processor allocationMode uniqueKeysCount offsets columns rows values @@ -231,7 +246,7 @@ module Expand = reducedValues, reducedColumns, reducedRows - let run (clContext: ClContext) workGroupSize opMul opAdd = + let run (clContext: ClContext) workGroupSize opAdd opMul = let getSegmentPointers = getSegmentPointers clContext workGroupSize @@ -248,9 +263,17 @@ module Expand = let values, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix + printfn $"expanded values: %A{values.ToHost processor}" + printfn $"expanded columns: %A{columns.ToHost processor}" + printfn $"expanded rows: %A{rows.ToHost processor}" + let sortedValues, sortedColumns, sortedRows = sort processor values columns rows + printfn $"sorted values: %A{sortedValues.ToHost processor}" + printfn $"sorted columns: %A{sortedColumns.ToHost processor}" + printfn $"sorted rows: %A{sortedRows.ToHost processor}" + values.Free processor columns.Free processor rows.Free processor @@ -258,8 +281,13 @@ module Expand = let reducedValues, reducedColumns, reducedRows = reduce processor allocationMode sortedValues sortedColumns sortedRows + printfn $"reduced values: %A{reducedValues.ToHost processor}" + printfn $"reduced columns: %A{reducedColumns.ToHost processor}" + printfn $"reduced rows: %A{reducedRows.ToHost processor}" + sortedValues.Free processor sortedColumns.Free processor sortedRows.Free processor reducedValues, reducedColumns, reducedRows + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs index 56add17c..f0a9df92 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs @@ -5,6 +5,7 @@ open GraphBLAS.FSharp.Backend.Common.Sort open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext module Radix = let config = @@ -18,15 +19,12 @@ module Radix = let context = Context.defaultContext.ClContext let checkResultByKeys (inputArray: (int * 'a) []) (actualValues: 'a []) = - let expectedValues = - Array.sortBy fst inputArray |> Array.map snd + let expectedValues = Seq.sortBy fst inputArray |> Seq.map snd "Values must be the same" |> Expect.sequenceEqual expectedValues actualValues let makeTestByKeys<'a when 'a: equality> sortFun (array: (int * 'a) []) = - // since Array.sort not stable - let array = Array.distinctBy fst array if array.Length > 0 then let keys = Array.map fst array @@ -35,7 +33,7 @@ module Radix = let clKeys = keys.ToDevice context let clValues = values.ToDevice context - let clActualValues: ClArray<'a> = sortFun processor clKeys clValues + let clActualValues: ClArray<'a> = sortFun processor HostInterop clKeys clValues let actualValues = clActualValues.ToHostAndFree processor @@ -48,7 +46,7 @@ module Radix = makeTestByKeys<'a> sort |> testPropertyWithConfig config $"test on {typeof<'a>}" - let testFixturesByKeys = + let testByKeys = [ createTestByKeys createTestByKeys @@ -57,9 +55,7 @@ module Radix = createTestByKeys createTestByKeys ] - - let testsByKeys = - testList "Radix sort by keys" testFixturesByKeys + |> testList "Radix sort by keys" let makeTestKeysOnly sort (keys: uint []) = if keys.Length > 0 then diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index ebd82453..e7c76c0f 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -225,6 +225,18 @@ module HostPrimitives = result + let array2DMultiplication mul add leftArray rightArray = + if Array2D.length2 leftArray <> Array2D.length1 rightArray then + failwith "Incompatible matrices" + + Array2D.init + <| Array2D.length1 leftArray + <| Array2D.length2 rightArray + <| fun i j -> + (leftArray.[i, *], rightArray.[*, j]) + ||> Array.map2 mul + |> Array.reduce add + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 8ded29f0..f26474e7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -12,6 +12,7 @@ open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext let context = Context.defaultContext.ClContext @@ -165,3 +166,67 @@ let expandTests = createExpandTest (=) false (&&) <@ (&&) @> Expand.expand createExpandTest (=) 0uy (*) <@ (*) @> Expand.expand ] |> testList "Expand.expand" + +let checkGeneralResult zero isEqual actualValues actualColumns actualRows mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = + + let expected = + HostPrimitives.array2DMultiplication mul add leftArray rightArray + |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) + |> function Matrix.COO matrix -> matrix | _ -> failwith "format miss" + + printfn $"leftMatrix \n %A{leftArray}" + printfn $"rightMatrix \n %A{rightArray}" + + printfn $"actual values: %A{actualValues}" + printfn $"expected values: %A{expected.Values}" + + printfn $"actualColumns: %A{actualColumns}" + printfn $"expectedColumns: %A{expected.Columns}" + + printfn $"actualRows: %A{actualRows}" + printfn $"expectedRows: %A{expected.Rows}" + + "Values must be the same" + |> Utils.compareArrays isEqual actualValues expected.Values + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expected.Columns + + "Rows must be the same" + |> Utils.compareArrays (=) actualRows expected.Rows + +let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = createCSRMatrix leftArray <| isEqual zero + + let rightMatrix = createCSRMatrix rightArray <| isEqual zero + + if leftMatrix.NNZ > 0 + && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let actualValues = clActualValues.ToHostAndFree processor + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor + + checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray + +let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = + + let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ + + makeGeneralTest zero isEqual opMul opAdd testFun + |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) (+) <@ (+) @> (*) <@ (*) @> Expand.run ] + |> testList "general" + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index befa7b96..5a590c3f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,7 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.expandTests ] + [ SpGeMM.generalTests ] |> testSequenced From 8ec7fd750a11213b009aff3d46726f7eae259039 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 5 Apr 2023 22:22:16 +0300 Subject: [PATCH 043/143] add: Scatter.firstOccurrence --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 4 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 89 +++++++++++++------ .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 4 +- .../Matrix/CSRMatrix/SpGEMMMasked.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 4 +- .../Vector/DenseVector/DenseVector.fs | 4 +- .../Vector/SparseVector/Common.fs | 4 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 32 +++++-- tests/GraphBLAS-sharp.Tests/Helpers.fs | 8 +- tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- 11 files changed, 107 insertions(+), 52 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 761e56ea..b8c25e8b 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -184,7 +184,7 @@ module ClArray = let removeDuplications (clContext: ClContext) workGroupSize = let scatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize @@ -349,7 +349,7 @@ module ClArray = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize let scatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (array: ClArray<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index e8c8b737..ac680e35 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -3,26 +3,7 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp module internal Scatter = - - /// - /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array - /// should be a value from the given one. - /// - /// - /// Every element of the positions array must not be less than the previous one. - /// If there are several elements with the same indices, the last one of them will be at the common index. - /// If index is out of bounds, the value will be ignored. - /// - /// - /// - /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] - /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// let result = run clContext 32 processor positions values result - /// ... - /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] - /// - /// - let runInplace<'a> (clContext: ClContext) workGroupSize = + let private general<'a> predicate (clContext: ClContext) workGroupSize = let run = <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (values: ClArray<'a>) (result: ClArray<'a>) (resultLength: int) -> @@ -30,14 +11,11 @@ module internal Scatter = let gid = ndRange.GlobalID0 if gid < positionsLength then - let index = positions.[gid] + // positions lengths == values length + let predicateResult = (%predicate) gid positionsLength positions resultLength - if 0 <= index && index < resultLength then - if gid < positionsLength - 1 then - if index <> positions.[gid + 1] then - result.[index] <- values.[gid] - else - result.[index] <- values.[gid] @> + if predicateResult then + result.[positions.[gid]] <- values.[gid] @> let program = clContext.Compile(run) @@ -58,3 +36,60 @@ module internal Scatter = ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + /// + /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array + /// should be a value from the given one. + /// + /// + /// Every element of the positions array must not be less than the previous one. + /// If there are several elements with the same indices, the FIRST one of them will be at the common index. + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] + /// let result = run clContext 32 processor positions values result + /// ... + /// > val result = [| 1,9; 3.7; 6.4; 7.3; 9.1 |] + /// + /// + let scatterFirstOccurrence clContext = + general + <| <@ fun gid _ (positions: ClArray) resultLength -> + let currentKey = positions.[gid] + // first occurrence condition + (gid = 0 || positions.[gid - 1] <> positions.[gid]) + // result position in valid range + && (0 <= currentKey && currentKey < resultLength) @> + <| clContext + + /// + /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array + /// should be a value from the given one. + /// + /// + /// Every element of the positions array must not be less than the previous one. + /// If there are several elements with the same indices, the last one of them will be at the common index. + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] + /// let result = run clContext 32 processor positions values result + /// ... + /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] + /// + /// + let scatterLastOccurrence clContext = + general + <| <@ fun gid positionsLength (positions: ClArray) resultLength -> + let index = positions.[gid] + // last occurrence condition + (gid = positionsLength - 1 || index <> positions.[gid + 1]) + // result position in valid range + && (0 <= index && index < resultLength) @> + <| clContext + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 4e46dbbb..45b8bce1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -81,7 +81,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id - let scatter = Scatter.runInplace clContext workGroupSize + let scatter = Scatter.scatterLastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -214,7 +214,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - let scatter = Scatter.runInplace clContext workGroupSize + let scatter = Scatter.scatterLastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs index ad034f91..52297150 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs @@ -151,8 +151,8 @@ module internal SpGEMMMasked = let calculate = calculate context workGroupSize opAdd opMul - let scatter = Scatter.runInplace context workGroupSize - let scatterData = Scatter.runInplace context workGroupSize + let scatter = Scatter.scatterLastOccurrence context workGroupSize + let scatterData = Scatter.scatterLastOccurrence context workGroupSize let scanInplace = PrefixSum.standardExcludeInplace context workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index eaca8906..3fab5f9c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -11,10 +11,10 @@ module Common = let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = let indicesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let valuesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let sum = PrefixSum.standardExcludeInplace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 5aca4a57..af6ceff2 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -90,10 +90,10 @@ module DenseVector = let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize = let scatterValues = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let scatterIndices = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let getBitmap = ClArray.map clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs index a78fdd9f..2f781406 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs @@ -13,10 +13,10 @@ module internal Common = PrefixSum.standardExcludeInplace clContext workGroupSize let valuesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let indicesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 0746d515..d6c2dc96 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -35,7 +35,7 @@ module Vector = let ofList (clContext: ClContext) workGroupSize = let scatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 9bb976b3..221088ff 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -21,13 +21,13 @@ let wgSize = Tests.Utils.defaultWorkGroupSize let q = defaultContext.Queue -let makeTest scatter (array: (int * 'a) []) (result: 'a []) = +let makeTest hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then let positions, values = Array.unzip array let expected = Array.copy result - |> HostPrimitives.scatter positions values + |> hostScatter positions values let actual = use clPositions = context.CreateClArray positions @@ -41,15 +41,29 @@ let makeTest scatter (array: (int * 'a) []) (result: 'a []) = $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" |> Tests.Utils.compareArrays (=) actual expected -let testFixtures<'a when 'a: equality> = - Scatter.runInplace<'a> context wgSize - |> makeTest +let testFixturesLast<'a when 'a: equality> hostScatter = + Scatter.scatterLastOccurrence<'a> context wgSize + |> makeTest hostScatter + |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" + +let testFixturesFirst<'a when 'a: equality> hostScatter = + Scatter.scatterFirstOccurrence<'a> context wgSize + |> makeTest hostScatter |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" let tests = q.Error.Add(fun e -> failwithf $"%A{e}") - [ testFixtures - testFixtures - testFixtures ] - |> testList "Backend.Common.Scatter tests" + let last = + [ testFixturesLast HostPrimitives.scatterLastOccurrence + testFixturesLast HostPrimitives.scatterLastOccurrence + testFixturesLast HostPrimitives.scatterLastOccurrence ] + |> testList "Last Occurrence" + + let first = + [ testFixturesFirst HostPrimitives.scatterFirstOccurrence + testFixturesFirst HostPrimitives.scatterFirstOccurrence + testFixturesFirst HostPrimitives.scatterFirstOccurrence ] + |> testList "First Occurrence" + + testList "Scatter tests" [first; last] diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index e7c76c0f..c941d7ec 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -200,11 +200,11 @@ module HostPrimitives = ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) |> Array.unzip3 - let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = + let generalScatter getBitmap (positions: int array) (values: 'a array) (resultValues: 'a array) = if positions.Length <> values.Length then failwith "Lengths must be the same" - let bitmap = getUniqueBitmapLastOccurrence positions + let bitmap = getBitmap positions Array.iteri2 (fun index bit key -> @@ -215,6 +215,10 @@ module HostPrimitives = resultValues + let scatterLastOccurrence positions = generalScatter getUniqueBitmapLastOccurrence positions + + let scatterFirstOccurrence positions = generalScatter getUniqueBitmapFirstOccurrence positions + let gather (positions: int []) (values: 'a []) (result: 'a []) = if positions.Length <> result.Length then failwith "Lengths must be the same" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 5a590c3f..a044bf8b 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,7 +94,9 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.generalTests ] + [ // SpGeMM.generalTests + Common.Scatter.tests + ] |> testSequenced From 63037b677c7623a7ab8bfd0c50c6538c7df6c559 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 09:44:13 +0300 Subject: [PATCH 044/143] spgemm: left filtering --- .../Common/Sort/Radix.fs | 3 ++- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 12 ++++++--- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 27 +++++++++---------- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +-- 4 files changed, 24 insertions(+), 21 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index 5b9e606e..6bc24183 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -163,7 +163,7 @@ module Radix = fun (processor: MailboxProcessor<_>) (keys: Indices) -> if keys.Length <= 1 then - keys + copy processor DeviceOnly keys // TODO(allocation mode) else let firstKeys = copy processor DeviceOnly keys @@ -194,6 +194,7 @@ module Radix = localOffset.Free processor shift.Free processor + (snd pair).Free processor fst pair let standardRunKeysOnly clContext workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 45b8bce1..5e77b9c7 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -191,9 +191,9 @@ module Expand = let sortedColumns = sortKeys processor columns // sort by rows - let valuesSortedByRows = sortByKeyValues processor DeviceOnly rows valuesSortedByColumns + let valuesSortedByRows = sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns - let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rows sortedColumns + let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns let sortedRows = sortKeys processor rowsSortedByColumns @@ -206,15 +206,16 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd + //let reduce = Reduce.ByKey2D.sequential clContext workGroupSize opAdd let getUniqueBitmap = - ClArray.getUniqueBitmap2FirstOccurrence clContext workGroupSize + ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - let scatter = Scatter.scatterLastOccurrence clContext workGroupSize + let scatter = Scatter.scatterFirstOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> @@ -242,6 +243,9 @@ module Expand = let reducedColumns, reducedRows, reducedValues = reduce processor allocationMode uniqueKeysCount offsets columns rows values + // let reducedColumns, reducedRows, reducedValues = + // reduce processor DeviceOnly uniqueKeysCount columns rows values + offsets.Free processor reducedValues, reducedColumns, reducedRows diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index f26474e7..8102d533 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -203,30 +203,29 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + try + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context + let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = + testFun processor HostInterop clLeftMatrix clRightMatrix - let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = - testFun processor HostInterop clLeftMatrix clRightMatrix + let actualValues = clActualValues.ToHostAndFree processor + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - - let actualValues = clActualValues.ToHostAndFree processor - let actualColumns = clActualColumns.ToHostAndFree processor - let actualRows = clActualRows.ToHostAndFree processor - - checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray + checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ makeGeneralTest zero isEqual opMul opAdd testFun - |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig { config with endSize = 10; maxTest = 1000 } $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) (+) <@ (+) @> (*) <@ (*) @> Expand.run ] |> testList "general" - diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index a044bf8b..01ba9564 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.generalTests - Common.Scatter.tests + [ SpGeMM.generalTests ] |> testSequenced From 03e7e95a9b3f30b04235651256354071790b80a2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 10:22:48 +0300 Subject: [PATCH 045/143] add: init gather --- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 36 +++++++++-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 10 ++-- tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 60 +++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- 4 files changed, 98 insertions(+), 12 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 3f980651..9837b9c1 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -3,6 +3,34 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp module internal Gather = + let runInit positionMap (clContext: ClContext) workGroupSize = + + let gather = + <@ fun (ndRange: Range1D) valuesLength (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < valuesLength then + let position = (%positionMap) gid + + if position >= 0 && position < valuesLength then + outputArray.[gid] <- values.[position] @> + + let program = clContext.Compile gather + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + + let kernel = program.GetKernel() + + let ndRange = Range1D.CreateValid(outputArray.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + /// /// Creates a new array obtained from positions replaced with values from the given array at these positions (indices). /// @@ -19,13 +47,13 @@ module internal Gather = let gather = <@ fun (ndRange: Range1D) positionsLength valuesLength (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> - let i = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if i < positionsLength then - let position = positions.[i] + if gid < positionsLength then + let position = positions.[gid] if position >= 0 && position < valuesLength then - outputArray.[i] <- values.[position] @> + outputArray.[gid] <- values.[position] @> let program = clContext.Compile gather diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 5e77b9c7..bd6b2d23 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -27,6 +27,8 @@ module Expand = let gather = Gather.run clContext workGroupSize + let shiftedGather = Gather.runInit Map.inc clContext workGroupSize + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> @@ -130,7 +132,7 @@ module Expand = // another way to get offsets ??? let offsets = removeDuplicates processor segmentsPointers - segmentPrefixSum processor offsets.Length BPositions APositions offsets // TODO(offsets lengths in scan) + segmentPrefixSum processor offsets.Length BPositions APositions offsets offsets.Free processor @@ -206,7 +208,6 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd - //let reduce = Reduce.ByKey2D.sequential clContext workGroupSize opAdd let getUniqueBitmap = ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize @@ -240,12 +241,9 @@ module Expand = bitmap.Free processor positions.Free processor - let reducedColumns, reducedRows, reducedValues = + let reducedColumns, reducedRows, reducedValues = // by size variance TODO() reduce processor allocationMode uniqueKeysCount offsets columns rows values - // let reducedColumns, reducedRows, reducedValues = - // reduce processor DeviceOnly uniqueKeysCount columns rows values - offsets.Free processor reducedValues, reducedColumns, reducedRows diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs index f991d0a4..96ff6527 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -6,6 +6,7 @@ open Expecto open Microsoft.FSharp.Collections open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Quotes let context = Context.defaultContext.ClContext @@ -62,3 +63,62 @@ let tests = createTest (=) Gather.run createTest (=) Gather.run ] |> testList "Gather" + + +let makeTestInit isEqual testFun indexMap (array: ('a * 'a) []) = + if array.Length > 0 then + + let positions, values, target = + Array.mapi (fun index (first, second) -> indexMap index, first, second) array + |> Array.unzip3 + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clTarget = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, target) + + testFun processor clValues clTarget + + clValues.Free processor + + let actual = clTarget.ToHostAndFree processor + + check isEqual actual positions values target + +let createTestInit<'a> (isEqual: 'a -> 'a -> bool) testFun indexMapQ indexMap = + + let testFun = testFun indexMapQ context Utils.defaultWorkGroupSize + + makeTestInit isEqual testFun indexMap + |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" + +let initTests = + + let idTests = + [ createTestInit (=) Gather.runInit Map.id id + + if Utils.isFloat64Available context.ClDevice then + createTestInit Utils.floatIsEqual Gather.runInit Map.id id + + createTestInit Utils.float32IsEqual Gather.runInit Map.id id + createTestInit (=) Gather.runInit Map.id id + createTestInit (=) Gather.runInit Map.id id] + |> testList "id" + + let inc = ((+) 1) + + let incTests = + [ createTestInit (=) Gather.runInit Map.inc inc + + if Utils.isFloat64Available context.ClDevice then + createTestInit Utils.floatIsEqual Gather.runInit Map.inc inc + + createTestInit Utils.float32IsEqual Gather.runInit Map.inc inc + createTestInit (=) Gather.runInit Map.inc inc + createTestInit (=) Gather.runInit Map.inc inc] + |> testList "inc" + + testList "init" [idTests; incTests] + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 01ba9564..cd8e3659 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,8 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.generalTests - ] + [ // SpGeMM.generalTests + Common.Gather.initTests ] |> testSequenced From 6f02570415f1241c4a2731fd18baf27c956c923f Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 11:25:45 +0300 Subject: [PATCH 046/143] add: init scatter --- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 51 +++++++++- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 24 +---- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 93 ++++++++++++++----- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +- 4 files changed, 127 insertions(+), 46 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index ac680e35..d34393be 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -50,7 +50,7 @@ module internal Scatter = /// /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// let result = run clContext 32 processor positions values result + /// run clContext 32 processor positions values result /// ... /// > val result = [| 1,9; 3.7; 6.4; 7.3; 9.1 |] /// @@ -78,7 +78,7 @@ module internal Scatter = /// /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// let result = run clContext 32 processor positions values result + /// run clContext 32 processor positions values result /// ... /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] /// @@ -93,3 +93,50 @@ module internal Scatter = && (0 <= index && index < resultLength) @> <| clContext + /// + /// Writes elements from the array of values to the array at the positions indicated by the global id map. + /// + /// + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positionMap = fun x -> x + 1 + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] + /// let result = ... // create result + /// run positionMap clContext 32 processor positions values result + /// ... + /// > val result = [| 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] + /// + /// + /// Should be injective in order to avoid race conditions. + let init<'a> positionMap (clContext: ClContext) workGroupSize = + + let run = + <@ fun (ndRange: Range1D) (valuesLength: int) (values: ClArray<'a>) (result: ClArray<'a>) resultLength -> + + let gid = ndRange.GlobalID0 + + if gid < valuesLength then + let position = (%positionMap) gid + + // may be race condition + if 0 <= position && position < resultLength then + result.[position] <- values.[gid] @> + + let program = clContext.Compile(run) + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (result: ClArray<'a>) -> + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + let kernel = program.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange values.Length values result result.Length) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index bd6b2d23..ee9439bf 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -17,18 +17,14 @@ type Values<'a> = ClArray<'a> module Expand = let getSegmentPointers (clContext: ClContext) workGroupSize = - let create = - ClArray.init clContext workGroupSize Map.id + let subtract = ClArray.map2 clContext workGroupSize Map.subtraction - let createShifted = - ClArray.init clContext workGroupSize Map.inc + let idGather = Gather.runInit Map.id clContext workGroupSize - let subtract = ClArray.map2 clContext workGroupSize Map.subtraction + let incGather = Gather.runInit Map.inc clContext workGroupSize let gather = Gather.run clContext workGroupSize - let shiftedGather = Gather.runInit Map.inc clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> @@ -37,27 +33,17 @@ module Expand = // extract first rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers // (right matrix row pointers without last item) - let positions = // TODO(fuse) - create processor DeviceOnly positionsLength - let firstPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - gather processor positions rightMatrix.RowPointers firstPointers - - positions.Free processor + idGather processor rightMatrix.RowPointers firstPointers // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers // (right matrix row pointers without first item) - let shiftedPositions = // TODO(fuse) - createShifted processor DeviceOnly positionsLength - let lastPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - gather processor shiftedPositions rightMatrix.RowPointers lastPointers - - shiftedPositions.Free processor + incGather processor rightMatrix.RowPointers lastPointers // subtract let rightMatrixRowsLengths = diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 221088ff..7ffc2d34 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -5,7 +5,7 @@ open Expecto.Logging open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context -open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions @@ -13,15 +13,13 @@ let logger = Log.create "Scatter.Tests" let context = defaultContext.ClContext -let config = - { Tests.Utils.defaultConfig with - endSize = 1000000 } +let config = { Utils.defaultConfig with endSize = 10000 } -let wgSize = Tests.Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize let q = defaultContext.Queue -let makeTest hostScatter scatter (array: (int * 'a) []) (result: 'a []) = +let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then let positions, values = Array.unzip array @@ -30,7 +28,7 @@ let makeTest hostScatter scatter (array: (int * 'a) []) (result: 'a []) = |> hostScatter positions values let actual = - use clPositions = context.CreateClArray positions + let clPositions = context.CreateClArray positions use clValues = context.CreateClArray values use clResult = context.CreateClArray result @@ -38,32 +36,81 @@ let makeTest hostScatter scatter (array: (int * 'a) []) (result: 'a []) = clResult.ToHostAndFree q - $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" - |> Tests.Utils.compareArrays (=) actual expected + $"Arrays should be equal." + |> Utils.compareArrays (=) actual expected -let testFixturesLast<'a when 'a: equality> hostScatter = - Scatter.scatterLastOccurrence<'a> context wgSize - |> makeTest hostScatter - |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" +let testFixturesLast<'a when 'a: equality> = + Scatter.scatterLastOccurrence context wgSize + |> makeTest<'a> HostPrimitives.scatterLastOccurrence + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" -let testFixturesFirst<'a when 'a: equality> hostScatter = - Scatter.scatterFirstOccurrence<'a> context wgSize - |> makeTest hostScatter - |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" +let testFixturesFirst<'a when 'a: equality> = + Scatter.scatterFirstOccurrence context wgSize + |> makeTest<'a> HostPrimitives.scatterFirstOccurrence + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let tests = q.Error.Add(fun e -> failwithf $"%A{e}") let last = - [ testFixturesLast HostPrimitives.scatterLastOccurrence - testFixturesLast HostPrimitives.scatterLastOccurrence - testFixturesLast HostPrimitives.scatterLastOccurrence ] + [ testFixturesLast + testFixturesLast + testFixturesLast ] |> testList "Last Occurrence" let first = - [ testFixturesFirst HostPrimitives.scatterFirstOccurrence - testFixturesFirst HostPrimitives.scatterFirstOccurrence - testFixturesFirst HostPrimitives.scatterFirstOccurrence ] + [ testFixturesFirst + testFixturesFirst + testFixturesFirst ] |> testList "First Occurrence" testList "Scatter tests" [first; last] + +let makeTestInit<'a when 'a: equality> positionsMap scatter (values: 'a []) (result: 'a []) = + if values.Length > 0 then + + let positionsAndValues = + Array.mapi (fun index value -> positionsMap index, value) values + + let expected = + Array.init result.Length (fun index -> + match Array.tryFind (fst >> ((=) index)) positionsAndValues with + | Some (_, value) -> value + | None -> result.[index]) + + let actual = + let values = Array.map snd positionsAndValues + + use clValues = context.CreateClArray values + use clResult = context.CreateClArray result + + scatter q clValues clResult + + clResult.ToHostAndFree q + + $"Arrays should be equal." + |> Utils.compareArrays (=) actual expected + +let createInitTest<'a when 'a: equality> indexMap indexMapQ = + Scatter.init<'a> indexMapQ context Utils.defaultWorkGroupSize + |> makeTestInit<'a> indexMap + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let initTests = + q.Error.Add(fun e -> failwithf $"%A{e}") + + let idTest = + [ createInitTest id Map.id + createInitTest id Map.id + createInitTest id Map.id ] + |> testList "id" + + let inc = ((+) 1) + + let incTest = + [ createInitTest inc Map.inc + createInitTest inc Map.inc + createInitTest inc Map.inc ] + |> testList "increment" + + testList "Scatter init tests" [idTest; incTest] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index cd8e3659..f274004f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,9 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.generalTests - Common.Gather.initTests ] + [ // SpGeMM.getSegmentsTests + // Common.Gather.initTests + Common.Scatter.initTests ] |> testSequenced From 29c564ce443302b124fff15ca188f18528194276 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 13:23:39 +0300 Subject: [PATCH 047/143] add: scatter init value --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 4 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 122 +++++++++++------- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 4 +- .../Matrix/CSRMatrix/SpGEMMMasked.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 4 +- .../Vector/DenseVector/DenseVector.fs | 4 +- .../Vector/SparseVector/Common.fs | 4 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 78 +++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 10 files changed, 132 insertions(+), 96 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index b8c25e8b..d39d5ec4 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -184,7 +184,7 @@ module ClArray = let removeDuplications (clContext: ClContext) workGroupSize = let scatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize @@ -349,7 +349,7 @@ module ClArray = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize let scatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (array: ClArray<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index d34393be..7a73fd2c 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -3,6 +3,17 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp module internal Scatter = + let firstOccurencePredicate () = + <@ fun gid _ (positions: ClArray) -> + // first occurrence condition + (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> + + let lastOccurrencePredicate () = + <@ fun gid positionsLength (positions: ClArray) -> + // last occurrence condition + (gid = positionsLength - 1 || positions.[gid] <> positions.[gid + 1]) @> + + let private general<'a> predicate (clContext: ClContext) workGroupSize = let run = @@ -12,9 +23,12 @@ module internal Scatter = if gid < positionsLength then // positions lengths == values length - let predicateResult = (%predicate) gid positionsLength positions resultLength + let predicateResult = (%predicate) gid positionsLength positions + let position = positions.[gid] + + if predicateResult + && 0 <= position && position < resultLength then - if predicateResult then result.[positions.[gid]] <- values.[gid] @> let program = clContext.Compile(run) @@ -55,14 +69,9 @@ module internal Scatter = /// > val result = [| 1,9; 3.7; 6.4; 7.3; 9.1 |] /// /// - let scatterFirstOccurrence clContext = + let firstOccurrence clContext = general - <| <@ fun gid _ (positions: ClArray) resultLength -> - let currentKey = positions.[gid] - // first occurrence condition - (gid = 0 || positions.[gid - 1] <> positions.[gid]) - // result position in valid range - && (0 <= currentKey && currentKey < resultLength) @> + <| firstOccurencePredicate () <| clContext /// @@ -71,7 +80,7 @@ module internal Scatter = /// /// /// Every element of the positions array must not be less than the previous one. - /// If there are several elements with the same indices, the last one of them will be at the common index. + /// If there are several elements with the same indices, the LAST one of them will be at the common index. /// If index is out of bounds, the value will be ignored. /// /// @@ -83,60 +92,85 @@ module internal Scatter = /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] /// /// - let scatterLastOccurrence clContext = + let lastOccurrence clContext = general - <| <@ fun gid positionsLength (positions: ClArray) resultLength -> - let index = positions.[gid] - // last occurrence condition - (gid = positionsLength - 1 || index <> positions.[gid + 1]) - // result position in valid range - && (0 <= index && index < resultLength) @> + <| lastOccurrencePredicate () <| clContext - /// - /// Writes elements from the array of values to the array at the positions indicated by the global id map. - /// - /// - /// If index is out of bounds, the value will be ignored. - /// - /// - /// - /// let positionMap = fun x -> x + 1 - /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// let result = ... // create result - /// run positionMap clContext 32 processor positions values result - /// ... - /// > val result = [| 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// - /// - /// Should be injective in order to avoid race conditions. - let init<'a> positionMap (clContext: ClContext) workGroupSize = + let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = let run = - <@ fun (ndRange: Range1D) (valuesLength: int) (values: ClArray<'a>) (result: ClArray<'a>) resultLength -> + <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (result: ClArray<'a>) (resultLength: int) -> let gid = ndRange.GlobalID0 - if gid < valuesLength then - let position = (%positionMap) gid + if gid < positionsLength then + // positions lengths == values length + let predicateResult = (%predicate) gid positionsLength positions + + let position = positions.[gid] + + if predicateResult + && 0 <= position && position < resultLength then - // may be race condition - if 0 <= position && position < resultLength then - result.[position] <- values.[gid] @> + result.[positions.[gid]] <- (%valueMap) gid @> let program = clContext.Compile(run) - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (result: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (positions: ClArray) (result: ClArray<'a>) -> + + let positionsLength = positions.Length let ndRange = - Range1D.CreateValid(values.Length, workGroupSize) + Range1D.CreateValid(positionsLength, workGroupSize) let kernel = program.GetKernel() processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange values.Length values result result.Length) + (fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + /// + /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array + /// should be a values obtained by applying the mapping to the global id. + /// + /// + /// Every element of the positions array must not be less than the previous one. + /// If there are several elements with the same indices, the FIRST one of them will be at the common index. + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] + /// let valueMap = id + /// run clContext 32 processor positions values result + /// ... + /// > val result = [| 0; 2; 5; 6; 8 |] + /// + /// + /// Maps global id to a value + let initFirsOccurrence<'a> valueMap = generalInit<'a> <| firstOccurencePredicate () <| valueMap + + /// + /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array + /// should be a values obtained by applying the mapping to the global id. + /// + /// + /// Every element of the positions array must not be less than the previous one. + /// If there are several elements with the same indices, the LAST one of them will be at the common index. + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] + /// let valueMap = id + /// run clContext 32 processor positions values result + /// ... + /// > val result = [| 1; 4; 5; 7; 8 |] + /// + /// + /// Maps global id to a value + let initLastOccurrence<'a> valueMap = generalInit<'a> <| lastOccurrencePredicate () <| valueMap diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index ee9439bf..c56ffc01 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -69,7 +69,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id - let scatter = Scatter.scatterLastOccurrence clContext workGroupSize + let scatter = Scatter.lastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -202,7 +202,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - let scatter = Scatter.scatterFirstOccurrence clContext workGroupSize + let scatter = Scatter.firstOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs index 52297150..c4c1b4d7 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs @@ -151,8 +151,8 @@ module internal SpGEMMMasked = let calculate = calculate context workGroupSize opAdd opMul - let scatter = Scatter.scatterLastOccurrence context workGroupSize - let scatterData = Scatter.scatterLastOccurrence context workGroupSize + let scatter = Scatter.lastOccurrence context workGroupSize + let scatterData = Scatter.lastOccurrence context workGroupSize let scanInplace = PrefixSum.standardExcludeInplace context workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index 3fab5f9c..ea26fd7f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -11,10 +11,10 @@ module Common = let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = let indicesScatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let valuesScatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let sum = PrefixSum.standardExcludeInplace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index af6ceff2..3d37a595 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -90,10 +90,10 @@ module DenseVector = let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize = let scatterValues = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let scatterIndices = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let getBitmap = ClArray.map clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs index 2f781406..d44c5a4b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs @@ -13,10 +13,10 @@ module internal Common = PrefixSum.standardExcludeInplace clContext workGroupSize let valuesScatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let indicesScatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index d6c2dc96..1e36d108 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -35,7 +35,7 @@ module Vector = let ofList (clContext: ClContext) workGroupSize = let scatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 7ffc2d34..bd2629cb 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -13,7 +13,7 @@ let logger = Log.create "Scatter.Tests" let context = defaultContext.ClContext -let config = { Utils.defaultConfig with endSize = 10000 } +let config = Utils.defaultConfig let wgSize = Utils.defaultWorkGroupSize @@ -21,7 +21,9 @@ let q = defaultContext.Queue let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then - let positions, values = Array.unzip array + let positions, values = + Array.sortBy fst array + |> Array.unzip let expected = Array.copy result @@ -29,23 +31,25 @@ let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (r let actual = let clPositions = context.CreateClArray positions - use clValues = context.CreateClArray values - use clResult = context.CreateClArray result + let clValues = context.CreateClArray values + let clResult = context.CreateClArray result scatter q clPositions clValues clResult + clValues.Free q + clValues.Free q clResult.ToHostAndFree q $"Arrays should be equal." |> Utils.compareArrays (=) actual expected let testFixturesLast<'a when 'a: equality> = - Scatter.scatterLastOccurrence context wgSize + Scatter.lastOccurrence context wgSize |> makeTest<'a> HostPrimitives.scatterLastOccurrence |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let testFixturesFirst<'a when 'a: equality> = - Scatter.scatterFirstOccurrence context wgSize + Scatter.firstOccurrence context wgSize |> makeTest<'a> HostPrimitives.scatterFirstOccurrence |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" @@ -64,53 +68,51 @@ let tests = testFixturesFirst ] |> testList "First Occurrence" - testList "Scatter tests" [first; last] + testList "ones occurrence" [first; last] -let makeTestInit<'a when 'a: equality> positionsMap scatter (values: 'a []) (result: 'a []) = - if values.Length > 0 then +let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: int []) (result: 'a []) = + if positions.Length > 0 then - let positionsAndValues = - Array.mapi (fun index value -> positionsMap index, value) values + let values = Array.init positions.Length valueMap + let positions = Array.sort positions let expected = - Array.init result.Length (fun index -> - match Array.tryFind (fst >> ((=) index)) positionsAndValues with - | Some (_, value) -> value - | None -> result.[index]) - - let actual = - let values = Array.map snd positionsAndValues + Array.copy result + |> hostScatter positions values - use clValues = context.CreateClArray values - use clResult = context.CreateClArray result + let clPositions = context.CreateClArray positions + let clResult = context.CreateClArray result - scatter q clValues clResult + scatter q clPositions clResult - clResult.ToHostAndFree q + let actual = clResult.ToHostAndFree q + clPositions.Free q + clResult.Free q $"Arrays should be equal." |> Utils.compareArrays (=) actual expected -let createInitTest<'a when 'a: equality> indexMap indexMapQ = - Scatter.init<'a> indexMapQ context Utils.defaultWorkGroupSize - |> makeTestInit<'a> indexMap - |> testPropertyWithConfig config $"test on {typeof<'a>}" +let createInitTest clScatter hostScatter name valuesMap valuesMapQ = + let scatter = clScatter valuesMapQ context Utils.defaultWorkGroupSize + + makeTestInit<'a> hostScatter valuesMap scatter + |> testPropertyWithConfig config name let initTests = q.Error.Add(fun e -> failwithf $"%A{e}") - let idTest = - [ createInitTest id Map.id - createInitTest id Map.id - createInitTest id Map.id ] - |> testList "id" - let inc = ((+) 1) - let incTest = - [ createInitTest inc Map.inc - createInitTest inc Map.inc - createInitTest inc Map.inc ] - |> testList "increment" + let firstOccurrence = + [ createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "id" id Map.id + createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "inc" inc Map.inc ] + |> testList "first occurrence" + + let lastOccurrence = + [ createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "id" id Map.id + createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "inc" inc Map.inc ] + |> testList "last occurrence" + + testList "init" [ firstOccurrence; lastOccurrence ] - testList "Scatter init tests" [idTest; incTest] +let allTests = testList "Scatter" [ tests; initTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f274004f..3b1194a8 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -96,7 +96,7 @@ let allTests = "All tests" [ // SpGeMM.getSegmentsTests // Common.Gather.initTests - Common.Scatter.initTests ] + Common.Scatter.allTests ] |> testSequenced From 972b3924c99d55bf7e5914edc19b19d3a23f380d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 13:35:16 +0300 Subject: [PATCH 048/143] refactor: init in spgemm --- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 4 ++-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 21 ++++++------------- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +++-- 3 files changed, 11 insertions(+), 19 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 7a73fd2c..5109a7b1 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -3,12 +3,12 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp module internal Scatter = - let firstOccurencePredicate () = + let private firstOccurencePredicate () = <@ fun gid _ (positions: ClArray) -> // first occurrence condition (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> - let lastOccurrencePredicate () = + let private lastOccurrencePredicate () = <@ fun gid positionsLength (positions: ClArray) -> // last occurrence condition (gid = positionsLength - 1 || positions.[gid] <> positions.[gid + 1]) @> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index c56ffc01..d12c3bcb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -69,6 +69,8 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id + let idScatter = Scatter.initLastOccurrence Map.id clContext workGroupSize + let scatter = Scatter.lastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -94,18 +96,14 @@ module Expand = fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute A positions - let sequence = init processor DeviceOnly segmentsPointers.Length // TODO(fuse) - let APositions = zeroCreate processor DeviceOnly lengths - scatter processor segmentsPointers sequence APositions - - sequence.Free processor + idScatter processor segmentsPointers APositions (maxPrefixSum processor APositions 0).Free processor // Compute B positions - let BPositions = create processor DeviceOnly lengths 1 // TODO(fuse) + let BPositions = create processor DeviceOnly lengths 1 let requiredBPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length @@ -200,9 +198,7 @@ module Expand = let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - - let scatter = Scatter.firstOccurrence clContext workGroupSize + let idScatter = Scatter.initFirsOccurrence Map.id clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> @@ -214,18 +210,13 @@ module Expand = printfn $"key bitmap after prefix sum: %A{bitmap.ToHost processor}" - let positions = init processor DeviceOnly bitmap.Length - - printfn $"positions: %A{positions.ToHost processor}" - let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) - scatter processor bitmap positions offsets + idScatter processor bitmap offsets printfn $"offsets: %A{offsets.ToHost processor}" bitmap.Free processor - positions.Free processor let reducedColumns, reducedRows, reducedValues = // by size variance TODO() reduce processor allocationMode uniqueKeysCount offsets columns rows values diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 3b1194a8..4976895a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,9 +94,10 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.getSegmentsTests + [ SpGeMM.generalTests // Common.Gather.initTests - Common.Scatter.allTests ] + //Common.Scatter.allTests ] + ] |> testSequenced From 73d755f7f5e202ef90919c94bd5f1e642f2be16e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 14:31:12 +0300 Subject: [PATCH 049/143] refactor: deforestation in ClArray.choose --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 67 ++++++++++++------- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 2 - tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- 3 files changed, 43 insertions(+), 29 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index d39d5ec4..1983899a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -319,9 +319,6 @@ module ClArray = let result = map processor allocationMode firstBitmap secondBitmap - printfn $"first bitmap: %A{firstBitmap.ToHost processor}" - printfn $"second bitmap: %A{secondBitmap.ToHost processor}" - firstBitmap.Free processor secondBitmap.Free processor @@ -333,42 +330,60 @@ module ClArray = let getUniqueBitmap2LastOccurrence clContext = getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext + let private assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) = + + let assign = + <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) resultLength -> + + let gid = ndRange.GlobalID0 + + if gid < length then + let position = positions.[gid] + let value = values.[gid] + + // seems like scatter (option scatter) ??? + if 0 <= position && position < resultLength then + match (%op) value with + | Some value -> + result.[position] <- value + | None -> () @> + + let kernel = clContext.Compile assign + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange values.Length values positions result result.Length) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = let getBitmap = map<'a, int> clContext workGroupSize <| Map.chooseBitmap predicate - let getOptionValues = - map<'a, 'b option> clContext workGroupSize predicate - - let getValues = - map<'b option, 'b> clContext workGroupSize - <| Map.optionToValueOrZero Unchecked.defaultof<'b> + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - let prefixSum = - PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize - - let scatter = - Scatter.lastOccurrence clContext workGroupSize + let assignValues = assignOption clContext workGroupSize predicate - fun (processor: MailboxProcessor<_>) allocationMode (array: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> - let positions = getBitmap processor DeviceOnly array + let positions = getBitmap processor DeviceOnly sourceValues let resultLength = - (prefixSum processor positions 0) + (prefixSum processor positions) .ToHostAndFree(processor) - let optionValues = - getOptionValues processor DeviceOnly array - - let values = - getValues processor DeviceOnly optionValues - - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatter processor positions values result + assignValues processor sourceValues positions result result diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index d12c3bcb..9e8518be 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -67,8 +67,6 @@ module Expand = let expand (clContext: ClContext) workGroupSize opMul = - let init = ClArray.init clContext workGroupSize Map.id - let idScatter = Scatter.initLastOccurrence Map.id clContext workGroupSize let scatter = Scatter.lastOccurrence clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 4976895a..c8950c2e 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,9 +94,10 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.generalTests + [ // SpGeMM.generalTests // Common.Gather.initTests //Common.Scatter.allTests ] + Common.ClArray.Choose.tests ] |> testSequenced From f34e590482333fa46a3a16b5e0b7242e7428a049 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 18:20:17 +0300 Subject: [PATCH 050/143] add: ClArray.choose2 --- .../BenchmarksBFS.fs | 2 +- .../BenchmarksEWiseAdd.fs | 6 +- .../VectorEWiseAddGen.fs | 16 ++--- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 64 +++++++++++++++++++ .../Quotes/Arithmetic.fs | 42 +++++++++--- src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 6 ++ tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs | 2 +- .../Common/ClArray/Choose.fs | 47 +++++++++++++- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 2 +- tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 8 +-- tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 18 +++--- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 14 ++-- 13 files changed, 182 insertions(+), 49 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index c9e2d233..95d25fc9 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs @@ -103,7 +103,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : type BFSBenchmarksWithoutDataTransfer() = inherit BFSBenchmarks, int>( - (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul wgSize), + (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption wgSize), int, (fun _ -> Utils.nextInt (System.Random())), Matrix.ToBackendCSR) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs index a298634f..18aa2cdd 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs @@ -195,7 +195,7 @@ module M = type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCOO @@ -207,7 +207,7 @@ type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = type EWiseAddBenchmarks4Float32COOWithDataTransfer() = inherit EWiseAddBenchmarksWithDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCOO, @@ -234,7 +234,7 @@ type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCSR diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs index 378a2036..97d75077 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs @@ -159,13 +159,13 @@ type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( type VectorEWiseBenchmarks4FloatSparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// General @@ -173,13 +173,13 @@ type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = type VectorEWiseGeneralBenchmarks4FloatSparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// With data transfer @@ -187,13 +187,13 @@ type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = type VectorEWiseBenchmarks4FloatSparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// General with data transfer @@ -201,11 +201,11 @@ type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = type VectorEWiseGeneralBenchmarks4FloatSparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseGeneralBenchmarks4Int32SparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 1983899a..e2dbb88f 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -352,6 +352,8 @@ module ClArray = fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> + if values.Length <> positions.Length then failwith "lengths must be the same" + let ndRange = Range1D.CreateValid(values.Length, workGroupSize) @@ -387,3 +389,65 @@ module ClArray = result + let private assignOption2 (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c option>) = + + let assign = + <@ fun (ndRange: Range1D) length (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) resultLength -> + + let gid = ndRange.GlobalID0 + + if gid < length then + let position = positions.[gid] + + let leftValue = firstValues.[gid] + let rightValue = secondValues.[gid] + + // seems like scatter2 (option scatter2) ??? + if 0 <= position && position < resultLength then + match (%op) leftValue rightValue with + | Some value -> + result.[position] <- value + | None -> () @> + + let kernel = clContext.Compile assign + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) -> + + if firstValues.Length <> secondValues.Length + || secondValues.Length <> positions.Length then + failwith "lengths must be the same" + + let ndRange = + Range1D.CreateValid(firstValues.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange firstValues.Length firstValues secondValues positions result result.Length) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let choose2 (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let getBitmap = + map2<'a, 'b, int> clContext workGroupSize + <| Map.chooseBitmap2 predicate + + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + + let assignValues = assignOption2 clContext workGroupSize predicate + + fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> + + let positions = getBitmap processor DeviceOnly firstValues secondValues + + let resultLength = + (prefixSum processor positions) + .ToHostAndFree(processor) + + let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + assignValues processor firstValues secondValues positions result + + result diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 8aa72db5..32e3d5b9 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -72,10 +72,10 @@ module ArithmeticOperations = let inline addRightConst zero constant = mkUnaryOp zero <@ fun x -> x + constant @> - let intSum = mkNumericSum 0 - let byteSum = mkNumericSum 0uy - let floatSum = mkNumericSum 0.0 - let float32Sum = mkNumericSum 0f + let intSumOption = mkNumericSum 0 + let byteSumOption = mkNumericSum 0uy + let floatSumOption = mkNumericSum 0.0 + let float32SumOption = mkNumericSum 0f let boolSumAtLeastOne = <@ fun (_: AtLeastOne) -> Some true @> @@ -85,7 +85,7 @@ module ArithmeticOperations = let floatSumAtLeastOne = mkNumericSumAtLeastOne 0.0 let float32SumAtLeastOne = mkNumericSumAtLeastOne 0f - let boolMul = + let boolMulOption = <@ fun (x: bool option) (y: bool option) -> let mutable res = false @@ -101,10 +101,10 @@ module ArithmeticOperations = let inline mulRightConst zero constant = mkUnaryOp zero <@ fun x -> x * constant @> - let intMul = mkNumericMul 0 - let byteMul = mkNumericMul 0uy - let floatMul = mkNumericMul 0.0 - let float32Mul = mkNumericMul 0f + let intMulOption = mkNumericMul 0 + let byteMulOption = mkNumericMul 0uy + let floatMulOption = mkNumericMul 0.0 + let float32MulOption = mkNumericMul 0f let boolMulAtLeastOne = <@ fun (values: AtLeastOne) -> @@ -121,8 +121,30 @@ module ArithmeticOperations = let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f - let notQ = + let notOption = <@ fun x -> match x with | Some true -> None | _ -> Some true @> + + let inline private binOpQ zero op = + <@ fun (left: 'a) (right: 'a) -> + let result = (%op) left right + + if result = zero then None else Some result @> + + let inline private binOp zero op = + fun left right -> + let result = op left right + + if result = zero then None else Some result + + let inline createPair zero op opQ = binOpQ zero opQ, binOp zero op + + let intAdd = createPair 0 (+) <@ (+) @> + + let boolAdd = createPair false (||) <@ (||) @> + + let floatAdd = createPair 0.0 (+) <@ (+) @> + + let float32Add = createPair 0.0f (+) <@ (+) @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index a697d5e0..f0750dac 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -22,6 +22,12 @@ module Map = | Some _ -> 1 | None -> 0 @> + let chooseBitmap2<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c option>) = + <@ fun (leftItem: 'a) (rightItem: 'b) -> + match (%map) leftItem rightItem with + | Some _ -> 1 + | None -> 0 @> + let inc = <@ fun item -> item + 1 @> let subtraction = <@ fun first second -> first - second @> diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index 1590f142..65bfb8f9 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs @@ -22,7 +22,7 @@ let testFixtures (testContext: TestContext) = sprintf "Test on %A" testContext.ClContext let bfs = - Algorithms.BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul workGroupSize + Algorithms.BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption workGroupSize testPropertyWithConfig config testName <| fun (matrix: int [,]) -> diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index 628ff51a..a17b35de 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -7,11 +7,16 @@ open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let workGroupSize = Utils.defaultWorkGroupSize let config = Utils.defaultConfig +let context = Context.defaultContext.ClContext + +let processor = defaultContext.Queue + let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = if array.Length > 0 then let context = testContext.ClContext @@ -39,7 +44,7 @@ let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = ClArray.choose context workGroupSize mapFunQ makeTest<'a, 'b> testContext choose mapFun isEqual - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>} -> %A{typeof<'b>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>} -> %A{typeof<'b>}" let testFixtures testContext = let device = testContext.ClContext.ClDevice @@ -54,4 +59,42 @@ let testFixtures testContext = createTest testContext id Map.id Utils.float32IsEqual ] let tests = - TestCases.gpuTests "ClArray.choose id tests" testFixtures + TestCases.gpuTests "choose id" testFixtures + +let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = + if firstArray.Length > 0 + && secondArray.Length > 0 then + + let expected = + Array.map2 opMap firstArray secondArray + |> Array.choose id + + let clFirstArray = context.CreateClArray firstArray + let clSecondArray = context.CreateClArray secondArray + + let (clActual: ClArray<_>) = testFun processor HostInterop clFirstArray clSecondArray + + let actual = clActual.ToHostAndFree processor + clFirstArray.Free processor + clSecondArray.Free processor + + "Results must be the same" + |> Utils.compareArrays isEqual actual expected + +let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = + let testFun = testFun context Utils.defaultWorkGroupSize opMapQ + + makeTest2 isEqual opMap testFun + |> testPropertyWithConfig { config with maxTest = 1000 } $"test on %A{typeof<'a>}" + +let tests2 = + [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 + + if Utils.isFloat64Available context.ClDevice then + createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 + + createTest2 (=) ArithmeticOperations.float32Add ClArray.choose2 + createTest2 (=) ArithmeticOperations.boolAdd ClArray.choose2 ] + |> testList "choose2 add" + +let allTests = testList "Choose" [ tests; tests2 ] diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index 229271b7..b89042a4 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -108,7 +108,7 @@ 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) ] + createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] let notTests = operationGPUTests "Backend.Matrix.map not tests" testFixturesMapNot diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index eeb1546f..ae5e0e22 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -113,13 +113,13 @@ let testFixturesMap2Add case = q.Error.Add(fun e -> failwithf "%A" e) creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSum Matrix.map2 + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumOption Matrix.map2 if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSum Matrix.map2 + creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSumOption Matrix.map2 - creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32Sum Matrix.map2 - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSum Matrix.map2 ] + creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32SumOption Matrix.map2 + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumOption Matrix.map2 ] let addTests = operationGPUTests "Backend.Matrix.map2 add tests" testFixturesMap2Add diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index c8950c2e..7f89df5a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -96,9 +96,7 @@ let allTests = "All tests" [ // SpGeMM.generalTests // Common.Gather.initTests - //Common.Scatter.allTests ] - Common.ClArray.Choose.tests - ] + Common.ClArray.Choose.tests2 ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index 33f4a693..0ff08e3f 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -101,14 +101,14 @@ let createTest case isEqual (zero: 'a) plus plusQ map2 = let addTestFixtures case = let context = case.TestContext.ClContext - [ createTest case (=) 0 (+) ArithmeticOperations.intSum Vector.map2 + [ createTest case (=) 0 (+) ArithmeticOperations.intSumOption Vector.map2 if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSum Vector.map2 + createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumOption Vector.map2 - createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32Sum Vector.map2 + createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumOption Vector.map2 createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 - createTest case (=) 0uy (+) ArithmeticOperations.byteSum Vector.map2 ] + createTest case (=) 0uy (+) ArithmeticOperations.byteSumOption Vector.map2 ] let addTests = operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures @@ -116,14 +116,14 @@ let addTests = let mulTestFixtures case = let context = case.TestContext.ClContext - [ createTest case (=) 0 (*) ArithmeticOperations.intMul Vector.map2 + [ createTest case (=) 0 (*) ArithmeticOperations.intMulOption Vector.map2 if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMul Vector.map2 + createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMulOption Vector.map2 - createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32Mul Vector.map2 - createTest case (=) false (&&) ArithmeticOperations.boolMul Vector.map2 - createTest case (=) 0uy (*) ArithmeticOperations.byteMul Vector.map2 ] + createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32MulOption Vector.map2 + createTest case (=) false (&&) ArithmeticOperations.boolMulOption Vector.map2 + createTest case (=) 0uy (*) ArithmeticOperations.byteMulOption Vector.map2 ] let mulTests = operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 1ce37add..2f7c5149 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -105,8 +105,8 @@ let testFixturesSpMV (testContext: TestContext) = let q = testContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMul - createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSum ArithmeticOperations.intMul + createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMulOption + createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption if Utils.isFloat64Available context.ClDevice then createTest @@ -115,8 +115,8 @@ let testFixturesSpMV (testContext: TestContext) = Utils.floatIsEqual (+) (*) - ArithmeticOperations.floatSum - ArithmeticOperations.floatMul + ArithmeticOperations.floatSumOption + ArithmeticOperations.floatMulOption createTest testContext @@ -124,10 +124,10 @@ let testFixturesSpMV (testContext: TestContext) = Utils.float32IsEqual (+) (*) - ArithmeticOperations.float32Sum - ArithmeticOperations.float32Mul + ArithmeticOperations.float32SumOption + ArithmeticOperations.float32MulOption - createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSum ArithmeticOperations.byteMul ] + createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSumOption ArithmeticOperations.byteMulOption ] let tests = gpuTests "Backend.Vector.SpMV tests" testFixturesSpMV From 751ee68fea5997661a6f94fc29ddd40b19d4f551 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 22:41:39 +0300 Subject: [PATCH 051/143] add: filter after multiplication --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 2 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 76 ++++++++++++++----- .../Quotes/Arithmetic.fs | 10 +++ .../Common/ClArray/Choose.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 5 +- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 49 ++++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 7 +- 7 files changed, 104 insertions(+), 47 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index e2dbb88f..0d4cf1b2 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -389,7 +389,7 @@ module ClArray = result - let private assignOption2 (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c option>) = + let assignOption2 (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c option>) = let assign = <@ fun (ndRange: Range1D) length (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) resultLength -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 9e8518be..d88a4712 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -9,6 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell +open FSharp.Quotations type Indices = ClArray @@ -65,7 +66,40 @@ module Expand = length, segmentsLengths - let expand (clContext: ClContext) workGroupSize opMul = + let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let getBitmap = + ClArray.map2<'a, 'b, int> clContext workGroupSize + <| Map.chooseBitmap2 predicate + + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + + let assignValues = ClArray.assignOption2 clContext workGroupSize predicate + + let scatter = Scatter.lastOccurrence clContext workGroupSize // TODO(last ?) + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: Indices) (rows: Indices) -> + + let positions = getBitmap processor DeviceOnly firstValues secondValues + + let resultLength = + (prefixSum processor positions) + .ToHostAndFree(processor) + + let resultColumns = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions columns resultColumns + + let resultRows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions rows resultRows + + let resultValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + assignValues processor firstValues secondValues positions resultValues + + resultValues, resultColumns, resultRows + + let expand (clContext: ClContext) workGroupSize = let idScatter = Scatter.initLastOccurrence Map.id clContext workGroupSize @@ -89,8 +123,6 @@ module Expand = let BGather = Gather.run clContext workGroupSize - let mul = ClArray.map2 clContext workGroupSize opMul - fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute A positions @@ -150,13 +182,8 @@ module Expand = BPositions.Free processor - // multiply values TODO(filter values) - let values = mul processor DeviceOnly AValues BValues - - AValues.Free processor - BValues.Free processor - - values, columns, rows + // left, right matrix values, columns and rows indices + AValues, BValues, columns, rows let sortByColumnsAndRows (clContext: ClContext) workGroupSize = @@ -227,7 +254,9 @@ module Expand = let getSegmentPointers = getSegmentPointers clContext workGroupSize - let expand = expand clContext workGroupSize opMul + let expand = expand clContext workGroupSize + + let multiply = multiply clContext workGroupSize opMul let sort = sortByColumnsAndRows clContext workGroupSize @@ -237,24 +266,37 @@ module Expand = let length, segmentPointers = getSegmentPointers processor leftMatrix rightMatrix - let values, columns, rows = + // expand + let leftMatrixValues, rightMatrixValues, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix - printfn $"expanded values: %A{values.ToHost processor}" + printfn $"left matrix values: %A{leftMatrixValues.ToHost processor}" + printfn $"right matrix values: %A{rightMatrixValues.ToHost processor}" printfn $"expanded columns: %A{columns.ToHost processor}" printfn $"expanded rows: %A{rows.ToHost processor}" + // multiply + let resultValues, resultColumns, resultRows = + multiply processor leftMatrixValues rightMatrixValues columns rows + + leftMatrixValues.Free processor + rightMatrixValues.Free processor + columns.Free processor + rows.Free processor + + // sort let sortedValues, sortedColumns, sortedRows = - sort processor values columns rows + sort processor resultValues resultColumns resultRows printfn $"sorted values: %A{sortedValues.ToHost processor}" printfn $"sorted columns: %A{sortedColumns.ToHost processor}" printfn $"sorted rows: %A{sortedRows.ToHost processor}" - values.Free processor - columns.Free processor - rows.Free processor + resultValues.Free processor + resultColumns.Free processor + resultRows.Free processor + // addition let reducedValues, reducedColumns, reducedRows = reduce processor allocationMode sortedValues sortedColumns sortedRows diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 32e3d5b9..bd2d159a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -141,6 +141,7 @@ module ArithmeticOperations = let inline createPair zero op opQ = binOpQ zero opQ, binOp zero op + // addition let intAdd = createPair 0 (+) <@ (+) @> let boolAdd = createPair false (||) <@ (||) @> @@ -148,3 +149,12 @@ module ArithmeticOperations = let floatAdd = createPair 0.0 (+) <@ (+) @> let float32Add = createPair 0.0f (+) <@ (+) @> + + // multiplication + let intMul = createPair 0 (*) <@ (*) @> + + let boolMul = createPair false (&&) <@ (&&) @> + + let floatMul = createPair 0.0 (*) <@ (*) @> + + let float32Mul = createPair 0.0f (*) <@ (*) @> diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index a17b35de..1863b191 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -85,7 +85,7 @@ let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = let testFun = testFun context Utils.defaultWorkGroupSize opMapQ makeTest2 isEqual opMap testFun - |> testPropertyWithConfig { config with maxTest = 1000 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let tests2 = [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c941d7ec..0fe23f11 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -229,7 +229,7 @@ module HostPrimitives = result - let array2DMultiplication mul add leftArray rightArray = + let array2DMultiplication zero mul add leftArray rightArray = if Array2D.length2 leftArray <> Array2D.length1 rightArray then failwith "Incompatible matrices" @@ -239,7 +239,8 @@ module HostPrimitives = <| fun i j -> (leftArray.[i, *], rightArray.[*, j]) ||> Array.map2 mul - |> Array.reduce add + |> Array.choose id + |> Array.fold add zero module Context = type TestContext = diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 8102d533..25b4913d 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -2,6 +2,7 @@ module GraphBLAS.FSharp.Tests.Matrix.SpGeMM open Expecto open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Test open Microsoft.FSharp.Collections open GraphBLAS.FSharp.Backend @@ -76,7 +77,7 @@ let getSegmentsTests = createTest ((=) 0uy) Expand.getSegmentPointers ] |> testList "get segment pointers" -let expand length segmentPointers mulOp (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = +let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = let extendPointers pointers = Array.pairwise pointers |> Array.map (fun (fst, snd) -> snd - fst) @@ -106,11 +107,9 @@ let expand length segmentPointers mulOp (leftMatrix: Matrix.CSR<'a>) (rightMatri |> Array.concat |> Array.unzip - let expectedValues = Array.map2 mulOp leftMatrixValues rightMatrixValues + leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows - expectedValues, expectedColumns, expectedRows - -let makeExpandTest isEqual zero opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = +let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let leftMatrix = createCSRMatrix leftArray <| isEqual zero @@ -126,22 +125,26 @@ let makeExpandTest isEqual zero opMul testFun (leftArray: 'a [,], rightArray: 'a let clRightMatrix = rightMatrix.ToDevice context let clSegmentPointers = context.CreateClArray segmentPointers - let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = + let (clActualLeftValues: ClArray<'a>), (clActualRightValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = testFun processor length clSegmentPointers clLeftMatrix clRightMatrix clLeftMatrix.Dispose processor clRightMatrix.Dispose processor clSegmentPointers.Free processor - let actualValues = clActualValues.ToHostAndFree processor + let actualLeftValues = clActualLeftValues.ToHostAndFree processor + let actualRightValues = clActualRightValues.ToHostAndFree processor let actualColumns = clActualColumns.ToHostAndFree processor let actualRows = clActualRows.ToHostAndFree processor - let expectedValues, expectedColumns, expectedRows = - expand length segmentPointers opMul leftMatrix rightMatrix + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = + expand length segmentPointers leftMatrix rightMatrix + + "Left values must be the same" + |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues - "Values must be the same" - |> Utils.compareArrays isEqual actualValues expectedValues + "Right values must be the same" + |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues "Columns must be the same" |> Utils.compareArrays (=) actualColumns expectedColumns @@ -149,28 +152,28 @@ let makeExpandTest isEqual zero opMul testFun (leftArray: 'a [,], rightArray: 'a "Rows must be the same" |> Utils.compareArrays (=) actualRows expectedRows -let createExpandTest isEqual (zero: 'a) opMul opMulQ testFun = +let createExpandTest isEqual (zero: 'a) testFun = - let testFun = testFun context Utils.defaultWorkGroupSize opMulQ + let testFun = testFun context Utils.defaultWorkGroupSize - makeExpandTest isEqual zero opMul testFun + makeExpandTest isEqual zero testFun |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let expandTests = - [ createExpandTest (=) 0 (*) <@ (*) @> Expand.expand + [ createExpandTest (=) 0 Expand.expand if Utils.isFloat64Available context.ClDevice then - createExpandTest Utils.floatIsEqual 0.0 (*) <@ (*) @> Expand.expand + createExpandTest Utils.floatIsEqual 0.0 Expand.expand - createExpandTest Utils.float32IsEqual 0f (*) <@ (*) @> Expand.expand - createExpandTest (=) false (&&) <@ (&&) @> Expand.expand - createExpandTest (=) 0uy (*) <@ (*) @> Expand.expand ] + createExpandTest Utils.float32IsEqual 0f Expand.expand + createExpandTest (=) false Expand.expand + createExpandTest (=) 0uy Expand.expand ] |> testList "Expand.expand" let checkGeneralResult zero isEqual actualValues actualColumns actualRows mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = let expected = - HostPrimitives.array2DMultiplication mul add leftArray rightArray + HostPrimitives.array2DMultiplication zero mul add leftArray rightArray |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) |> function Matrix.COO matrix -> matrix | _ -> failwith "format miss" @@ -217,9 +220,9 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray with | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + | _ -> reraise () -let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = +let createGeneralTest (zero: 'a) isEqual opAddQ opAdd (opMulQ, opMul) testFun = let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ @@ -227,5 +230,5 @@ let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = |> testPropertyWithConfig { config with endSize = 10; maxTest = 1000 } $"test on %A{typeof<'a>}" let generalTests = - [ createGeneralTest 0 (=) (+) <@ (+) @> (*) <@ (*) @> Expand.run ] + [ createGeneralTest 0 (=) <@ (+) @> (+) ArithmeticOperations.intMul Expand.run ] |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 7f89df5a..513f54cf 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,10 +94,11 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.generalTests + [ // SpGeMM.expandTests + SpGeMM.generalTests // Common.Gather.initTests - Common.ClArray.Choose.tests2 ] - + // Common.ClArray.Choose.tests2 ] + ] |> testSequenced [] From 69be680727566be2233e370121021e5116af27d1 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 23:55:37 +0300 Subject: [PATCH 052/143] add: reduce by key option --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 125 ++++++++++++++++++ .../Common/Reduce/ReduceByKey.fs | 95 +++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- 3 files changed, 222 insertions(+), 2 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index ca84fab9..953f4e6c 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -6,6 +6,7 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell module Reduce = /// @@ -616,3 +617,127 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) firstReducedKeys, secondReducedKeys, reducedValues + + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let segmentSequentialOption<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) (resultPositions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] + + let firstSourceKey = firstKeys.[startPosition] + let secondSourceKey = secondKeys.[startPosition] + + let mutable sum = Some values.[startPosition] + + let mutable currentPosition = startPosition + 1 + + while currentPosition < keysLength + && firstSourceKey = firstKeys.[currentPosition] + && secondSourceKey = secondKeys.[currentPosition] do + + match sum with + | Some value -> + let result = ((%reduceOp) value values.[currentPosition]) // brahma error + + sum <- result + | None -> + sum <- Some values.[currentPosition] + + currentPosition <- currentPosition + 1 + + match sum with + | Some value -> + reducedValues.[gid] <- value + resultPositions.[gid] <- 1 + | None -> + resultPositions.[gid] <- 0 + + firstReducedKeys.[gid] <- firstSourceKey + secondReducedKeys.[gid] <- secondSourceKey @> + + let kernel = clContext.Compile kernel + + let scatterData = Scatter.lastOccurrence clContext workGroupSize + + let scatterIndices = Scatter.lastOccurrence clContext workGroupSize + + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let resultPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + resultPositions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let resultLength = + (prefixSum processor resultPositions).ToHostAndFree processor + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterData processor resultPositions reducedValues resultValues + + reducedValues.Free processor + + let resultFirstKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterIndices processor resultPositions firstReducedKeys resultFirstKeys + + firstReducedKeys.Free processor + + let resultSecondKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterIndices processor resultPositions secondReducedKeys resultSecondKeys + + secondReducedKeys.Free processor + + resultPositions.Free processor + + resultFirstKeys, resultSecondKeys, resultValues diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 6a7f66f3..c015550a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -2,6 +2,7 @@ module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.ByKey open Expecto open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext @@ -14,6 +15,16 @@ let processor = Context.defaultContext.Queue let config = Utils.defaultConfig +let getOffsets array = + Array.map fst array + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions + +let getOffsets2D array = + Array.map (fun (fst, snd, _) -> fst, snd) array + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions + let checkResult isEqual actualKeys actualValues keys values reduceOp = let expectedKeys, expectedValues = @@ -336,3 +347,87 @@ let sequentialSegmentTests2D = createTestSequentialSegments2D (=) (&&) <@ (&&) @> ] testList "Sequential segments 2D" [ addTests; mulTests ] + +let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp = + + let reduceOp left right = + match left, right with + | Some left, Some right -> + reduceOp left right + | Some value, None + | None, Some value -> Some value + | _ -> None + + let expectedFirstKeys, expectedSecondKeys, expectedValues = + let keys = Array.zip firstKeys secondKeys + + Array.zip keys values + |> Array.groupBy fst + |> Array.map (fun (key, array) -> key, Array.map snd array) + |> Array.map (fun (key, array) -> + Array.map Some array + |> Array.reduce reduceOp + |> fun result -> key, result) + |> Array.choose (fun ((fstKey, sndKey), value) -> + match value with + | Some value -> Some (fstKey, sndKey, value) + | _ -> None ) + |> Array.unzip3 + + "First keys must be the same" + |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys + + "Second keys must be the same" + |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys + + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + +let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = + if array.Length > 0 then + let array = Array.sortBy (fun (fst, snd, _) -> fst, snd) array + + let offsets = getOffsets2D array + + let firstKeys, secondKeys, values = Array.unzip3 array + + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + let clFirstKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, firstKeys) + + let clSecondKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, secondKeys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = + reduce processor DeviceOnly offsets.Length clOffsets clFirstKeys clSecondKeys clValues + + let reducedFirsKeys = clFirstActualKeys.ToHostAndFree processor + let reducesSecondKeys = clSecondActualKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor + + checkResult2DOption isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp + +let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = + let reduce = + Reduce.ByKey2D.segmentSequentialOption context Utils.defaultWorkGroupSize reduceOpQ + + test2DOption<'a> isEqual reduce reduceOp + |> testPropertyWithConfig { config with arbitrary = [ typeof ] } $"test on {typeof<'a>}" + +let testsByKey2DSegmentsSequential = + [ createTest2DOption (=) ArithmeticOperations.intAdd + + if Utils.isFloat64Available context.ClDevice then + createTest2DOption Utils.floatIsEqual ArithmeticOperations.floatAdd + + createTest2DOption Utils.float32IsEqual ArithmeticOperations.float32Add + createTest2DOption (=) ArithmeticOperations.boolAdd ] + |> testList "2D option" + + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 513f54cf..7e1a4974 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,10 +95,10 @@ let allTests = testList "All tests" [ // SpGeMM.expandTests - SpGeMM.generalTests + // SpGeMM.generalTests // Common.Gather.initTests // Common.ClArray.Choose.tests2 ] - ] + Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] |> testSequenced [] From 3f7c0bf757fb4e43a876dca6792935c0d5434a57 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 09:03:57 +0300 Subject: [PATCH 053/143] add: spgemm --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 15 +++++++++++++-- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 6 +++--- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +++-- 4 files changed, 20 insertions(+), 8 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index d88a4712..857ca8b9 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -216,7 +216,7 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = - let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd + let reduce = Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd let getUniqueBitmap = ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 0fe23f11..c4375449 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -233,15 +233,26 @@ module HostPrimitives = if Array2D.length2 leftArray <> Array2D.length1 rightArray then failwith "Incompatible matrices" + let add left right = + match left, right with + | Some left, Some right -> + add left right + | Some value, None + | None, Some value -> Some value + | _ -> None + Array2D.init <| Array2D.length1 leftArray <| Array2D.length2 rightArray <| fun i j -> (leftArray.[i, *], rightArray.[*, j]) + // multiply and filter ||> Array.map2 mul |> Array.choose id - |> Array.fold add zero - + // add and filter + |> Array.map Some + |> Array.fold add None + |> function | Some value -> value | None -> zero module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 25b4913d..a73953d3 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -222,13 +222,13 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr | ex when ex.Message = "InvalidBufferSize" -> () | _ -> reraise () -let createGeneralTest (zero: 'a) isEqual opAddQ opAdd (opMulQ, opMul) testFun = +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ makeGeneralTest zero isEqual opMul opAdd testFun - |> testPropertyWithConfig { config with endSize = 10; maxTest = 1000 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let generalTests = - [ createGeneralTest 0 (=) <@ (+) @> (+) ArithmeticOperations.intMul Expand.run ] + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Expand.run ] |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 7e1a4974..ae4e742d 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,10 +95,11 @@ let allTests = testList "All tests" [ // SpGeMM.expandTests - // SpGeMM.generalTests + SpGeMM.generalTests // Common.Gather.initTests // Common.ClArray.Choose.tests2 ] - Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] + // Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] + ] |> testSequenced [] From 96c0c0822b32ee0a737c292f5df65de213170472 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 10:28:00 +0300 Subject: [PATCH 054/143] refactor: spgemm --- .../BenchmarksMxm.fs | 12 +- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 68 +++-- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 16 +- .../Common/PrefixSum.fs | 1 - src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 46 +-- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 32 ++- .../GraphBLAS-sharp.Backend.fsproj | 22 +- .../Matrix/CSRMatrix/Matrix.fs | 50 +++- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 141 ++++++---- .../{SpGEMMMasked.fs => SpGEMM/Masked.fs} | 11 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 46 ++- .../Quotes/Arithmetic.fs | 10 +- tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs | 6 +- .../Common/ClArray/Choose.fs | 11 +- tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 19 +- .../Common/Reduce/ReduceByKey.fs | 80 ++++-- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 19 +- .../Common/Sort/Radix.fs | 3 +- .../GraphBLAS-sharp.Tests.fsproj | 6 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 55 ++-- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 234 ---------------- .../Matrix/SpGeMM/Expand.fs | 264 ++++++++++++++++++ .../Matrix/{Mxm.fs => SpGeMM/Masked.fs} | 10 +- tests/GraphBLAS-sharp.Tests/Program.fs | 177 ++++++------ 24 files changed, 746 insertions(+), 593 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/{SpGEMMMasked.fs => SpGEMM/Masked.fs} (96%) delete mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs rename tests/GraphBLAS-sharp.Tests/Matrix/{Mxm.fs => SpGeMM/Masked.fs} (91%) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs index a886736b..dd5d7673 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs @@ -229,7 +229,7 @@ module Operations = type MxmBenchmarks4Float32MultiplicationOnly() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.mxm Operations.add Operations.mult), + (Matrix.SpGeMM.masked Operations.add Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -241,7 +241,7 @@ type MxmBenchmarks4Float32MultiplicationOnly() = type MxmBenchmarks4Float32WithTransposing() = inherit MxmBenchmarksWithTransposing( - (Matrix.mxm Operations.add Operations.mult), + (Matrix.SpGeMM.masked Operations.add Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -253,7 +253,7 @@ type MxmBenchmarks4Float32WithTransposing() = type MxmBenchmarks4BoolMultiplicationOnly() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.mxm Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), (fun _ -> true), (fun _ -> true), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -265,7 +265,7 @@ type MxmBenchmarks4BoolMultiplicationOnly() = type MxmBenchmarks4BoolWithTransposing() = inherit MxmBenchmarksWithTransposing( - (Matrix.mxm Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), (fun _ -> true), (fun _ -> true), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -277,7 +277,7 @@ type MxmBenchmarks4BoolWithTransposing() = type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.mxm Operations.addWithFilter Operations.mult), + (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -289,7 +289,7 @@ type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = type MxmBenchmarks4Float32WithTransposingWithZerosFilter() = inherit MxmBenchmarksWithTransposing( - (Matrix.mxm Operations.addWithFilter Operations.mult), + (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 0d4cf1b2..8275c434 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -168,13 +168,15 @@ module ClArray = let getUniqueBitmapFirstOccurrence clContext = getUniqueBitmapGeneral <| <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> - gid = 0 || inputArray.[gid - 1] <> inputArray.[gid] @> + gid = 0 + || inputArray.[gid - 1] <> inputArray.[gid] @> <| clContext let getUniqueBitmapLastOccurrence clContext = getUniqueBitmapGeneral <| <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> - gid = length - 1 || inputArray.[gid] <> inputArray.[gid + 1] @> + gid = length - 1 + || inputArray.[gid] <> inputArray.[gid + 1] @> <| clContext ///Remove duplicates form the given array. @@ -186,7 +188,8 @@ module ClArray = let scatter = Scatter.lastOccurrence clContext workGroupSize - let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize + let getUniqueBitmap = + getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSumExclude = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize @@ -308,16 +311,20 @@ module ClArray = let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = - let map = map2 clContext workGroupSize <@ fun x y -> x ||| y @> + let map = + map2 clContext workGroupSize <@ fun x y -> x ||| y @> let firstGetBitmap = getUniqueBitmap clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> - let firstBitmap = firstGetBitmap processor DeviceOnly firstArray + let firstBitmap = + firstGetBitmap processor DeviceOnly firstArray - let secondBitmap = firstGetBitmap processor DeviceOnly secondArray + let secondBitmap = + firstGetBitmap processor DeviceOnly secondArray - let result = map processor allocationMode firstBitmap secondBitmap + let result = + map processor allocationMode firstBitmap secondBitmap firstBitmap.Free processor secondBitmap.Free processor @@ -344,15 +351,15 @@ module ClArray = // seems like scatter (option scatter) ??? if 0 <= position && position < resultLength then match (%op) value with - | Some value -> - result.[position] <- value + | Some value -> result.[position] <- value | None -> () @> let kernel = clContext.Compile assign fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> - if values.Length <> positions.Length then failwith "lengths must be the same" + if values.Length <> positions.Length then + failwith "lengths must be the same" let ndRange = Range1D.CreateValid(values.Length, workGroupSize) @@ -371,19 +378,23 @@ module ClArray = map<'a, int> clContext workGroupSize <| Map.chooseBitmap predicate - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let assignValues = assignOption clContext workGroupSize predicate + let assignValues = + assignOption clContext workGroupSize predicate fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> - let positions = getBitmap processor DeviceOnly sourceValues + let positions = + getBitmap processor DeviceOnly sourceValues let resultLength = (prefixSum processor positions) .ToHostAndFree(processor) - let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) assignValues processor sourceValues positions result @@ -405,8 +416,7 @@ module ClArray = // seems like scatter2 (option scatter2) ??? if 0 <= position && position < resultLength then match (%op) leftValue rightValue with - | Some value -> - result.[position] <- value + | Some value -> result.[position] <- value | None -> () @> let kernel = clContext.Compile assign @@ -414,8 +424,8 @@ module ClArray = fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) -> if firstValues.Length <> secondValues.Length - || secondValues.Length <> positions.Length then - failwith "lengths must be the same" + || secondValues.Length <> positions.Length then + failwith "lengths must be the same" let ndRange = Range1D.CreateValid(firstValues.Length, workGroupSize) @@ -424,7 +434,15 @@ module ClArray = processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange firstValues.Length firstValues secondValues positions result result.Length) + (fun () -> + kernel.KernelFunc + ndRange + firstValues.Length + firstValues + secondValues + positions + result + result.Length) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -434,19 +452,23 @@ module ClArray = map2<'a, 'b, int> clContext workGroupSize <| Map.chooseBitmap2 predicate - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let assignValues = assignOption2 clContext workGroupSize predicate + let assignValues = + assignOption2 clContext workGroupSize predicate fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> - let positions = getBitmap processor DeviceOnly firstValues secondValues + let positions = + getBitmap processor DeviceOnly firstValues secondValues let resultLength = (prefixSum processor positions) .ToHostAndFree(processor) - let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) assignValues processor firstValues secondValues positions result diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 9837b9c1..c4f1fa19 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -22,11 +22,10 @@ module internal Gather = let kernel = program.GetKernel() - let ndRange = Range1D.CreateValid(outputArray.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(outputArray.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray) - ) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -59,14 +58,17 @@ module internal Gather = fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> - if positions.Length <> outputArray.Length then failwith "Lengths must be the same" + if positions.Length <> outputArray.Length then + failwith "Lengths must be the same" let kernel = program.GetKernel() - let ndRange = Range1D.CreateValid(positions.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(positions.Length, workGroupSize) processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray) + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index 591b9a28..3ecd363c 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -341,4 +341,3 @@ module PrefixSum = /// let sequentialInclude clContext = sequentialSegments (Map.snd ()) clContext - diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 5109a7b1..4146ea0c 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -5,13 +5,14 @@ open Brahma.FSharp module internal Scatter = let private firstOccurencePredicate () = <@ fun gid _ (positions: ClArray) -> - // first occurrence condition - (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> + // first occurrence condition + (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> let private lastOccurrencePredicate () = <@ fun gid positionsLength (positions: ClArray) -> - // last occurrence condition - (gid = positionsLength - 1 || positions.[gid] <> positions.[gid + 1]) @> + // last occurrence condition + (gid = positionsLength - 1 + || positions.[gid] <> positions.[gid + 1]) @> let private general<'a> predicate (clContext: ClContext) workGroupSize = @@ -23,11 +24,14 @@ module internal Scatter = if gid < positionsLength then // positions lengths == values length - let predicateResult = (%predicate) gid positionsLength positions + let predicateResult = + (%predicate) gid positionsLength positions + let position = positions.[gid] if predicateResult - && 0 <= position && position < resultLength then + && 0 <= position + && position < resultLength then result.[positions.[gid]] <- values.[gid] @> @@ -35,7 +39,8 @@ module internal Scatter = fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> - if positions.Length <> values.Length then failwith "Lengths must be the same" + if positions.Length <> values.Length then + failwith "Lengths must be the same" let positionsLength = positions.Length @@ -70,9 +75,7 @@ module internal Scatter = /// /// let firstOccurrence clContext = - general - <| firstOccurencePredicate () - <| clContext + general <| firstOccurencePredicate () <| clContext /// /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array @@ -93,9 +96,7 @@ module internal Scatter = /// /// let lastOccurrence clContext = - general - <| lastOccurrencePredicate () - <| clContext + general <| lastOccurrencePredicate () <| clContext let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = @@ -106,12 +107,14 @@ module internal Scatter = if gid < positionsLength then // positions lengths == values length - let predicateResult = (%predicate) gid positionsLength positions + let predicateResult = + (%predicate) gid positionsLength positions let position = positions.[gid] if predicateResult - && 0 <= position && position < resultLength then + && 0 <= position + && position < resultLength then result.[positions.[gid]] <- (%valueMap) gid @> @@ -127,8 +130,7 @@ module internal Scatter = let kernel = program.GetKernel() processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -152,7 +154,10 @@ module internal Scatter = /// /// /// Maps global id to a value - let initFirsOccurrence<'a> valueMap = generalInit<'a> <| firstOccurencePredicate () <| valueMap + let initFirsOccurrence<'a> valueMap = + generalInit<'a> + <| firstOccurencePredicate () + <| valueMap /// /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array @@ -173,4 +178,7 @@ module internal Scatter = /// /// /// Maps global id to a value - let initLastOccurrence<'a> valueMap = generalInit<'a> <| lastOccurrencePredicate () <| valueMap + let initLastOccurrence<'a> valueMap = + generalInit<'a> + <| lastOccurrencePredicate () + <| valueMap diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 953f4e6c..bdf1840d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -536,7 +536,16 @@ module Reduce = processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange firstKeys.Length firstKeys secondKeys values reducedValues firstReducedKeys secondReducedKeys) + (fun () -> + kernel.KernelFunc + ndRange + firstKeys.Length + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -650,11 +659,11 @@ module Reduce = match sum with | Some value -> - let result = ((%reduceOp) value values.[currentPosition]) // brahma error + let result = + ((%reduceOp) value values.[currentPosition]) // brahma error sum <- result - | None -> - sum <- Some values.[currentPosition] + | None -> sum <- Some values.[currentPosition] currentPosition <- currentPosition + 1 @@ -662,19 +671,21 @@ module Reduce = | Some value -> reducedValues.[gid] <- value resultPositions.[gid] <- 1 - | None -> - resultPositions.[gid] <- 0 + | None -> resultPositions.[gid] <- 0 firstReducedKeys.[gid] <- firstSourceKey secondReducedKeys.[gid] <- secondSourceKey @> let kernel = clContext.Compile kernel - let scatterData = Scatter.lastOccurrence clContext workGroupSize + let scatterData = + Scatter.lastOccurrence clContext workGroupSize - let scatterIndices = Scatter.lastOccurrence clContext workGroupSize + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> @@ -715,7 +726,8 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let resultLength = - (prefixSum processor resultPositions).ToHostAndFree processor + (prefixSum processor resultPositions) + .ToHostAndFree processor let resultValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 006437cb..74797513 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -31,19 +31,18 @@ - + - - - + + @@ -56,21 +55,6 @@ - - - - - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index 4f3f0f09..63cd4fcc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -104,17 +104,39 @@ module Matrix = |> transposeInplace queue |> toCSRInplace queue allocationMode - let spgemmCSC - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - = - - let run = - SpGEMMMasked.run clContext workGroupSize opAdd opMul - - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> - - run queue matrixLeft matrixRight mask - + module SpGeMM = + let masked + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let run = + SpGeMM.Masked.run clContext workGroupSize opAdd opMul + + fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + + run queue matrixLeft matrixRight mask + + let expand + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let run = + SpGeMM.Expand.run clContext workGroupSize opAdd opMul + + fun (queue: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let values, columns, rows = + run queue allocationMode leftMatrix rightMatrix + + { COO.Context = clContext + ColumnCount = rightMatrix.ColumnCount + RowCount = leftMatrix.RowCount + Values = values + Columns = columns + Rows = rows } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 857ca8b9..71f5fff9 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -18,15 +18,19 @@ type Values<'a> = ClArray<'a> module Expand = let getSegmentPointers (clContext: ClContext) workGroupSize = - let subtract = ClArray.map2 clContext workGroupSize Map.subtraction + let subtract = + ClArray.map2 clContext workGroupSize Map.subtraction - let idGather = Gather.runInit Map.id clContext workGroupSize + let idGather = + Gather.runInit Map.id clContext workGroupSize - let incGather = Gather.runInit Map.inc clContext workGroupSize + let incGather = + Gather.runInit Map.inc clContext workGroupSize let gather = Gather.run clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> @@ -62,7 +66,9 @@ module Expand = rightMatrixRowsLengths.Free processor // compute pointers - let length = (prefixSum processor segmentsLengths).ToHostAndFree processor + let length = + (prefixSum processor segmentsLengths) + .ToHostAndFree processor length, segmentsLengths @@ -71,29 +77,36 @@ module Expand = ClArray.map2<'a, 'b, int> clContext workGroupSize <| Map.chooseBitmap2 predicate - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let assignValues = ClArray.assignOption2 clContext workGroupSize predicate + let assignValues = + ClArray.assignOption2 clContext workGroupSize predicate - let scatter = Scatter.lastOccurrence clContext workGroupSize // TODO(last ?) + let scatter = + Scatter.lastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: Indices) (rows: Indices) -> - let positions = getBitmap processor DeviceOnly firstValues secondValues + let positions = + getBitmap processor DeviceOnly firstValues secondValues let resultLength = (prefixSum processor positions) .ToHostAndFree(processor) - let resultColumns = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) scatter processor positions columns resultColumns - let resultRows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) scatter processor positions rows resultRows - let resultValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) assignValues processor firstValues secondValues positions resultValues @@ -101,23 +114,30 @@ module Expand = let expand (clContext: ClContext) workGroupSize = - let idScatter = Scatter.initLastOccurrence Map.id clContext workGroupSize + let idScatter = + Scatter.initLastOccurrence Map.id clContext workGroupSize - let scatter = Scatter.lastOccurrence clContext workGroupSize + let scatter = + Scatter.lastOccurrence clContext workGroupSize - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + let zeroCreate = + ClArray.zeroCreate clContext workGroupSize - let maxPrefixSum = PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize + let maxPrefixSum = + PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize let create = ClArray.create clContext workGroupSize let gather = Gather.run clContext workGroupSize - let segmentPrefixSum = PrefixSum.ByKey.sequentialInclude clContext workGroupSize <@ (+) @> 0 + let segmentPrefixSum = + PrefixSum.ByKey.sequentialInclude clContext workGroupSize <@ (+) @> 0 - let removeDuplicates = ClArray.removeDuplications clContext workGroupSize + let removeDuplicates = + ClArray.removeDuplications clContext workGroupSize - let expandRowPointers = Common.expandRowPointers clContext workGroupSize + let expandRowPointers = + Common.expandRowPointers clContext workGroupSize let AGather = Gather.run clContext workGroupSize @@ -130,12 +150,14 @@ module Expand = idScatter processor segmentsPointers APositions - (maxPrefixSum processor APositions 0).Free processor + (maxPrefixSum processor APositions 0) + .Free processor // Compute B positions let BPositions = create processor DeviceOnly lengths 1 - let requiredBPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length + let requiredBPointers = + zeroCreate processor DeviceOnly leftMatrix.Columns.Length gather processor leftMatrix.Columns rightMatrix.RowPointers requiredBPointers @@ -144,7 +166,8 @@ module Expand = requiredBPointers.Free processor // another way to get offsets ??? - let offsets = removeDuplicates processor segmentsPointers + let offsets = + removeDuplicates processor segmentsPointers segmentPrefixSum processor offsets.Length BPositions APositions offsets @@ -157,7 +180,8 @@ module Expand = gather processor BPositions rightMatrix.Columns columns // compute rows - let ARows = expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount + let ARows = + expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount let rows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) @@ -187,24 +211,31 @@ module Expand = let sortByColumnsAndRows (clContext: ClContext) workGroupSize = - let sortByKeyIndices = Radix.runByKeysStandard clContext workGroupSize + let sortByKeyIndices = + Radix.runByKeysStandard clContext workGroupSize - let sortByKeyValues = Radix.runByKeysStandard clContext workGroupSize + let sortByKeyValues = + Radix.runByKeysStandard clContext workGroupSize - let sortKeys = Radix.standardRunKeysOnly clContext workGroupSize + let sortKeys = + Radix.standardRunKeysOnly clContext workGroupSize fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> // sort by columns - let valuesSortedByColumns = sortByKeyValues processor DeviceOnly columns values + let valuesSortedByColumns = + sortByKeyValues processor DeviceOnly columns values - let rowsSortedByColumns = sortByKeyIndices processor DeviceOnly columns rows + let rowsSortedByColumns = + sortByKeyIndices processor DeviceOnly columns rows let sortedColumns = sortKeys processor columns // sort by rows - let valuesSortedByRows = sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns + let valuesSortedByRows = + sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns - let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns + let columnsSortedByRows = + sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns let sortedRows = sortKeys processor rowsSortedByColumns @@ -214,33 +245,34 @@ module Expand = valuesSortedByRows, columnsSortedByRows, sortedRows - let reduce (clContext: ClContext) workGroupSize opAdd = + let reduce (clContext: ClContext) workGroupSize opAdd = - let reduce = Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd + let reduce = + Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd let getUniqueBitmap = ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let idScatter = Scatter.initFirsOccurrence Map.id clContext workGroupSize + let idScatter = + Scatter.initFirsOccurrence Map.id clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> - let bitmap = getUniqueBitmap processor DeviceOnly columns rows + let bitmap = + getUniqueBitmap processor DeviceOnly columns rows - printfn $"key bitmap: %A{bitmap.ToHost processor}" + let uniqueKeysCount = + (prefixSum processor bitmap) + .ToHostAndFree processor - let uniqueKeysCount = (prefixSum processor bitmap).ToHostAndFree processor - - printfn $"key bitmap after prefix sum: %A{bitmap.ToHost processor}" - - let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + let offsets = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) idScatter processor bitmap offsets - printfn $"offsets: %A{offsets.ToHost processor}" - bitmap.Free processor let reducedColumns, reducedRows, reducedValues = // by size variance TODO() @@ -252,29 +284,27 @@ module Expand = let run (clContext: ClContext) workGroupSize opAdd opMul = - let getSegmentPointers = getSegmentPointers clContext workGroupSize + let getSegmentPointers = + getSegmentPointers clContext workGroupSize let expand = expand clContext workGroupSize let multiply = multiply clContext workGroupSize opMul - let sort = sortByColumnsAndRows clContext workGroupSize + let sort = + sortByColumnsAndRows clContext workGroupSize let reduce = reduce clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let length, segmentPointers = getSegmentPointers processor leftMatrix rightMatrix + let length, segmentPointers = + getSegmentPointers processor leftMatrix rightMatrix // expand let leftMatrixValues, rightMatrixValues, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix - printfn $"left matrix values: %A{leftMatrixValues.ToHost processor}" - printfn $"right matrix values: %A{rightMatrixValues.ToHost processor}" - printfn $"expanded columns: %A{columns.ToHost processor}" - printfn $"expanded rows: %A{rows.ToHost processor}" - // multiply let resultValues, resultColumns, resultRows = multiply processor leftMatrixValues rightMatrixValues columns rows @@ -288,10 +318,6 @@ module Expand = let sortedValues, sortedColumns, sortedRows = sort processor resultValues resultColumns resultRows - printfn $"sorted values: %A{sortedValues.ToHost processor}" - printfn $"sorted columns: %A{sortedColumns.ToHost processor}" - printfn $"sorted rows: %A{sortedRows.ToHost processor}" - resultValues.Free processor resultColumns.Free processor resultRows.Free processor @@ -300,13 +326,8 @@ module Expand = let reducedValues, reducedColumns, reducedRows = reduce processor allocationMode sortedValues sortedColumns sortedRows - printfn $"reduced values: %A{reducedValues.ToHost processor}" - printfn $"reduced columns: %A{reducedColumns.ToHost processor}" - printfn $"reduced rows: %A{reducedRows.ToHost processor}" - sortedValues.Free processor sortedColumns.Free processor sortedRows.Free processor reducedValues, reducedColumns, reducedRows - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs similarity index 96% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs index c4c1b4d7..b4f3fcbd 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR +namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM open GraphBLAS.FSharp.Backend.Common open Brahma.FSharp @@ -8,7 +8,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell -module internal SpGEMMMasked = +module internal Masked = let private calculate (context: ClContext) workGroupSize @@ -151,8 +151,11 @@ module internal SpGEMMMasked = let calculate = calculate context workGroupSize opAdd opMul - let scatter = Scatter.lastOccurrence context workGroupSize - let scatterData = Scatter.lastOccurrence context workGroupSize + let scatter = + Scatter.lastOccurrence context workGroupSize + + let scatterData = + Scatter.lastOccurrence context workGroupSize let scanInplace = PrefixSum.standardExcludeInplace context workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 3fac746a..7b93b433 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -337,17 +337,35 @@ module Matrix = Values = copyData processor allocationMode m.Values } |> ClMatrix.CSR - let mxm - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - (clContext: ClContext) - workGroupSize - = - - let runCSRnCSC = - CSR.Matrix.spgemmCSC clContext workGroupSize opAdd opMul - - fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> - match matrix1, matrix2, mask with - | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO - | _ -> failwith "Matrix formats are not matching" + module SpGeMM = + let masked + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let runCSRnCSC = + CSR.Matrix.SpGeMM.masked clContext workGroupSize opAdd opMul + + fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> + match matrix1, matrix2, mask with + | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO + | _ -> failwith "Matrix formats are not matching" + + let expand + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let run = + CSR.Matrix.SpGeMM.expand clContext workGroupSize opAdd opMul + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + match leftMatrix, rightMatrix with + | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> + run processor allocationMode leftMatrix rightMatrix + |> ClMatrix.COO + | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index bd2d159a..692455da 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -131,13 +131,19 @@ module ArithmeticOperations = <@ fun (left: 'a) (right: 'a) -> let result = (%op) left right - if result = zero then None else Some result @> + if result = zero then + None + else + Some result @> let inline private binOp zero op = fun left right -> let result = op left right - if result = zero then None else Some result + if result = zero then + None + else + Some result let inline createPair zero op opQ = binOpQ zero opQ, binOp zero op diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index 65bfb8f9..4c7f76d6 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs @@ -22,7 +22,11 @@ let testFixtures (testContext: TestContext) = sprintf "Test on %A" testContext.ClContext let bfs = - Algorithms.BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption workGroupSize + Algorithms.BFS.singleSource + context + ArithmeticOperations.intSumOption + ArithmeticOperations.intMulOption + workGroupSize testPropertyWithConfig config testName <| fun (matrix: int [,]) -> diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index 1863b191..7c1cfdea 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -62,8 +62,7 @@ let tests = TestCases.gpuTests "choose id" testFixtures let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = - if firstArray.Length > 0 - && secondArray.Length > 0 then + if firstArray.Length > 0 && secondArray.Length > 0 then let expected = Array.map2 opMap firstArray secondArray @@ -72,7 +71,8 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = let clFirstArray = context.CreateClArray firstArray let clSecondArray = context.CreateClArray secondArray - let (clActual: ClArray<_>) = testFun processor HostInterop clFirstArray clSecondArray + let (clActual: ClArray<_>) = + testFun processor HostInterop clFirstArray clSecondArray let actual = clActual.ToHostAndFree processor clFirstArray.Free processor @@ -82,7 +82,8 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = |> Utils.compareArrays isEqual actual expected let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = - let testFun = testFun context Utils.defaultWorkGroupSize opMapQ + let testFun = + testFun context Utils.defaultWorkGroupSize opMapQ makeTest2 isEqual opMap testFun |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -91,7 +92,7 @@ let tests2 = [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 if Utils.isFloat64Available context.ClDevice then - createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 + createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 createTest2 (=) ArithmeticOperations.float32Add ClArray.choose2 createTest2 (=) ArithmeticOperations.boolAdd ClArray.choose2 ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs index 96ff6527..3019d9d3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -48,7 +48,8 @@ let makeTest isEqual testFun (array: (uint * 'a * 'a) []) = let createTest<'a> (isEqual: 'a -> 'a -> bool) testFun = - let testFun = testFun context Utils.defaultWorkGroupSize + let testFun = + testFun context Utils.defaultWorkGroupSize makeTest isEqual testFun |> testPropertyWithConfig Utils.defaultConfig $"test on %A{typeof<'a>}" @@ -57,7 +58,7 @@ let tests = [ createTest (=) Gather.run if Utils.isFloat64Available context.ClDevice then - createTest Utils.floatIsEqual Gather.run + createTest Utils.floatIsEqual Gather.run createTest Utils.float32IsEqual Gather.run createTest (=) Gather.run @@ -88,7 +89,8 @@ let makeTestInit isEqual testFun indexMap (array: ('a * 'a) []) = let createTestInit<'a> (isEqual: 'a -> 'a -> bool) testFun indexMapQ indexMap = - let testFun = testFun indexMapQ context Utils.defaultWorkGroupSize + let testFun = + testFun indexMapQ context Utils.defaultWorkGroupSize makeTestInit isEqual testFun indexMap |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" @@ -99,11 +101,11 @@ let initTests = [ createTestInit (=) Gather.runInit Map.id id if Utils.isFloat64Available context.ClDevice then - createTestInit Utils.floatIsEqual Gather.runInit Map.id id + createTestInit Utils.floatIsEqual Gather.runInit Map.id id createTestInit Utils.float32IsEqual Gather.runInit Map.id id createTestInit (=) Gather.runInit Map.id id - createTestInit (=) Gather.runInit Map.id id] + createTestInit (=) Gather.runInit Map.id id ] |> testList "id" let inc = ((+) 1) @@ -112,13 +114,14 @@ let initTests = [ createTestInit (=) Gather.runInit Map.inc inc if Utils.isFloat64Available context.ClDevice then - createTestInit Utils.floatIsEqual Gather.runInit Map.inc inc + createTestInit Utils.floatIsEqual Gather.runInit Map.inc inc createTestInit Utils.float32IsEqual Gather.runInit Map.inc inc createTestInit (=) Gather.runInit Map.inc inc - createTestInit (=) Gather.runInit Map.inc inc] + createTestInit (=) Gather.runInit Map.inc inc ] |> testList "inc" - testList "init" [idTests; incTests] + testList "init" [ idTests; incTests ] +let allTests = testList "Gather" [ tests; initTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index c015550a..e50b34ed 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -228,7 +228,9 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let resultLength = Array.length <| Array.distinctBy (fun (fst, snd, _) -> (fst, snd)) array + let resultLength = + Array.length + <| Array.distinctBy (fun (fst, snd, _) -> (fst, snd)) array let clFirstActualKeys, clSecondActualKeys, clActualValues: ClArray * ClArray * ClArray<'a> = reduce processor HostInterop resultLength clFirstKeys clSecondKeys clValues @@ -238,8 +240,12 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = clSecondKeys.Free processor let actualValues = clActualValues.ToHostAndFree processor - let firstActualKeys = clFirstActualKeys.ToHostAndFree processor - let secondActualKeys = clSecondActualKeys.ToHostAndFree processor + + let firstActualKeys = + clFirstActualKeys.ToHostAndFree processor + + let secondActualKeys = + clSecondActualKeys.ToHostAndFree processor checkResult2D isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp @@ -249,7 +255,11 @@ let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = Reduce.ByKey2D.sequential context Utils.defaultWorkGroupSize reduceOpQ makeTest2D isEqual reduce reduceOp - |> testPropertyWithConfig { config with arbitrary = [ typeof ]; endSize = 10 } $"test on {typeof<'a>}" + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] + endSize = 10 } + $"test on {typeof<'a>}" let sequential2DTest = let addTests = @@ -281,7 +291,8 @@ let sequential2DTest = let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a) []) = if array.Length > 0 then - let array = Array.sortBy (fun (fst, snd, _) -> fst, snd) array + let array = + Array.sortBy (fun (fst, snd, _) -> fst, snd) array let offsets = array @@ -308,8 +319,12 @@ let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = reduce processor DeviceOnly resultLength clOffsets clFirstKeys clSecondKeys clValues - let reducedFirsKeys = clFirstActualKeys.ToHostAndFree processor - let reducesSecondKeys = clSecondActualKeys.ToHostAndFree processor + let reducedFirsKeys = + clFirstActualKeys.ToHostAndFree processor + + let reducesSecondKeys = + clSecondActualKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor checkResult2D isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp @@ -319,7 +334,10 @@ let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp redu Reduce.ByKey2D.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ makeTestSequentialSegments2D isEqual reduce reduceOp - |> testPropertyWithConfig { config with arbitrary = [ typeof ] } $"test on {typeof<'a>}" + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" let sequentialSegmentTests2D = let addTests = @@ -352,8 +370,7 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi let reduceOp left right = match left, right with - | Some left, Some right -> - reduceOp left right + | Some left, Some right -> reduceOp left right | Some value, None | None, Some value -> Some value | _ -> None @@ -364,14 +381,16 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi Array.zip keys values |> Array.groupBy fst |> Array.map (fun (key, array) -> key, Array.map snd array) - |> Array.map (fun (key, array) -> - Array.map Some array - |> Array.reduce reduceOp - |> fun result -> key, result) - |> Array.choose (fun ((fstKey, sndKey), value) -> - match value with - | Some value -> Some (fstKey, sndKey, value) - | _ -> None ) + |> Array.map + (fun (key, array) -> + Array.map Some array + |> Array.reduce reduceOp + |> fun result -> key, result) + |> Array.choose + (fun ((fstKey, sndKey), value) -> + match value with + | Some value -> Some(fstKey, sndKey, value) + | _ -> None) |> Array.unzip3 "First keys must be the same" @@ -383,9 +402,10 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi "Values must the same" |> Utils.compareArrays isEqual actualValues expectedValues -let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = +let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = if array.Length > 0 then - let array = Array.sortBy (fun (fst, snd, _) -> fst, snd) array + let array = + Array.sortBy (fun (fst, snd, _) -> fst, snd) array let offsets = getOffsets2D array @@ -406,8 +426,12 @@ let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = reduce processor DeviceOnly offsets.Length clOffsets clFirstKeys clSecondKeys clValues - let reducedFirsKeys = clFirstActualKeys.ToHostAndFree processor - let reducesSecondKeys = clSecondActualKeys.ToHostAndFree processor + let reducedFirsKeys = + clFirstActualKeys.ToHostAndFree processor + + let reducesSecondKeys = + clSecondActualKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor checkResult2DOption isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp @@ -417,17 +441,17 @@ let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = Reduce.ByKey2D.segmentSequentialOption context Utils.defaultWorkGroupSize reduceOpQ test2DOption<'a> isEqual reduce reduceOp - |> testPropertyWithConfig { config with arbitrary = [ typeof ] } $"test on {typeof<'a>}" + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" -let testsByKey2DSegmentsSequential = +let testsByKey2DSegmentsSequentialOption = [ createTest2DOption (=) ArithmeticOperations.intAdd if Utils.isFloat64Available context.ClDevice then - createTest2DOption Utils.floatIsEqual ArithmeticOperations.floatAdd + createTest2DOption Utils.floatIsEqual ArithmeticOperations.floatAdd createTest2DOption Utils.float32IsEqual ArithmeticOperations.float32Add createTest2DOption (=) ArithmeticOperations.boolAdd ] |> testList "2D option" - - - diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index bd2629cb..e3f16eb4 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -21,13 +21,10 @@ let q = defaultContext.Queue let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then - let positions, values = - Array.sortBy fst array - |> Array.unzip + let positions, values = Array.sortBy fst array |> Array.unzip let expected = - Array.copy result - |> hostScatter positions values + Array.copy result |> hostScatter positions values let actual = let clPositions = context.CreateClArray positions @@ -68,7 +65,7 @@ let tests = testFixturesFirst ] |> testList "First Occurrence" - testList "ones occurrence" [first; last] + testList "ones occurrence" [ first; last ] let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: int []) (result: 'a []) = if positions.Length > 0 then @@ -77,8 +74,7 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: let positions = Array.sort positions let expected = - Array.copy result - |> hostScatter positions values + Array.copy result |> hostScatter positions values let clPositions = context.CreateClArray positions let clResult = context.CreateClArray result @@ -93,7 +89,8 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: |> Utils.compareArrays (=) actual expected let createInitTest clScatter hostScatter name valuesMap valuesMapQ = - let scatter = clScatter valuesMapQ context Utils.defaultWorkGroupSize + let scatter = + clScatter valuesMapQ context Utils.defaultWorkGroupSize makeTestInit<'a> hostScatter valuesMap scatter |> testPropertyWithConfig config name @@ -105,12 +102,12 @@ let initTests = let firstOccurrence = [ createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "id" id Map.id - createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "inc" inc Map.inc ] + createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "inc" inc Map.inc ] |> testList "first occurrence" let lastOccurrence = [ createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "id" id Map.id - createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "inc" inc Map.inc ] + createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "inc" inc Map.inc ] |> testList "last occurrence" testList "init" [ firstOccurrence; lastOccurrence ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs index f0a9df92..049568c5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs @@ -33,7 +33,8 @@ module Radix = let clKeys = keys.ToDevice context let clValues = values.ToDevice context - let clActualValues: ClArray<'a> = sortFun processor HostInterop clKeys clValues + let clActualValues: ClArray<'a> = + sortFun processor HostInterop clKeys clValues let actualValues = clActualValues.ToHostAndFree processor diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 502969bf..3d9f4d63 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -17,7 +17,7 @@ - + @@ -46,10 +46,10 @@ - - + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c4375449..8f58afea 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -140,7 +140,8 @@ module Utils = result - let castMatrixToCSR = function + let castMatrixToCSR = + function | Matrix.CSR matrix -> matrix | _ -> failwith "matrix format must be CSR" @@ -197,46 +198,51 @@ module HostPrimitives = let reduceByKey2D firstKeys secondKeys values reduceOp = Array.zip firstKeys secondKeys |> fun compactedKeys -> reduceByKey compactedKeys values reduceOp - ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) + ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) |> Array.unzip3 let generalScatter getBitmap (positions: int array) (values: 'a array) (resultValues: 'a array) = - if positions.Length <> values.Length then failwith "Lengths must be the same" + if positions.Length <> values.Length then + failwith "Lengths must be the same" let bitmap = getBitmap positions Array.iteri2 (fun index bit key -> - if bit = 1 - && 0 <= key - && key < resultValues.Length then - resultValues.[key] <- values.[index]) bitmap positions + if bit = 1 && 0 <= key && key < resultValues.Length then + resultValues.[key] <- values.[index]) + bitmap + positions resultValues - let scatterLastOccurrence positions = generalScatter getUniqueBitmapLastOccurrence positions + let scatterLastOccurrence positions = + generalScatter getUniqueBitmapLastOccurrence positions - let scatterFirstOccurrence positions = generalScatter getUniqueBitmapFirstOccurrence positions + let scatterFirstOccurrence positions = + generalScatter getUniqueBitmapFirstOccurrence positions let gather (positions: int []) (values: 'a []) (result: 'a []) = if positions.Length <> result.Length then failwith "Lengths must be the same" - Array.iteri (fun index position -> - if position >= 0 && position < values.Length then - result.[index] <- values.[position]) positions + Array.iteri + (fun index position -> + if position >= 0 && position < values.Length then + result.[index] <- values.[position]) + positions result let array2DMultiplication zero mul add leftArray rightArray = - if Array2D.length2 leftArray <> Array2D.length1 rightArray then + if Array2D.length2 leftArray + <> Array2D.length1 rightArray then failwith "Incompatible matrices" let add left right = match left, right with - | Some left, Some right -> - add left right + | Some left, Some right -> add left right | Some value, None | None, Some value -> Some value | _ -> None @@ -245,14 +251,17 @@ module HostPrimitives = <| Array2D.length1 leftArray <| Array2D.length2 rightArray <| fun i j -> - (leftArray.[i, *], rightArray.[*, j]) - // multiply and filter - ||> Array.map2 mul - |> Array.choose id - // add and filter - |> Array.map Some - |> Array.fold add None - |> function | Some value -> value | None -> zero + (leftArray.[i, *], rightArray.[*, j]) + // multiply and filter + ||> Array.map2 mul + |> Array.choose id + // add and filter + |> Array.map Some + |> Array.fold add None + |> function + | Some value -> value + | None -> zero + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs deleted file mode 100644 index a73953d3..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ /dev/null @@ -1,234 +0,0 @@ -module GraphBLAS.FSharp.Tests.Matrix.SpGeMM - -open Expecto -open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.Test -open Microsoft.FSharp.Collections -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects.ClContext - -let context = Context.defaultContext.ClContext - -let processor = Context.defaultContext.Queue - -let config = { Utils.defaultConfig with arbitrary = [ typeof ] } - -let createCSRMatrix array isZero = - Utils.createMatrixFromArray2D CSR array isZero - |> Utils.castMatrixToCSR - -let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - Array.map (fun item -> - rightMatrix.RowPointers.[item + 1] - rightMatrix.RowPointers.[item]) leftMatrix.ColumnIndices - |> HostPrimitives.prefixSumExclude - -let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = createCSRMatrix leftArray isZero - - let rightMatrix = createCSRMatrix rightArray isZero - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - let clLeftMatrix = leftMatrix.ToDevice context - - let clRightMatrix = rightMatrix.ToDevice context - - let actualLength, (clActual: ClArray) = - testFun processor clLeftMatrix clRightMatrix - - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - - let actualPointers = clActual.ToHostAndFree processor - - let expectedPointers, expectedLength = - getSegmentsPointers leftMatrix rightMatrix - - "Results lengths must be the same" - |> Expect.equal actualLength expectedLength - - "Result pointers must be the same" - |> Expect.sequenceEqual actualPointers expectedPointers - -let createTest<'a when 'a : struct> (isZero: 'a -> bool) testFun = - - let testFun = testFun context Utils.defaultWorkGroupSize - - makeTest isZero testFun - |> testPropertyWithConfig config $"test on {typeof<'a>}" - -let getSegmentsTests = - [ createTest ((=) 0) Expand.getSegmentPointers - - if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) Expand.getSegmentPointers - - createTest ((=) 0f) Expand.getSegmentPointers - createTest ((=) false) Expand.getSegmentPointers - createTest ((=) 0uy) Expand.getSegmentPointers ] - |> testList "get segment pointers" - -let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - let extendPointers pointers = - Array.pairwise pointers - |> Array.map (fun (fst, snd) -> snd - fst) - |> Array.mapi (fun index length -> Array.create length index) - |> Array.concat - - let segmentsLengths = - Array.append segmentPointers [| length |] - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) - - let leftMatrixValues, expectedRows = - let tripleFst (fst, _, _) = fst - - Array.zip3 segmentsLengths leftMatrix.Values <| extendPointers leftMatrix.RowPointers // TODO(expand row pointers) - // select items each segment length not zero - |> Array.filter (tripleFst >> ((=) 0) >> not) - |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) - |> Array.unzip - - let rightMatrixValues, expectedColumns = - let valuesAndColumns = Array.zip rightMatrix.Values rightMatrix.ColumnIndices - - Array.map2 (fun column length -> - let rowStart = rightMatrix.RowPointers.[column] - Array.take length valuesAndColumns.[rowStart..]) leftMatrix.ColumnIndices segmentsLengths - |> Array.concat - |> Array.unzip - - leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows - -let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = createCSRMatrix leftArray <| isEqual zero - - let rightMatrix = createCSRMatrix rightArray <| isEqual zero - - if leftMatrix.NNZ > 0 - && rightMatrix.NNZ > 0 then - - let segmentPointers, length = - getSegmentsPointers leftMatrix rightMatrix - - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - let clSegmentPointers = context.CreateClArray segmentPointers - - let (clActualLeftValues: ClArray<'a>), (clActualRightValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = - testFun processor length clSegmentPointers clLeftMatrix clRightMatrix - - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - clSegmentPointers.Free processor - - let actualLeftValues = clActualLeftValues.ToHostAndFree processor - let actualRightValues = clActualRightValues.ToHostAndFree processor - let actualColumns = clActualColumns.ToHostAndFree processor - let actualRows = clActualRows.ToHostAndFree processor - - let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = - expand length segmentPointers leftMatrix rightMatrix - - "Left values must be the same" - |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues - - "Right values must be the same" - |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues - - "Columns must be the same" - |> Utils.compareArrays (=) actualColumns expectedColumns - - "Rows must be the same" - |> Utils.compareArrays (=) actualRows expectedRows - -let createExpandTest isEqual (zero: 'a) testFun = - - let testFun = testFun context Utils.defaultWorkGroupSize - - makeExpandTest isEqual zero testFun - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -let expandTests = - [ createExpandTest (=) 0 Expand.expand - - if Utils.isFloat64Available context.ClDevice then - createExpandTest Utils.floatIsEqual 0.0 Expand.expand - - createExpandTest Utils.float32IsEqual 0f Expand.expand - createExpandTest (=) false Expand.expand - createExpandTest (=) 0uy Expand.expand ] - |> testList "Expand.expand" - -let checkGeneralResult zero isEqual actualValues actualColumns actualRows mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = - - let expected = - HostPrimitives.array2DMultiplication zero mul add leftArray rightArray - |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) - |> function Matrix.COO matrix -> matrix | _ -> failwith "format miss" - - printfn $"leftMatrix \n %A{leftArray}" - printfn $"rightMatrix \n %A{rightArray}" - - printfn $"actual values: %A{actualValues}" - printfn $"expected values: %A{expected.Values}" - - printfn $"actualColumns: %A{actualColumns}" - printfn $"expectedColumns: %A{expected.Columns}" - - printfn $"actualRows: %A{actualRows}" - printfn $"expectedRows: %A{expected.Rows}" - - "Values must be the same" - |> Utils.compareArrays isEqual actualValues expected.Values - - "Columns must be the same" - |> Utils.compareArrays (=) actualColumns expected.Columns - - "Rows must be the same" - |> Utils.compareArrays (=) actualRows expected.Rows - -let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = createCSRMatrix leftArray <| isEqual zero - - let rightMatrix = createCSRMatrix rightArray <| isEqual zero - - if leftMatrix.NNZ > 0 - && rightMatrix.NNZ > 0 then - try - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - - let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = - testFun processor HostInterop clLeftMatrix clRightMatrix - - let actualValues = clActualValues.ToHostAndFree processor - let actualColumns = clActualColumns.ToHostAndFree processor - let actualRows = clActualRows.ToHostAndFree processor - - checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray - with - | ex when ex.Message = "InvalidBufferSize" -> () - | _ -> reraise () - -let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = - - let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ - - makeGeneralTest zero isEqual opMul opAdd testFun - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -let generalTests = - [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Expand.run ] - |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs new file mode 100644 index 00000000..5e6c6a8a --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -0,0 +1,264 @@ +module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand + +open Expecto +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Test +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Objects.MatrixExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let createCSRMatrix array isZero = + Utils.createMatrixFromArray2D CSR array isZero + |> Utils.castMatrixToCSR + +let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + Array.map + (fun item -> + rightMatrix.RowPointers.[item + 1] + - rightMatrix.RowPointers.[item]) + leftMatrix.ColumnIndices + |> HostPrimitives.prefixSumExclude + +let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = createCSRMatrix leftArray isZero + + let rightMatrix = createCSRMatrix rightArray isZero + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + + let clRightMatrix = rightMatrix.ToDevice context + + let actualLength, (clActual: ClArray) = + testFun processor clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let actualPointers = clActual.ToHostAndFree processor + + let expectedPointers, expectedLength = + getSegmentsPointers leftMatrix rightMatrix + + "Results lengths must be the same" + |> Expect.equal actualLength expectedLength + + "Result pointers must be the same" + |> Expect.sequenceEqual actualPointers expectedPointers + +let createTest<'a when 'a: struct> (isZero: 'a -> bool) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize + + makeTest isZero testFun + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let getSegmentsTests = + [ createTest ((=) 0) Expand.getSegmentPointers + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) Expand.getSegmentPointers + + createTest ((=) 0f) Expand.getSegmentPointers + createTest ((=) false) Expand.getSegmentPointers + createTest ((=) 0uy) Expand.getSegmentPointers ] + |> testList "get segment pointers" + +let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + let extendPointers pointers = + Array.pairwise pointers + |> Array.map (fun (fst, snd) -> snd - fst) + |> Array.mapi (fun index length -> Array.create length index) + |> Array.concat + + let segmentsLengths = + Array.append segmentPointers [| length |] + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let leftMatrixValues, expectedRows = + let tripleFst (fst, _, _) = fst + + Array.zip3 segmentsLengths leftMatrix.Values + <| extendPointers leftMatrix.RowPointers + // select items each segment length not zero + |> Array.filter (tripleFst >> ((=) 0) >> not) + |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) + |> Array.unzip + + let rightMatrixValues, expectedColumns = + let valuesAndColumns = + Array.zip rightMatrix.Values rightMatrix.ColumnIndices + + Array.map2 + (fun column length -> + let rowStart = rightMatrix.RowPointers.[column] + Array.take length valuesAndColumns.[rowStart..]) + leftMatrix.ColumnIndices + segmentsLengths + |> Array.concat + |> Array.unzip + + leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows + +let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + createCSRMatrix leftArray <| isEqual zero + + let rightMatrix = + createCSRMatrix rightArray <| isEqual zero + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let segmentPointers, length = + getSegmentsPointers leftMatrix rightMatrix + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + let clSegmentPointers = context.CreateClArray segmentPointers + + let ((clActualLeftValues: ClArray<'a>), + (clActualRightValues: ClArray<'a>), + (clActualColumns: ClArray), + (clActualRows: ClArray)) = + testFun processor length clSegmentPointers clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + clSegmentPointers.Free processor + + let actualLeftValues = + clActualLeftValues.ToHostAndFree processor + + let actualRightValues = + clActualRightValues.ToHostAndFree processor + + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor + + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = + expand length segmentPointers leftMatrix rightMatrix + + "Left values must be the same" + |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues + + "Right values must be the same" + |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expectedColumns + + "Rows must be the same" + |> Utils.compareArrays (=) actualRows expectedRows + +let createExpandTest isEqual (zero: 'a) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize + + makeExpandTest isEqual zero testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +// expand phase tests +let expandTests = + [ createExpandTest (=) 0 Expand.expand + + if Utils.isFloat64Available context.ClDevice then + createExpandTest Utils.floatIsEqual 0.0 Expand.expand + + createExpandTest Utils.float32IsEqual 0f Expand.expand + createExpandTest (=) false Expand.expand + createExpandTest (=) 0uy Expand.expand ] + |> testList "Expand.expand" + +let checkGeneralResult zero isEqual (actualMatrix: Matrix<'a>) mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = + + let expected = + HostPrimitives.array2DMultiplication zero mul add leftArray rightArray + |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) + + match actualMatrix, expected with + | Matrix.COO actualMatrix, Matrix.COO expected -> + + "Values must be the same" + |> Utils.compareArrays isEqual actualMatrix.Values expected.Values + + "Columns must be the same" + |> Utils.compareArrays (=) actualMatrix.Columns expected.Columns + + "Rows must be the same" + |> Utils.compareArrays (=) actualMatrix.Rows expected.Rows + | _ -> failwith "Matrix format are not matching" + +let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + try + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clMatrixActual: ClMatrix<_>) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + let matrixActual = clMatrixActual.ToHost processor + clMatrixActual.Dispose processor + + checkGeneralResult zero isEqual matrixActual opMul opAdd leftArray rightArray + with + | ex when ex.Message = "InvalidBufferSize" -> () + | _ -> reraise () + +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize opAddQ opMulQ + + makeGeneralTest zero isEqual opMul opAdd testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest + 0.0 + Utils.floatIsEqual + ArithmeticOperations.floatAdd + ArithmeticOperations.floatMul + Matrix.SpGeMM.expand + + createGeneralTest + 0.0f + Utils.float32IsEqual + ArithmeticOperations.float32Add + ArithmeticOperations.float32Mul + Matrix.SpGeMM.expand + createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] + |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs similarity index 91% rename from tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs rename to tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs index 236f0973..7304b96e 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.Mxm +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGeMM.Masked open Expecto open Expecto.Logging @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Test -let logger = Log.create "Mxm.Tests" +let logger = Log.create "SpGeMM.Masked.Tests" let context = defaultContext.ClContext let workGroupSize = Utils.defaultWorkGroupSize @@ -79,7 +79,7 @@ let tests = let mult = <@ fun x y -> Some(x * y) @> let mxmFun = - Matrix.mxm add mult context workGroupSize + Matrix.SpGeMM.masked add mult context workGroupSize makeTest context q 0 (=) (+) (*) mxmFun |> testPropertyWithConfig config (getCorrectnessTestName "int") @@ -105,8 +105,8 @@ let tests = res @> let mxmFun = - Matrix.mxm logicalOr logicalAnd context workGroupSize + Matrix.SpGeMM.masked logicalOr logicalAnd context workGroupSize makeTest context q false (=) (||) (&&) mxmFun |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] - |> testList "Mxm tests" + |> testList "SpGeMM masked tests" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index ae4e742d..b1dc6c04 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,108 +1,95 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Tests.Matrix +open GraphBLAS.FSharp.Tests +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Map.notTests + Matrix.Map.addTests + Matrix.Map.mulTests + Matrix.Transpose.tests + + Matrix.SpGeMM.Masked.tests + Matrix.SpGeMM.Expand.generalTests ] + |> testSequenced + +let commonTests = + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.sequentialTest + Common.Reduce.ByKey.sequentialSegmentTests + Common.Reduce.ByKey.oneWorkGroupTest + Common.Reduce.ByKey.testsByKey2DSegmentsSequentialOption + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] -// [] -// let allTests = -// testList -// "All tests" -// [ Matrix.SpGEMM.Expand.processPositionsTest -// Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest -// Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest -// Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest -// Matrix.SpGEMM.Expand.multiplicationTest -// Matrix.SpGEMM.Expand.runExtendTest ] - // |> testSequenced + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.PrefixSum.tests + Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.allTests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.testByKeys + Common.Sort.Radix.testKeysOnly ] + + testList + "Common tests" + [ clArrayTests + sortTests + reduceTests + Common.Scatter.allTests + Common.Gather.allTests ] + |> testSequenced + +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Map.notTests -// Matrix.Map.addTests -// Matrix.Map.mulTests -// Matrix.Mxm.tests -// Matrix.Transpose.tests ] -// |> testSequenced -// -// let commonTests = -// let reduceTests = -// testList -// "Reduce" -// [ Common.Reduce.ByKey.sequentialTest -// Common.Reduce.ByKey.sequentialSegmentTests -// Common.Reduce.ByKey.oneWorkGroupTest -// Common.Reduce.Reduce.tests -// Common.Reduce.Sum.tests ] -// -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.PrefixSum.tests -// Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.tests ] -// -// let sortTests = -// testList -// "Sort" -// [ Common.Sort.Bitonic.tests -// Common.Sort.Radix.testsByKeys -// Common.Sort.Radix.testKeysOnly ] -// -// testList -// "Common tests" -// [ clArrayTests -// sortTests -// reduceTests -// Common.Scatter.tests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced -// [] let allTests = testList "All tests" - [ // SpGeMM.expandTests - SpGeMM.generalTests - // Common.Gather.initTests - // Common.ClArray.Choose.tests2 ] - // Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] - ] + [ matrixTests + vectorTests + commonTests + algorithmsTests ] |> testSequenced [] let main argv = allTests |> runTestsWithCLIArgs [] argv - - From 420e2b8e33f83245d3f5c3a377d43335db8a7572 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 14:34:24 +0300 Subject: [PATCH 055/143] refactor: Helpers --- tests/GraphBLAS-sharp.Tests/Helpers.fs | 30 +++++++------------------- 1 file changed, 8 insertions(+), 22 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 6c0f779a..c45a2674 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -177,32 +177,18 @@ module HostPrimitives = |> Array.choose id let reduceByKey keys value reduceOp = - let zipped = Array.zip keys value - - Array.distinct keys + Array.zip keys value + |> Array.groupBy fst |> Array.map - (fun key -> - // extract elements corresponding to key - (key, - Array.map snd - <| Array.filter ((=) key << fst) zipped)) - // reduce elements - |> Array.map (fun (key, values) -> key, Array.reduce reduceOp values) + (fun (key, array) -> + Array.map snd array + |> Array.reduce reduceOp + |> fun value -> key, value) |> Array.unzip let scanByKey scan keysAndValues = - // select keys - Array.map fst keysAndValues - // get unique keys - |> Array.distinct - |> Array.map - (fun key -> - // select with certain key - Array.filter (fst >> ((=) key)) keysAndValues - // get values - |> Array.map snd - // scan values and get only values without sum - |> (fst << scan)) + Array.groupBy fst keysAndValues + |> Array.map (fun (_, array) -> Array.map snd array |> scan |> fst) |> Array.concat module Context = From 95fea31311c3b68f5b8b64be30ec8fdba849095c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 17:00:26 +0300 Subject: [PATCH 056/143] refactor: duplication, allTests in Reduce --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 9 +++---- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 21 ++++------------ .../Quotes/Arithmetic.fs | 2 +- .../Quotes/Predicates.fs | 12 ++++++++++ .../Common/Reduce/ReduceByKey.fs | 24 +++++++++++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 5 +--- 6 files changed, 39 insertions(+), 34 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 8275c434..5db339a7 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -6,6 +6,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Quotes module ClArray = let init (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = @@ -167,16 +168,12 @@ module ClArray = let getUniqueBitmapFirstOccurrence clContext = getUniqueBitmapGeneral - <| <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> - gid = 0 - || inputArray.[gid - 1] <> inputArray.[gid] @> + <| Predicates.firstOccurrence () <| clContext let getUniqueBitmapLastOccurrence clContext = getUniqueBitmapGeneral - <| <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> - gid = length - 1 - || inputArray.[gid] <> inputArray.[gid + 1] @> + <| Predicates.lastOccurrence () <| clContext ///Remove duplicates form the given array. diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 4146ea0c..d6113206 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -1,20 +1,9 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Quotes module internal Scatter = - let private firstOccurencePredicate () = - <@ fun gid _ (positions: ClArray) -> - // first occurrence condition - (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> - - let private lastOccurrencePredicate () = - <@ fun gid positionsLength (positions: ClArray) -> - // last occurrence condition - (gid = positionsLength - 1 - || positions.[gid] <> positions.[gid + 1]) @> - - let private general<'a> predicate (clContext: ClContext) workGroupSize = let run = @@ -75,7 +64,7 @@ module internal Scatter = /// /// let firstOccurrence clContext = - general <| firstOccurencePredicate () <| clContext + general <| Predicates.firstOccurrence () <| clContext /// /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array @@ -96,7 +85,7 @@ module internal Scatter = /// /// let lastOccurrence clContext = - general <| lastOccurrencePredicate () <| clContext + general <| Predicates.lastOccurrence () <| clContext let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = @@ -156,7 +145,7 @@ module internal Scatter = /// Maps global id to a value let initFirsOccurrence<'a> valueMap = generalInit<'a> - <| firstOccurencePredicate () + <| Predicates.firstOccurrence () <| valueMap /// @@ -180,5 +169,5 @@ module internal Scatter = /// Maps global id to a value let initLastOccurrence<'a> valueMap = generalInit<'a> - <| lastOccurrencePredicate () + <| Predicates.lastOccurrence () <| valueMap diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 692455da..5e0ba6c4 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -159,7 +159,7 @@ module ArithmeticOperations = // multiplication let intMul = createPair 0 (*) <@ (*) @> - let boolMul = createPair false (&&) <@ (&&) @> + let boolMul = createPair true (&&) <@ (&&) @> let floatMul = createPair 0.0 (*) <@ (*) @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs index ad2c4165..97641e18 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs @@ -1,8 +1,20 @@ namespace GraphBLAS.FSharp.Backend.Quotes +open Brahma.FSharp + module Predicates = let isSome<'a> = <@ fun (item: 'a option) -> match item with | Some _ -> true | _ -> false @> + + let inline lastOccurrence () = + <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> + gid = length - 1 + || inputArray.[gid] <> inputArray.[gid + 1] @> + + let inline firstOccurrence () = + <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> + gid = 0 + || inputArray.[gid - 1] <> inputArray.[gid] @> diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index e50b34ed..79e76ae4 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -15,17 +15,17 @@ let processor = Context.defaultContext.Queue let config = Utils.defaultConfig -let getOffsets array = +let private getOffsets array = Array.map fst array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let getOffsets2D array = +let private getOffsets2D array = Array.map (fun (fst, snd, _) -> fst, snd) array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let checkResult isEqual actualKeys actualValues keys values reduceOp = +let private checkResult isEqual actualKeys actualValues keys values reduceOp = let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp @@ -36,7 +36,7 @@ let checkResult isEqual actualKeys actualValues keys values reduceOp = "Values must the same" |> Utils.compareArrays isEqual actualValues expectedValues -let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = +let private makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let keys, values = Array.sortBy fst arrayAndKeys |> Array.unzip @@ -60,7 +60,7 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = checkResult isEqual actualKeys actualValues keys values reduceOp -let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = +let private createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ @@ -339,7 +339,7 @@ let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp redu arbitrary = [ typeof ] } $"test on {typeof<'a>}" -let sequentialSegmentTests2D = +let sequentialSegment2DTests = let addTests = testList "add tests" @@ -446,7 +446,7 @@ let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = arbitrary = [ typeof ] } $"test on {typeof<'a>}" -let testsByKey2DSegmentsSequentialOption = +let testsSegmentsSequential2DOption = [ createTest2DOption (=) ArithmeticOperations.intAdd if Utils.isFloat64Available context.ClDevice then @@ -455,3 +455,13 @@ let testsByKey2DSegmentsSequentialOption = createTest2DOption Utils.float32IsEqual ArithmeticOperations.float32Add createTest2DOption (=) ArithmeticOperations.boolAdd ] |> testList "2D option" + +let allTests = + testList + "Reduce.ByKey" + [ sequentialTest + oneWorkGroupTest + sequentialSegmentTests + sequential2DTest + sequentialSegment2DTests + testsSegmentsSequential2DOption ] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index b1dc6c04..a5a7a469 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -23,10 +23,7 @@ let commonTests = let reduceTests = testList "Reduce" - [ Common.Reduce.ByKey.sequentialTest - Common.Reduce.ByKey.sequentialSegmentTests - Common.Reduce.ByKey.oneWorkGroupTest - Common.Reduce.ByKey.testsByKey2DSegmentsSequentialOption + [ Common.Reduce.ByKey.allTests Common.Reduce.Reduce.tests Common.Reduce.Sum.tests ] From c5fa0d0628ade6bf1474dd5eec988410470f17e9 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 17:42:27 +0300 Subject: [PATCH 057/143] refactor: ClArray.Free and *.FreeAndWait --- .../GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs | 2 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 8 ++++++-- .../Objects/ArraysExtentions.fs | 4 ++-- src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 2 +- src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs | 8 ++++---- .../Common/Reduce/ReduceByKey.fs | 14 +++++++------- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 3 +-- 7 files changed, 22 insertions(+), 19 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index 95d25fc9..283cbcc2 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs @@ -83,7 +83,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : (matrix :> IDeviceMemObject).Dispose this.Processor member this.ClearResult() = - this.ResultVector.Free this.Processor + this.ResultVector.FreeAndWait this.Processor member this.ReadMatrix() = let matrixReader = this.InputMatrixReader diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index d6113206..4f51cb93 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -64,7 +64,9 @@ module internal Scatter = /// /// let firstOccurrence clContext = - general <| Predicates.firstOccurrence () <| clContext + general + <| Predicates.firstOccurrence () + <| clContext /// /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array @@ -85,7 +87,9 @@ module internal Scatter = /// /// let lastOccurrence clContext = - general <| Predicates.lastOccurrence () <| clContext + general + <| Predicates.lastOccurrence () + <| clContext let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index 4a35e2e0..29aad544 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -4,7 +4,7 @@ open Brahma.FSharp module ArraysExtensions = type ClArray<'a> with - member this.Free(q: MailboxProcessor) = + member this.FreeAndWait(q: MailboxProcessor) = q.Post(Msg.CreateFreeMsg this) q.PostAndReply(Msg.MsgNotifyMe) @@ -12,7 +12,7 @@ module ArraysExtensions = let dst = Array.zeroCreate this.Length q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) - // member this.Free(q: MailboxProcessor<_>) = q.Post <| Msg.CreateFreeMsg this TODO() + member this.Free(q: MailboxProcessor<_>) = q.Post <| Msg.CreateFreeMsg this member this.ToHostAndFree(q: MailboxProcessor<_>) = let result = this.ToHost q diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index c1d75282..fb8cdcc8 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -34,4 +34,4 @@ type ClVector<'a when 'a: struct> = member this.Dispose(q) = match this with | Sparse vector -> vector.Dispose(q) - | Dense vector -> vector.Free(q) + | Dense vector -> vector.FreeAndWait(q) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs index 97641e18..74fda243 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs @@ -11,10 +11,10 @@ module Predicates = let inline lastOccurrence () = <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> - gid = length - 1 - || inputArray.[gid] <> inputArray.[gid + 1] @> + gid = length - 1 + || inputArray.[gid] <> inputArray.[gid + 1] @> let inline firstOccurrence () = <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> - gid = 0 - || inputArray.[gid - 1] <> inputArray.[gid] @> + gid = 0 + || inputArray.[gid - 1] <> inputArray.[gid] @> diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 79e76ae4..41760d02 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -458,10 +458,10 @@ let testsSegmentsSequential2DOption = let allTests = testList - "Reduce.ByKey" - [ sequentialTest - oneWorkGroupTest - sequentialSegmentTests - sequential2DTest - sequentialSegment2DTests - testsSegmentsSequential2DOption ] + "Reduce.ByKey" + [ sequentialTest + oneWorkGroupTest + sequentialSegmentTests + sequential2DTest + sequentialSegment2DTests + testsSegmentsSequential2DOption ] diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 2f7c5149..db42fd9d 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -77,8 +77,7 @@ let correctnessGenericTest (ClMatrix.CSR m).Dispose q v.Free q - let hostRes = res.ToHost q - res.Free q + let hostRes = res.ToHostAndFree q checkResult isEqual sumOp mulOp zero matrix vector hostRes | _ -> failwith "Impossible" From 6ff19713c52247adda20ddcf8be582a2c2a9aba4 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 23:36:12 +0300 Subject: [PATCH 058/143] refactor: remove use in test --- .../Common/ClArray/Copy.fs | 10 ++++------ .../Common/ClArray/PrefixSum.fs | 7 ++++--- .../Common/ClArray/Replicate.fs | 10 ++++------ .../Common/Reduce/Reduce.fs | 12 +++++------ .../Common/Reduce/Sum.fs | 10 ++++++---- .../Common/Sort/Bitonic.fs | 20 +++++++------------ .../Matrix/SpGeMM/Expand.fs | 4 +++- 7 files changed, 33 insertions(+), 40 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs index dcf4ed83..e4e261d3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs @@ -7,6 +7,7 @@ open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "ClArray.Copy.Tests" @@ -20,13 +21,10 @@ let config = Utils.defaultConfig let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = if array.Length > 0 then - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array - let actual = - use clActual: ClArray<'a> = copyFun q HostInterop clArray - - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = (copyFun q HostInterop clArray: ClArray<_>).ToHostAndFree q + clArray.Free q logger.debug ( eventX "Actual is {actual}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs index 3c8bedee..faab8893 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "ClArray.PrefixSum.Tests" @@ -28,12 +29,12 @@ let makeTest plus zero isEqual scan (array: 'a []) = ) let actual, actualSum = - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array let (total: ClCell<_>) = scan q clArray zero - let actual = Array.zeroCreate<'a> clArray.Length + let actual = clArray.ToHostAndFree q let actualSum = total.ToHostAndFree(q) - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clArray, actual, ch)), actualSum + actual, actualSum logger.debug ( eventX "Actual is {actual}\n" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs index c7067df5..2df5858c 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs @@ -7,6 +7,7 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "Replicate.Tests" @@ -20,13 +21,10 @@ let config = Utils.defaultConfig let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = if array.Length > 0 && i > 0 then - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array - let actual = - use clActual: ClArray<'a> = replicateFun q HostInterop clArray i - - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = (replicateFun q HostInterop clArray i: ClArray<'a>).ToHostAndFree q + clArray.Free q logger.debug ( eventX $"Actual is {actual}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs index 3d365f27..d6d47640 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs @@ -6,6 +6,8 @@ open Expecto.Logging.Message open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "Reduce.Tests" @@ -28,15 +30,11 @@ let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zer ) let actualSum = - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array let total = reduce clArray - let actualSum = [| zero |] - - let sum = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) - - sum.[0] + clArray.Free q + total.ToHostAndFree q logger.debug ( eventX "Actual is {actual}\n" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs index c779ea07..e094d572 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs @@ -8,6 +8,8 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests open FSharp.Quotations open Context +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell let logger = Log.create "Sum.Test" @@ -27,11 +29,11 @@ let makeTest plus zero sum (array: 'a []) = ) let actualSum = - use clArray = context.CreateClArray array - use total = sum q clArray + let clArray = context.CreateClArray array + let (total: ClCell<_>) = sum q clArray - let actualSum = [| zero |] - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)).[0] + clArray.Free q + total.ToHostAndFree q logger.debug ( eventX "Actual is {actual}\n" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs index 40fcc9f6..60705e76 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Backend.Common open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Bitonic = let logger = Log.create "BitonicSort.Tests" @@ -32,22 +33,16 @@ module Bitonic = let rows, cols, vals = Array.unzip3 array - use clRows = context.CreateClArray rows - use clColumns = context.CreateClArray cols - use clValues = context.CreateClArray vals + let clRows = context.CreateClArray rows + let clColumns = context.CreateClArray cols + let clValues = context.CreateClArray vals let actualRows, actualCols, actualValues = sort q clRows clColumns clValues - let rows = Array.zeroCreate<'n> clRows.Length - let columns = Array.zeroCreate<'n> clColumns.Length - let values = Array.zeroCreate<'a> clValues.Length - - q.Post(Msg.CreateToHostMsg(clRows, rows)) - q.Post(Msg.CreateToHostMsg(clColumns, columns)) - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) - |> ignore + let rows = clRows.ToHostAndFree q + let columns = clColumns.ToHostAndFree q + let values = clValues.ToHostAndFree q rows, columns, values @@ -80,7 +75,6 @@ module Bitonic = testFixtures testFixtures - testFixtures testFixtures ] |> testList "Backend.Common.BitonicSort tests" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 5e6c6a8a..104c01a7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -22,7 +22,9 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] + endSize = 500 + maxTest = 100 } let createCSRMatrix array isZero = Utils.createMatrixFromArray2D CSR array isZero From 048477dfea0fb437547ad54ef51c0df3ff2aed52 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 23:38:23 +0300 Subject: [PATCH 059/143] refactor: formatting --- src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj | 4 ---- tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs | 5 ++++- tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs | 5 ++++- tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj | 4 ---- 4 files changed, 8 insertions(+), 10 deletions(-) diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index 97538119..96e59d55 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -31,10 +31,6 @@ - Always diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs index e4e261d3..2c8d2ba2 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs @@ -23,7 +23,10 @@ let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = if array.Length > 0 then let clArray = context.CreateClArray array - let actual = (copyFun q HostInterop clArray: ClArray<_>).ToHostAndFree q + let actual = + (copyFun q HostInterop clArray: ClArray<_>) + .ToHostAndFree q + clArray.Free q logger.debug ( diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs index 2df5858c..0299eb05 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs @@ -23,7 +23,10 @@ let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = if array.Length > 0 && i > 0 then let clArray = context.CreateClArray array - let actual = (replicateFun q HostInterop clArray i: ClArray<'a>).ToHostAndFree q + let actual = + (replicateFun q HostInterop clArray i: ClArray<'a>) + .ToHostAndFree q + clArray.Free q logger.debug ( diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 3d9f4d63..26bebb7d 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -31,10 +31,6 @@ - - - - From 4d26023e7fc85f7baa0ed0025f528dbda8e90a9c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 23:50:44 +0300 Subject: [PATCH 060/143] refactor: formatting --- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 104c01a7..84d5b943 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -36,7 +36,7 @@ let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b rightMatrix.RowPointers.[item + 1] - rightMatrix.RowPointers.[item]) leftMatrix.ColumnIndices - |> HostPrimitives.prefixSumExclude + |> HostPrimitives.prefixSumExclude 0 (+) let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = From cf7cc1d553fce6f6929fb5d0d5be83900e9ee7a1 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Apr 2023 11:54:15 +0300 Subject: [PATCH 061/143] refactor: expand endSize --- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 84d5b943..e3e732fd 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -23,7 +23,7 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with arbitrary = [ typeof ] - endSize = 500 + endSize = 100 maxTest = 100 } let createCSRMatrix array isZero = From fdb904110f7cf74a175455de2ed6c54811ca6afa Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Apr 2023 15:50:55 +0300 Subject: [PATCH 062/143] refactor: Scatter.test memory release --- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index e3f16eb4..a72de22b 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -34,7 +34,7 @@ let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (r scatter q clPositions clValues clResult clValues.Free q - clValues.Free q + clPositions.Free q clResult.ToHostAndFree q $"Arrays should be equal." @@ -81,9 +81,8 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: scatter q clPositions clResult - let actual = clResult.ToHostAndFree q clPositions.Free q - clResult.Free q + let actual = clResult.ToHostAndFree q $"Arrays should be equal." |> Utils.compareArrays (=) actual expected From a6ebc30e76573995f02cf905f1c54f21c5179a60 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Apr 2023 20:51:43 +0300 Subject: [PATCH 063/143] refactor: tests, names --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 50 +++++++++---------- .../Common/Reduce/ReduceByKey.fs | 10 ++-- .../Common/Scan/PrefixSum.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 4 +- .../Matrix/SpGeMM/Expand.fs | 14 +++--- 5 files changed, 39 insertions(+), 41 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 71f5fff9..37cefdce 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -139,37 +139,37 @@ module Expand = let expandRowPointers = Common.expandRowPointers clContext workGroupSize - let AGather = Gather.run clContext workGroupSize + let leftMatrixGather = Gather.run clContext workGroupSize - let BGather = Gather.run clContext workGroupSize + let rightMatrixGather = Gather.run clContext workGroupSize fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - // Compute A positions - let APositions = zeroCreate processor DeviceOnly lengths + // Compute left matrix positions + let leftMatrixPositions = zeroCreate processor DeviceOnly lengths - idScatter processor segmentsPointers APositions + idScatter processor segmentsPointers leftMatrixPositions - (maxPrefixSum processor APositions 0) + (maxPrefixSum processor leftMatrixPositions 0) .Free processor - // Compute B positions - let BPositions = create processor DeviceOnly lengths 1 + // Compute right matrix positions + let rightMatrixPositions = create processor DeviceOnly lengths 1 - let requiredBPointers = + let requiredRightMatrixPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length - gather processor leftMatrix.Columns rightMatrix.RowPointers requiredBPointers + gather processor leftMatrix.Columns rightMatrix.RowPointers requiredRightMatrixPointers - scatter processor segmentsPointers requiredBPointers BPositions + scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions - requiredBPointers.Free processor + requiredRightMatrixPointers.Free processor // another way to get offsets ??? let offsets = removeDuplicates processor segmentsPointers - segmentPrefixSum processor offsets.Length BPositions APositions offsets + segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets offsets.Free processor @@ -177,37 +177,37 @@ module Expand = let columns = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - gather processor BPositions rightMatrix.Columns columns + gather processor rightMatrixPositions rightMatrix.Columns columns // compute rows - let ARows = + let leftMatrixRows = expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount let rows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - gather processor APositions ARows rows + gather processor leftMatrixPositions leftMatrixRows rows - ARows.Free processor + leftMatrixRows.Free processor - // compute leftMatrix values - let AValues = + // compute left matrix values + let leftMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - AGather processor APositions leftMatrix.Values AValues + leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues - APositions.Free processor + leftMatrixPositions.Free processor // compute right matrix values - let BValues = + let rightMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - BGather processor BPositions rightMatrix.Values BValues + rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues - BPositions.Free processor + rightMatrixPositions.Free processor // left, right matrix values, columns and rows indices - AValues, BValues, columns, rows + leftMatrixValues, rightMatrixValues, columns, rows let sortByColumnsAndRows (clContext: ClContext) workGroupSize = diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 41760d02..09e0b21a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -15,17 +15,17 @@ let processor = Context.defaultContext.Queue let config = Utils.defaultConfig -let private getOffsets array = +let getOffsets array = Array.map fst array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let private getOffsets2D array = +let getOffsets2D array = Array.map (fun (fst, snd, _) -> fst, snd) array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let private checkResult isEqual actualKeys actualValues keys values reduceOp = +let checkResult isEqual actualKeys actualValues keys values reduceOp = let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp @@ -36,7 +36,7 @@ let private checkResult isEqual actualKeys actualValues keys values reduceOp = "Values must the same" |> Utils.compareArrays isEqual actualValues expectedValues -let private makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = +let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let keys, values = Array.sortBy fst arrayAndKeys |> Array.unzip @@ -60,7 +60,7 @@ let private makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = checkResult isEqual actualKeys actualValues keys values reduceOp -let private createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = +let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs index f76a0258..734b96f9 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs @@ -33,7 +33,7 @@ let makeTest plus zero isEqual scan (array: 'a []) = let (total: ClCell<_>) = scan q clArray zero let actual = clArray.ToHostAndFree q - let actualSum = total.ToHostAndFree(q) + let actualSum = total.ToHostAndFree q actual, actualSum logger.debug ( diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 93c13eb3..08c2fc27 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -254,9 +254,7 @@ module HostPrimitives = // add and filter |> Array.map Some |> Array.fold add None - |> function - | Some value -> value - | None -> zero + |> Option.defaultValue zero let scanByKey scan keysAndValues = Array.groupBy fst keysAndValues diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index e3e732fd..00ce048d 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -67,23 +67,23 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = "Result pointers must be the same" |> Expect.sequenceEqual actualPointers expectedPointers -let createTest<'a when 'a: struct> (isZero: 'a -> bool) testFun = +let createTest<'a when 'a: struct> (isZero: 'a -> bool) = let testFun = - testFun context Utils.defaultWorkGroupSize + Expand.getSegmentPointers context Utils.defaultWorkGroupSize makeTest isZero testFun |> testPropertyWithConfig config $"test on {typeof<'a>}" let getSegmentsTests = - [ createTest ((=) 0) Expand.getSegmentPointers + [ createTest ((=) 0) if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) Expand.getSegmentPointers + createTest ((=) 0.0) - createTest ((=) 0f) Expand.getSegmentPointers - createTest ((=) false) Expand.getSegmentPointers - createTest ((=) 0uy) Expand.getSegmentPointers ] + createTest ((=) 0f) + createTest ((=) false) + createTest ((=) 0uy) ] |> testList "get segment pointers" let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = From 7e0d0603773c02bbccb2fe9b1710bc75c79fb3b7 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 13 Apr 2023 14:43:03 +0300 Subject: [PATCH 064/143] add: ClArray.chunk* --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 83 +++++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 1 + src/GraphBLAS-sharp.Backend/Matrix/Split.fs | 22 +++++ 3 files changed, 106 insertions(+) create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/Split.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index aace2a48..64da52d9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -1,5 +1,6 @@ namespace GraphBLAS.FSharp.Backend.Common +open System.Collections.Generic open Brahma.FSharp open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext @@ -329,3 +330,85 @@ module ClArray = scatter processor positions values result result + + let getChunk (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) startIndex endIndex (sourceArray: ClArray<'a>) (targetChunk: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + let sourcePosition = gid + startIndex + + if sourcePosition < endIndex then + + targetChunk.[gid] <- sourceArray.[sourcePosition] @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) startIndex endIndex -> + if startIndex < 0 then failwith "" + if startIndex >= endIndex then failwith "" // empty array + if endIndex > sourceArray.Length then failwith "" // TODO() + + let resultLength = endIndex - startIndex + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange startIndex endIndex sourceArray result) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + result + + /// + /// Lazy divides the input array into chunks of size at most chunkSize. + /// + /// Cl context. + /// Work group size. + /// + /// Since calculations are performed lazily, the array should not change. + /// + let lazyChunkBySize (clContext: ClContext) workGroupSize = + + let getChunk = + getChunk clContext workGroupSize + + // TODO(immutable array) + fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + if chunkSize <= 0 then failwith "" + + let chunkCount = (sourceArray.Length - 1) / chunkSize + 1 + + let getChunk = getChunk processor allocationMode sourceArray + + seq { + for i in 0 .. chunkCount do + let startIndex = i * chunkSize + let endIndex = max (startIndex + chunkSize) sourceArray.Length + + yield lazy ( getChunk startIndex endIndex ) + } + + /// + /// Divides the input array into chunks of size at most chunkSize. + /// + /// Cl context. + /// Work group size. + let chunkBySize (clContext: ClContext) workGroupSize = + + let chunkBySizeLazy = + lazyChunkBySize clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + chunkBySizeLazy processor allocationMode chunkSize sourceArray + |> Seq.map (fun lazyValue -> lazyValue.Value) + |> Seq.toArray diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index b8ca8ba0..85db1a0b 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -36,6 +36,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Split.fs b/src/GraphBLAS-sharp.Backend/Matrix/Split.fs new file mode 100644 index 00000000..43ea1197 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/Split.fs @@ -0,0 +1,22 @@ +module GraphBLAS.FSharp.Backend.Matrix + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Quotes +open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClContext + +module Split = + let toCOO (clContext: ClContext) workGroupSize = + + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + // endIndex exclusive (for csr matrix row pointers interop), startIndex inclusive + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) startIndex endIndex -> + + () From babe90e18d66f1b4fb19e73bc06ba18ab1b13895 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 13 Apr 2023 22:52:31 +0300 Subject: [PATCH 065/143] add: Split --- src/GraphBLAS-sharp.Backend/Matrix/Split.fs | 73 ++++++++++++++++++--- 1 file changed, 63 insertions(+), 10 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Split.fs b/src/GraphBLAS-sharp.Backend/Matrix/Split.fs index 43ea1197..33761660 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Split.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Split.fs @@ -2,21 +2,74 @@ module GraphBLAS.FSharp.Backend.Matrix open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Backend.Quotes -open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix -open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +// type lazy matrix ??? module Split = - let toCOO (clContext: ClContext) workGroupSize = + module ByChunk = + let runCOOLazy (clContext: ClContext) workGroupSize = + + let chunkBySizeValues = ClArray.lazyChunkBySize clContext workGroupSize + + let chunkBySizeIndices = ClArray.lazyChunkBySize clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode chunkSize (matrix: ClMatrix.COO<'a>) -> + + let createSubMatrixLazy (values: Lazy<_>) (columns: Lazy<_>) (rows: Lazy<_>) = + lazy + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows.Value + Columns = columns.Value + Values = values.Value } + + let values = chunkBySizeValues processor allocationMode chunkSize matrix.Values + let columns = chunkBySizeIndices processor allocationMode chunkSize matrix.Columns + let rows = chunkBySizeIndices processor allocationMode chunkSize matrix.Rows + + Seq.map3 createSubMatrixLazy values columns rows + + let runCOO (clContext: ClContext) workGroupSize = + + let run = runCOOLazy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode chunkSize (matrix: ClMatrix.COO<'a>) -> + run processor allocationMode chunkSize matrix + |> Seq.map (fun lazyMatrix -> lazyMatrix.Value) + |> Seq.toArray + + module ByRow = + let runCSRLazy (clContext: ClContext) workGroupSize = + + let getChunkValues = ClArray.getChunk clContext workGroupSize + + let getChunkIndices = ClArray.getChunk clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + + let getChunkValues = getChunkValues processor allocationMode matrix.Values + let getChunkIndices = getChunkIndices processor allocationMode matrix.Columns + + matrix.RowPointers.ToHost processor + |> Seq.pairwise + |> Seq.map (fun (first, second) -> + lazy + if second - first > 0 then + let values = getChunkValues first second + let columns = getChunkIndices first second - let copy = ClArray.copy clContext workGroupSize + Some (values, columns) + else None) - let copyData = ClArray.copy clContext workGroupSize + let runCSR (clContext: ClContext) workGroupSize = - // endIndex exclusive (for csr matrix row pointers interop), startIndex inclusive - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) startIndex endIndex -> + let runLazy = runCSRLazy clContext workGroupSize - () + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + runLazy processor allocationMode matrix + |> Seq.map (fun lazyValue -> lazyValue.Value) + |> Seq.toArray From b30a9f897755c312f6463921925e075d1b4c76e2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 14 Apr 2023 00:33:36 +0300 Subject: [PATCH 066/143] add: ClArray.chunk* tests --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 15 +- .../GraphBLAS-sharp.Backend.fsproj | 2 +- src/GraphBLAS-sharp.Backend/Matrix/Split.fs | 65 ++++++- .../Common/ClArray/chunkBySize.fs | 107 ++++++++++ tests/GraphBLAS-sharp.Tests/Generators.fs | 57 ++++++ .../GraphBLAS-sharp.Tests.fsproj | 2 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 7 + tests/GraphBLAS-sharp.Tests/Matrix/Split.fs | 4 + tests/GraphBLAS-sharp.Tests/Program.fs | 182 +++++++++--------- 9 files changed, 339 insertions(+), 102 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/ClArray/chunkBySize.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/Split.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 64da52d9..4804d690 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -346,9 +346,9 @@ module ClArray = let kernel = clContext.Compile kernel fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) startIndex endIndex -> - if startIndex < 0 then failwith "" - if startIndex >= endIndex then failwith "" // empty array - if endIndex > sourceArray.Length then failwith "" // TODO() + if startIndex < 0 then failwith "startIndex is less than zero" + if startIndex >= endIndex then failwith "startIndex is greater than or equal to the endIndex" + if endIndex > sourceArray.Length then failwith "endIndex is larger than the size of the array" let resultLength = endIndex - startIndex @@ -382,20 +382,19 @@ module ClArray = let getChunk = getChunk clContext workGroupSize - // TODO(immutable array) fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> - if chunkSize <= 0 then failwith "" + if chunkSize <= 0 then failwith "The size of the piece cannot be less than 1" - let chunkCount = (sourceArray.Length - 1) / chunkSize + 1 + let chunkCount = (sourceArray.Length - 1) / chunkSize let getChunk = getChunk processor allocationMode sourceArray seq { for i in 0 .. chunkCount do let startIndex = i * chunkSize - let endIndex = max (startIndex + chunkSize) sourceArray.Length + let endIndex = min (startIndex + chunkSize) sourceArray.Length - yield lazy ( getChunk startIndex endIndex ) + yield lazy getChunk startIndex endIndex } /// diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 85db1a0b..580d2a5a 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -36,7 +36,6 @@ - @@ -46,6 +45,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Split.fs b/src/GraphBLAS-sharp.Backend/Matrix/Split.fs index 33761660..61fcefd7 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Split.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Split.fs @@ -1,10 +1,11 @@ -module GraphBLAS.FSharp.Backend.Matrix +namespace GraphBLAS.FSharp.Backend.Matrix open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClVector // type lazy matrix ??? @@ -42,7 +43,21 @@ module Split = |> Seq.map (fun lazyMatrix -> lazyMatrix.Value) |> Seq.toArray + // let run (clContext: ClContext) workGroupSize = + // + // let run = runCOOLazy clContext workGroupSize + // + // let runCOO = runCOO clContext workGroupSize + // + // let COOToCSR = COO.Matrix.toCSR clCOntext workGroupSize + // + // fun (processor: MailboxProcessor<_>) allocationMode chunkSize (matrix: ClMatrix<'a>) -> + // match matrix with + // | ClMatrix.COO matrix -> runCOO processor allocationMode chunkSize matrix + // | ClMatrix.COO matrix -> + // () module ByRow = + // MB We can split CSR to chunks without COO representation let runCSRLazy (clContext: ClContext) workGroupSize = let getChunkValues = ClArray.getChunk clContext workGroupSize @@ -54,6 +69,12 @@ module Split = let getChunkValues = getChunkValues processor allocationMode matrix.Values let getChunkIndices = getChunkIndices processor allocationMode matrix.Columns + let creatSparseVector values columns = + { Context = clContext + Indices = columns + Values = values + Size = matrix.ColumnCount } + matrix.RowPointers.ToHost processor |> Seq.pairwise |> Seq.map (fun (first, second) -> @@ -62,7 +83,7 @@ module Split = let values = getChunkValues first second let columns = getChunkIndices first second - Some (values, columns) + Some <| creatSparseVector values columns else None) let runCSR (clContext: ClContext) workGroupSize = @@ -73,3 +94,43 @@ module Split = runLazy processor allocationMode matrix |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray + + module ByColumn = + let runCSRLazy (clContext: ClContext) workGroupSize = + + let getChunkValues = ClArray.getChunk clContext workGroupSize + + let getChunkIndices = ClArray.getChunk clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSC<'a>) -> + + let getChunkValues = getChunkValues processor allocationMode matrix.Values + let getChunkIndices = getChunkIndices processor allocationMode matrix.Rows + + let creatSparseVector values columns = + { Context = clContext + Indices = columns + Values = values + Size = matrix.RowCount } + + matrix.ColumnPointers.ToHost processor + |> Seq.pairwise + |> Seq.map (fun (first, second) -> + lazy + if second - first > 0 then + let values = getChunkValues first second + let rows = getChunkIndices first second + + Some <| creatSparseVector values rows + else None) + + let runCSR (clContext: ClContext) workGroupSize = + + let runLazy = runCSRLazy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSC<'a>) -> + runLazy processor allocationMode matrix + |> Seq.map (fun lazyValue -> lazyValue.Value) + |> Seq.toArray + + diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/chunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/chunkBySize.fs new file mode 100644 index 00000000..92cc2514 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/chunkBySize.fs @@ -0,0 +1,107 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.chunkBySize + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = { Utils.defaultConfig with arbitrary = [ typeof ] } + +let makeTestGetChunk<'a when 'a : equality> testFun (array: 'a [], startPosition: int, endPosition: int) = + + if array.Length > 0 then + + let clArray = context.CreateClArray array + + let (clActual: ClArray<'a>) = + testFun processor HostInterop clArray startPosition endPosition + + clArray.Free processor + let actual = clActual.ToHostAndFree processor + + "Results must be the same" + |> Expect.sequenceEqual actual array.[startPosition .. endPosition - 1] + +let creatTestGetChunk<'a when 'a : equality> = + ClArray.getChunk context Utils.defaultWorkGroupSize + |> makeTestGetChunk<'a> + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let getChunkTests = + [ creatTestGetChunk + + if Utils.isFloat64Available context.ClDevice then + creatTestGetChunk + + creatTestGetChunk + creatTestGetChunk + creatTestGetChunk ] + |> testList "getChunk" + +let makeTestChunkBySize<'a when 'a : equality> isEqual testFun (array: 'a [], chunkSize: uint) = + + let chunkSize = int chunkSize + + if chunkSize > 0 && array.Length > 0 then + + let clArray = context.CreateClArray array + + let clActual: ClArray<'a>[] = + (testFun processor HostInterop chunkSize clArray) + + clArray.Free processor + + let actual = + clActual + |> Array.map (fun clArray -> clArray.ToHostAndFree processor) + + let expected = + Array.chunkBySize chunkSize array + + "Results must be the same" + |> Utils.compareChunksArrays isEqual actual expected + +let creatTestChunkBySize<'a when 'a : equality> isEqual = + ClArray.chunkBySize context Utils.defaultWorkGroupSize + |> makeTestChunkBySize<'a> isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let chunkBySizeTests = + [ creatTestChunkBySize (=) + + if Utils.isFloat64Available context.ClDevice then + creatTestChunkBySize Utils.floatIsEqual + + creatTestChunkBySize Utils.float32IsEqual + creatTestChunkBySize (=) + creatTestChunkBySize (=) ] + |> testList "chanBySize" + +let creatTestChunkBySizeLazy<'a when 'a : equality> isEqual = + (fun processor allocationMode chunkSize array -> + ClArray.lazyChunkBySize context Utils.defaultWorkGroupSize processor allocationMode chunkSize array + |> Seq.map (fun lazyValue -> lazyValue.Value) + |> Seq.toArray) + |> makeTestChunkBySize<'a> isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let lazyChunkBySizeTests = + [ creatTestChunkBySizeLazy (=) + + if Utils.isFloat64Available context.ClDevice then + creatTestChunkBySizeLazy Utils.floatIsEqual + + creatTestChunkBySizeLazy Utils.float32IsEqual + creatTestChunkBySizeLazy (=) + creatTestChunkBySizeLazy (=) ] + |> testList "chunkBySize lazy" + +let allTests = + testList "chunk" [ getChunkTests; chunkBySizeTests; lazyChunkBySizeTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 4182b57a..4e30171a 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -820,3 +820,60 @@ module Generators = static member BoolType() = pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen + + type ArrayAndChunkPositions() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! length = Gen.sized <| fun size -> Gen.choose (1, size) + + let! array = Gen.arrayOfLength length valuesGenerator + + let! endPosition = Gen.choose (1, length - 1) + let! startPosition = Gen.choose (0, endPosition - 1) + + return (array, startPosition, endPosition) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 234c76a1..ac1ace07 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -24,6 +24,7 @@ + @@ -49,6 +50,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c45a2674..19abea82 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -99,6 +99,13 @@ module Utils = Actual value is %A{actual.[i]}, expected %A{expected.[i]}, \n actual: %A{actual} \n expected: %A{expected}" |> failtestf "%s" + let compareChunksArrays areEqual (actual: 'a [][]) (expected: 'a [][]) message = + $"%s{message}. Lengths should be equal. Actual is %A{actual}, expected %A{expected}" + |> Expect.equal actual.Length expected.Length + + for i in 0 .. actual.Length - 1 do + compareArrays areEqual actual.[i] expected.[i] message + let compare2DArrays areEqual (actual: 'a [,]) (expected: 'a [,]) message = $"%s{message}. Lengths should be equal. Actual is %A{actual}, expected %A{expected}" |> Expect.equal actual.Length expected.Length diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Split.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Split.fs new file mode 100644 index 00000000..2c25c9c6 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Split.fs @@ -0,0 +1,4 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.Split + +let makeTest testFun = + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 8532df05..00bdb716 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,96 +1,96 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Map.notTests - Matrix.Map.addTests - Matrix.Map.mulTests - Matrix.Mxm.tests - Matrix.Transpose.tests ] - |> testSequenced - -let commonTests = - let scanTests = - testList - "Scan" - [ Common.Scan.ByKey.sequentialSegmentsTests - Common.Scan.PrefixSum.tests ] - - let reduceTests = - testList - "Reduce" - [ Common.Reduce.ByKey.sequentialTest - Common.Reduce.ByKey.sequentialSegmentTests - Common.Reduce.ByKey.oneWorkGroupTest - Common.Reduce.Reduce.tests - Common.Reduce.Sum.tests ] - - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests ] - - let sortTests = - testList - "Sort" - [ Common.Sort.Bitonic.tests - Common.Sort.Radix.testsByKeys - Common.Sort.Radix.testKeysOnly ] - - testList - "Common tests" - [ clArrayTests - sortTests - reduceTests - scanTests - Common.Scatter.tests ] - |> testSequenced - -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced - -[] -let allTests = - testList - "All tests" - [ matrixTests - commonTests - vectorTests - algorithmsTests ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Map.notTests +// Matrix.Map.addTests +// Matrix.Map.mulTests +// Matrix.Mxm.tests +// Matrix.Transpose.tests ] +// |> testSequenced +// +// let commonTests = +// let scanTests = +// testList +// "Scan" +// [ Common.Scan.ByKey.sequentialSegmentsTests +// Common.Scan.PrefixSum.tests ] +// +// let reduceTests = +// testList +// "Reduce" +// [ Common.Reduce.ByKey.sequentialTest +// Common.Reduce.ByKey.sequentialSegmentTests +// Common.Reduce.ByKey.oneWorkGroupTest +// Common.Reduce.Reduce.tests +// Common.Reduce.Sum.tests ] +// +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.tests ] +// +// let sortTests = +// testList +// "Sort" +// [ Common.Sort.Bitonic.tests +// Common.Sort.Radix.testsByKeys +// Common.Sort.Radix.testKeysOnly ] +// +// testList +// "Common tests" +// [ clArrayTests +// sortTests +// reduceTests +// scanTests +// Common.Scatter.tests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced +// +// [] +// let allTests = +// testList +// "All tests" +// [ matrixTests +// commonTests +// vectorTests +// algorithmsTests ] +// |> testSequenced [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = Common.ClArray.chunkBySize.allTests |> runTestsWithCLIArgs [] argv From 0cfe11281fa5f996d4953296f17a7d8c511d4042 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 14 Apr 2023 15:49:59 +0300 Subject: [PATCH 067/143] add: ClArray.append --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 33 +++++ .../GraphBLAS-sharp.Backend.fsproj | 40 ++---- .../Matrix/{COOMatrix => COO}/Map.fs | 0 .../Matrix/{COOMatrix => COO}/Map2.fs | 0 .../{COOMatrix => COO}/Map2AtLeastOne.fs | 0 .../Matrix/{COOMatrix => COO}/Matrix.fs | 0 .../Matrix/{CSRMatrix => CSR}/GetTuples.fs | 0 .../Matrix/{CSRMatrix => CSR}/Map.fs | 0 .../Matrix/{CSRMatrix => CSR}/Map2.fs | 0 .../{CSRMatrix => CSR}/Map2AtLeastOne.fs | 0 .../Matrix/{CSRMatrix => CSR}/Matrix.fs | 39 +++++ .../Matrix/{CSRMatrix => CSR}/SpGEMM.fs | 0 .../Matrix/{CSRMatrix => CSR}/SpMSpV.fs | 0 .../Matrix/{CSRMatrix => CSR}/Transpose.fs | 0 src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 16 +++ .../Matrix/Rows/Matrix.fs | 16 +++ src/GraphBLAS-sharp.Backend/Matrix/Split.fs | 136 ------------------ src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 18 +++ .../Vector/SparseVector/SparseVector.fs | 11 ++ src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 13 +- 20 files changed, 148 insertions(+), 174 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix => COO}/Map.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix => COO}/Map2.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix => COO}/Map2AtLeastOne.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix => COO}/Matrix.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/GetTuples.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Map.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Map2.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Map2AtLeastOne.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Matrix.fs (77%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/SpGEMM.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/SpMSpV.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Transpose.fs (100%) create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs delete mode 100644 src/GraphBLAS-sharp.Backend/Matrix/Split.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 4804d690..0cd0f0cc 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -411,3 +411,36 @@ module ClArray = chunkBySizeLazy processor allocationMode chunkSize sourceArray |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray + + let append<'a> (clContext: ClContext) workGroupSize = + + let set = + <@ fun (ndRange: Range1D) sourceArrayLength appendedArrayLength (inputArray: ClArray<'a>) (result: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + let resultPosition = gid + sourceArrayLength + + if gid < appendedArrayLength then + + result.[resultPosition] <- inputArray.[gid] @> + + let kernel = clContext.Compile set + + fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) (appendedArray: ClArray<'a>) -> + + let resultLength = sourceArray.Length + appendedArray.Length + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = + Range1D.CreateValid(appendedArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange sourceArray.Length appendedArray.Length appendedArray result)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + result diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 580d2a5a..59db4bac 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -34,19 +34,6 @@ - - - - - - - - - - - - - @@ -54,22 +41,19 @@ + + + + + + + + + + + + - - - - - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2AtLeastOne.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Map2AtLeastOne.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/GetTuples.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/GetTuples.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/GetTuples.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/GetTuples.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs similarity index 77% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 5a606ad3..087415f5 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -8,6 +8,8 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Matrix = let private expandRowPointers (clContext: ClContext) workGroupSize = @@ -140,6 +142,43 @@ module Matrix = |> transposeInplace queue |> toCSRInplace queue allocationMode + let byRowsLazy (clContext: ClContext) workGroupSize = + + let getChunkValues = ClArray.getChunk clContext workGroupSize + + let getChunkIndices = ClArray.getChunk clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + + let getChunkValues = getChunkValues processor allocationMode matrix.Values + let getChunkIndices = getChunkIndices processor allocationMode matrix.Columns + + let creatSparseVector values columns = + { Context = clContext + Indices = columns + Values = values + Size = matrix.ColumnCount } + + matrix.RowPointers.ToHost processor + |> Seq.pairwise + |> Seq.map (fun (first, second) -> + lazy + if second - first > 0 then + let values = getChunkValues first second + let columns = getChunkIndices first second + + Some <| creatSparseVector values columns + else None) + + let byRows (clContext: ClContext) workGroupSize = + + let runLazy = byRowsLazy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + runLazy processor allocationMode matrix + |> Seq.map (fun lazyValue -> lazyValue.Value) + |> Seq.toArray + let spgemmCSC (clContext: ClContext) workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpMSpV.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpMSpV.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpMSpV.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/SpMSpV.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Transpose.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Transpose.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Transpose.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Transpose.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 3fac746a..a25fb05d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -6,13 +6,17 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend module Matrix = let copy (clContext: ClContext) workGroupSize = + let copy = ClArray.copy clContext workGroupSize let copyData = ClArray.copy clContext workGroupSize + let vectorCopy = Vector.Sparse.SparseVector.copy clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> @@ -39,6 +43,18 @@ module Matrix = Rows = copy processor allocationMode m.Rows ColumnPointers = copy processor allocationMode m.ColumnPointers Values = copyData processor allocationMode m.Values } + | ClMatrix.Rows matrix -> + matrix.Rows + |> Array.map (function + Some vector -> Some <| vectorCopy processor allocationMode vector + | None -> None) + |> fun rows -> + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + NNZ = matrix.NNZ } + |> ClMatrix.Rows /// /// Creates a new matrix, represented in CSR format, that is equal to the given one. diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs new file mode 100644 index 00000000..0432ac5f --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs @@ -0,0 +1,16 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.Rows + +open Brahma.FSharp +open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend + +module Matrix = + let x = () + + let toCSR (clContext: ClContext) workGroupSize = + + () diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Split.fs b/src/GraphBLAS-sharp.Backend/Matrix/Split.fs deleted file mode 100644 index 61fcefd7..00000000 --- a/src/GraphBLAS-sharp.Backend/Matrix/Split.fs +++ /dev/null @@ -1,136 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.Matrix - -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ClMatrix -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open GraphBLAS.FSharp.Backend.Objects.ClVector - -// type lazy matrix ??? - -module Split = - module ByChunk = - let runCOOLazy (clContext: ClContext) workGroupSize = - - let chunkBySizeValues = ClArray.lazyChunkBySize clContext workGroupSize - - let chunkBySizeIndices = ClArray.lazyChunkBySize clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode chunkSize (matrix: ClMatrix.COO<'a>) -> - - let createSubMatrixLazy (values: Lazy<_>) (columns: Lazy<_>) (rows: Lazy<_>) = - lazy - { Context = clContext - RowCount = matrix.RowCount - ColumnCount = matrix.ColumnCount - Rows = rows.Value - Columns = columns.Value - Values = values.Value } - - let values = chunkBySizeValues processor allocationMode chunkSize matrix.Values - let columns = chunkBySizeIndices processor allocationMode chunkSize matrix.Columns - let rows = chunkBySizeIndices processor allocationMode chunkSize matrix.Rows - - Seq.map3 createSubMatrixLazy values columns rows - - let runCOO (clContext: ClContext) workGroupSize = - - let run = runCOOLazy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode chunkSize (matrix: ClMatrix.COO<'a>) -> - run processor allocationMode chunkSize matrix - |> Seq.map (fun lazyMatrix -> lazyMatrix.Value) - |> Seq.toArray - - // let run (clContext: ClContext) workGroupSize = - // - // let run = runCOOLazy clContext workGroupSize - // - // let runCOO = runCOO clContext workGroupSize - // - // let COOToCSR = COO.Matrix.toCSR clCOntext workGroupSize - // - // fun (processor: MailboxProcessor<_>) allocationMode chunkSize (matrix: ClMatrix<'a>) -> - // match matrix with - // | ClMatrix.COO matrix -> runCOO processor allocationMode chunkSize matrix - // | ClMatrix.COO matrix -> - // () - module ByRow = - // MB We can split CSR to chunks without COO representation - let runCSRLazy (clContext: ClContext) workGroupSize = - - let getChunkValues = ClArray.getChunk clContext workGroupSize - - let getChunkIndices = ClArray.getChunk clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - - let getChunkValues = getChunkValues processor allocationMode matrix.Values - let getChunkIndices = getChunkIndices processor allocationMode matrix.Columns - - let creatSparseVector values columns = - { Context = clContext - Indices = columns - Values = values - Size = matrix.ColumnCount } - - matrix.RowPointers.ToHost processor - |> Seq.pairwise - |> Seq.map (fun (first, second) -> - lazy - if second - first > 0 then - let values = getChunkValues first second - let columns = getChunkIndices first second - - Some <| creatSparseVector values columns - else None) - - let runCSR (clContext: ClContext) workGroupSize = - - let runLazy = runCSRLazy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - runLazy processor allocationMode matrix - |> Seq.map (fun lazyValue -> lazyValue.Value) - |> Seq.toArray - - module ByColumn = - let runCSRLazy (clContext: ClContext) workGroupSize = - - let getChunkValues = ClArray.getChunk clContext workGroupSize - - let getChunkIndices = ClArray.getChunk clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSC<'a>) -> - - let getChunkValues = getChunkValues processor allocationMode matrix.Values - let getChunkIndices = getChunkIndices processor allocationMode matrix.Rows - - let creatSparseVector values columns = - { Context = clContext - Indices = columns - Values = values - Size = matrix.RowCount } - - matrix.ColumnPointers.ToHost processor - |> Seq.pairwise - |> Seq.map (fun (first, second) -> - lazy - if second - first > 0 then - let values = getChunkValues first second - let rows = getChunkIndices first second - - Some <| creatSparseVector values rows - else None) - - let runCSR (clContext: ClContext) workGroupSize = - - let runLazy = runCSRLazy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSC<'a>) -> - runLazy processor allocationMode matrix - |> Seq.map (fun lazyValue -> lazyValue.Value) - |> Seq.toArray - - diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 957c5fe3..58b5bd5a 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -75,6 +75,19 @@ module ClMatrix = member this.NNZ = this.Values.Length + type Rows<'elem when 'elem : struct> = + { Context: ClContext + RowCount: int + ColumnCount: int + Rows: ClVector.Sparse<'elem> option [] + NNZ: int } // TODO(empty vector) (or only some with row index ???) + + interface IDeviceMemObject with + member this.Dispose q = + this.Rows + |> Array.choose id + |> Array.iter (fun vector -> vector.Dispose q) + type Tuple<'elem when 'elem: struct> = { Context: ClContext RowIndices: ClArray @@ -95,27 +108,32 @@ type ClMatrix<'a when 'a: struct> = | CSR of ClMatrix.CSR<'a> | COO of ClMatrix.COO<'a> | CSC of ClMatrix.CSC<'a> + | Rows of ClMatrix.Rows<'a> member this.RowCount = match this with | ClMatrix.CSR matrix -> matrix.RowCount | ClMatrix.COO matrix -> matrix.RowCount | ClMatrix.CSC matrix -> matrix.RowCount + | ClMatrix.Rows matrix -> matrix.RowCount member this.ColumnCount = match this with | ClMatrix.CSR matrix -> matrix.ColumnCount | ClMatrix.COO matrix -> matrix.ColumnCount | ClMatrix.CSC matrix -> matrix.ColumnCount + | ClMatrix.Rows matrix -> matrix.ColumnCount member this.Dispose q = match this with | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose q | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose q | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.Rows matrix -> (matrix :> IDeviceMemObject).Dispose q member this.NNZ = match this with | ClMatrix.CSR matrix -> matrix.NNZ | ClMatrix.COO matrix -> matrix.NNZ | ClMatrix.CSC matrix -> matrix.NNZ + | ClMatrix.Rows matrix -> matrix.NNZ diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 2e597e1f..bf0a9e1a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -9,6 +9,17 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClVector module SparseVector = + let copy (clContext: ClContext) workGroupSize = + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (vector: Sparse<'a>) -> + { Context = clContext + Indices = copy processor allocationMode vector.Indices + Values = copyData processor allocationMode vector.Values + Size = vector.Size } + let map2 = Map2.run let map2AtLeastOne (clContext: ClContext) opAdd workGroupSize allocationMode = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 0746d515..9ef48ab7 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -79,26 +79,19 @@ module Vector = ClVector.Dense result let copy (clContext: ClContext) workGroupSize = - let copy = ClArray.copy clContext workGroupSize - - let copyData = ClArray.copy clContext workGroupSize + let sparseCopy = SparseVector.copy clContext workGroupSize let copyOptionData = ClArray.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Sparse vector -> - { Context = clContext - Indices = copy processor allocationMode vector.Indices - Values = copyData processor allocationMode vector.Values - Size = vector.Size } - |> ClVector.Sparse + ClVector.Sparse + <| sparseCopy processor allocationMode vector | ClVector.Dense vector -> ClVector.Dense <| copyOptionData processor allocationMode vector - let mask = copy - let toSparse (clContext: ClContext) workGroupSize = let toSparse = DenseVector.toSparse clContext workGroupSize From a79542d9ae4ebaa1d117867700239a77741f7c04 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 14 Apr 2023 20:39:42 +0300 Subject: [PATCH 068/143] add: Vector.map --- .../BenchmarksMxm.fs | 2 +- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 71 ++++++++++--- .../GraphBLAS-sharp.Backend.fsproj | 11 ++- .../Matrix/COO/Matrix.fs | 30 ++++++ src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 62 ++++++++---- .../Matrix/Rows/Matrix.fs | 75 +++++++++++++- .../{DenseVector => Dense}/DenseVector.fs | 0 .../Vector/{SparseVector => Sparse}/Common.fs | 0 .../Vector/Sparse/Map.fs | 99 +++++++++++++++++++ .../Vector/{SparseVector => Sparse}/Map2.fs | 0 .../Map2AtLeastOne.fs | 0 .../{SparseVector => Sparse}/SparseVector.fs | 21 ++++ 12 files changed, 327 insertions(+), 44 deletions(-) rename src/GraphBLAS-sharp.Backend/Vector/{DenseVector => Dense}/DenseVector.fs (100%) rename src/GraphBLAS-sharp.Backend/Vector/{SparseVector => Sparse}/Common.fs (100%) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs rename src/GraphBLAS-sharp.Backend/Vector/{SparseVector => Sparse}/Map2.fs (100%) rename src/GraphBLAS-sharp.Backend/Vector/{SparseVector => Sparse}/Map2AtLeastOne.fs (100%) rename src/GraphBLAS-sharp.Backend/Vector/{SparseVector => Sparse}/SparseVector.fs (76%) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs index a886736b..66e9f8ad 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs @@ -83,7 +83,7 @@ type MxmBenchmarks<'elem when 'elem : struct>( member this.FunCSC2CSR = match funCSC2CSR with | None -> - let x = Matrix.toCSRInplace this.OclContext this.WorkGroupSize + let x = Matrix.toCSRInPlace this.OclContext this.WorkGroupSize funCSC2CSR <- Some x x | Some x -> x diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 0cd0f0cc..d8349331 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -412,35 +412,82 @@ module ClArray = |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray - let append<'a> (clContext: ClContext) workGroupSize = + let assign<'a> (clContext: ClContext) workGroupSize = - let set = - <@ fun (ndRange: Range1D) sourceArrayLength appendedArrayLength (inputArray: ClArray<'a>) (result: ClArray<'a>) -> + let assign = + <@ fun (ndRange: Range1D) startPosition appendedArrayLength (inputArray: ClArray<'a>) (result: ClArray<'a>) -> let gid = ndRange.GlobalID0 - let resultPosition = gid + sourceArrayLength + let resultPosition = gid + startPosition if gid < appendedArrayLength then result.[resultPosition] <- inputArray.[gid] @> - let kernel = clContext.Compile set + let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) (appendedArray: ClArray<'a>) -> - - let resultLength = sourceArray.Length + appendedArray.Length - - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + fun (processor: MailboxProcessor<_>) allocationMode (targetArray: ClArray<'a>) startPosition (appendedArray: ClArray<'a>) -> + if startPosition < 0 then failwith "The starting position cannot be less than zero" + if startPosition + appendedArray.Length > targetArray.Length then + failwith "The array should fit completely" let ndRange = Range1D.CreateValid(appendedArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange sourceArray.Length appendedArray.Length appendedArray result)) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange appendedArray.Length appendedArray.Length appendedArray targetArray)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let concat (clContext: ClContext) workGroupSize = + + let assign = assign clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (sourceArrays: ClArray<'a> seq) -> + + let resultLength = + sourceArrays |> Seq.sumBy (fun array -> array.Length) + + let result = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let assign = assign processor allocationMode result + + // write each array to result + Seq.fold (fun previousLength array -> + assign previousLength array + previousLength + array.Length) 0 sourceArrays + |> ignore + result + + let fill (clContext: ClContext) workGroupSize = + + let fill = + <@ fun (ndRange: Range1D) firstPosition endPosition (value: ClCell<'a>) (targetArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + let writePosition = gid + firstPosition + + if writePosition < endPosition then + + targetArray.[writePosition] <- value.Value @> + + let kernel = clContext.Compile fill + + fun (processor: MailboxProcessor<_>) value firstPosition count (targetArray: ClArray<'a>) -> + if firstPosition + count > targetArray.Length then failwith "" + if firstPosition < 0 then failwith "" + if count <= 0 then failwith "" // TODO() + + let ndRange = + Range1D.CreateValid(count, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange firstPosition (firstPosition + count) value targetArray)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + () diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 59db4bac..e122b07a 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -34,11 +34,12 @@ - - - - - + + + + + + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index f6a389d6..61006763 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -155,3 +155,33 @@ module Matrix = Columns = copy queue allocationMode matrix.Columns Values = copyData queue allocationMode matrix.Values } |> transposeInplace queue + + let concat (clContext: ClContext) workGroupSize = + + let concatValues = ClArray.concat clContext workGroupSize + + let concatIndices = ClArray.concat clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode columnCount rowCount (matrices: ClMatrix.COO<'a> seq) -> + + let resultValues = + matrices + |> Seq.map (fun matrix -> matrix.Values) + |> concatValues processor allocationMode + + let resultColumns = + matrices + |> Seq.map (fun matrix -> matrix.Columns) + |> concatIndices processor allocationMode + + let resultRows = + matrices + |> Seq.map (fun matrix -> matrix.Rows) + |> concatIndices processor allocationMode + + { Context = clContext + RowCount = rowCount + ColumnCount = columnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index a25fb05d..70a7ef66 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -45,9 +45,7 @@ module Matrix = Values = copyData processor allocationMode m.Values } | ClMatrix.Rows matrix -> matrix.Rows - |> Array.map (function - Some vector -> Some <| vectorCopy processor allocationMode vector - | None -> None) + |> Array.map (Option.bind <| (Some << (vectorCopy processor allocationMode))) |> fun rows -> { Context = clContext RowCount = matrix.RowCount @@ -69,6 +67,8 @@ module Matrix = let transpose = CSR.Matrix.transpose clContext workGroupSize + let rowsToCSR = Rows.Matrix.toCSR clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> toCSR processor allocationMode m |> ClMatrix.CSR @@ -77,6 +77,9 @@ module Matrix = m.ToCSR |> transpose processor allocationMode |> ClMatrix.CSR + | ClMatrix.Rows m -> + rowsToCSR processor allocationMode m + |> ClMatrix.CSR /// /// Returns the matrix, represented in CSR format, that is equal to the given one. @@ -84,23 +87,26 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let toCSRInplace (clContext: ClContext) workGroupSize = - let toCSRInplace = + let toCSRInPlace (clContext: ClContext) workGroupSize = + let toCSRInPlace = COO.Matrix.toCSRInplace clContext workGroupSize - let transposeInplace = + let transposeInPlace = CSR.Matrix.transposeInplace clContext workGroupSize + let rowsToCSR = Rows.Matrix.toCSR clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> - toCSRInplace processor allocationMode m + toCSRInPlace processor allocationMode m |> ClMatrix.CSR | ClMatrix.CSR _ -> matrix | ClMatrix.CSC m -> m.ToCSR - |> transposeInplace processor allocationMode + |> transposeInPlace processor allocationMode |> ClMatrix.CSR + | _ -> failwith "not yet supported" /// /// Creates a new matrix, represented in COO format, that is equal to the given one. @@ -115,6 +121,9 @@ module Matrix = let transposeInplace = COO.Matrix.transposeInplace clContext workGroupSize + let rowsToCOO = + Rows.Matrix.toCOO clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> copy processor allocationMode matrix @@ -124,6 +133,9 @@ module Matrix = |> toCOO processor allocationMode |> transposeInplace processor |> ClMatrix.COO + | ClMatrix.Rows m -> + rowsToCOO processor allocationMode m + |> ClMatrix.COO /// /// Returns the matrix, represented in COO format, that is equal to the given one. @@ -131,24 +143,28 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let toCOOInplace (clContext: ClContext) workGroupSize = - let toCOOInplace = + let toCOOInPlace (clContext: ClContext) workGroupSize = + let toCOOInPlace = CSR.Matrix.toCOOInplace clContext workGroupSize - let transposeInplace = + let transposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize + let rowsToCOO = + Rows.Matrix.toCOO clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> matrix | ClMatrix.CSR m -> - toCOOInplace processor allocationMode m + toCOOInPlace processor allocationMode m |> ClMatrix.COO | ClMatrix.CSC m -> m.ToCSR - |> toCOOInplace processor allocationMode - |> transposeInplace processor + |> toCOOInPlace processor allocationMode + |> transposeInPlace processor |> ClMatrix.COO + | _ -> failwith "not yet supported" /// /// Creates a new matrix, represented in CSC format, that is equal to the given one. @@ -156,7 +172,7 @@ module Matrix = ///OpenCL context. ///Should be a power of 2 and greater than 1. let toCSC (clContext: ClContext) workGroupSize = - let toCSR = COO.Matrix.toCSR clContext workGroupSize + let COOtoCSR = COO.Matrix.toCSR clContext workGroupSize let copy = copy clContext workGroupSize @@ -174,9 +190,10 @@ module Matrix = |> ClMatrix.CSC | ClMatrix.COO m -> (transposeCOO processor allocationMode m - |> toCSR processor allocationMode) + |> COOtoCSR processor allocationMode) .ToCSC |> ClMatrix.CSC + | _ -> failwith "not yet supported" /// /// Returns the matrix, represented in CSC format, that is equal to the given one. @@ -206,6 +223,7 @@ module Matrix = |> toCSRInplace processor allocationMode) .ToCSC |> ClMatrix.CSC + | _ -> failwith "not yet supported" let map (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) workGroupSize = let mapCOO = @@ -271,7 +289,7 @@ module Matrix = let CSRElementwise = CSR.Matrix.map2AtLeastOneToCOO clContext opAdd workGroupSize - let transposeCOOInplace = + let transposeCOOInPlace = COO.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> @@ -284,7 +302,7 @@ module Matrix = |> ClMatrix.COO | ClMatrix.CSC m1, ClMatrix.CSC m2 -> CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR - |> transposeCOOInplace processor + |> transposeCOOInPlace processor |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" @@ -301,15 +319,16 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let transposeInplace (clContext: ClContext) workGroupSize = - let COOtransposeInplace = + let transposeInPlace (clContext: ClContext) workGroupSize = + let COOTransposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) matrix -> match matrix with - | ClMatrix.COO m -> COOtransposeInplace processor m |> ClMatrix.COO + | ClMatrix.COO m -> COOTransposeInPlace processor m |> ClMatrix.COO | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC | ClMatrix.CSC m -> ClMatrix.CSR m.ToCSR + | ClMatrix.Rows _ -> failwith "not yet supported" /// /// Transposes the given matrix and returns result as a new matrix. @@ -352,6 +371,7 @@ module Matrix = Columns = copy processor allocationMode m.Rows Values = copyData processor allocationMode m.Values } |> ClMatrix.CSR + | ClMatrix.Rows _ -> failwith "not yet supported" let mxm (opAdd: Expr<'c -> 'c -> 'c option>) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs index 0432ac5f..11f8f88e 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs @@ -1,16 +1,81 @@ namespace GraphBLAS.FSharp.Backend.Matrix.Rows open Brahma.FSharp -open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ClMatrix module Matrix = - let x = () - let toCSR (clContext: ClContext) workGroupSize = - () + let concatVectors = + Vector.Sparse.SparseVector.concat clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: Rows<'a>) -> + + // create row pointers + let rowPointers = + matrix.Rows + |> Array.Parallel.map (function None -> 0 | Some array -> array.Size) + |> Array.scan (+) 0 // mb device prefix sum ??? + + let rowPointers = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, rowPointers) + + // compact columns and values + matrix.Rows + |> Array.Parallel.choose id + |> concatVectors processor allocationMode + |> fun vector -> + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + RowPointers = rowPointers + Columns = vector.Indices + Values = vector.Values } + + let toCOO (clContext: ClContext) workGroupSize = + + let create = ClArray.create clContext workGroupSize + + let concatMatrix = COO.Matrix.concat clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: Rows<'a>) -> + + let createMatrix (vector: ClVector.Sparse<_>) rows = + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + Columns = vector.Indices + Values = vector.Values } + + let indices, rowsVectors = + matrix.Rows + |> Array.Parallel.mapi (fun index optionRow -> + (match optionRow with + | None -> None + | Some row -> Some (index, row))) + |> Array.Parallel.choose id + |> Array.unzip + + // creat rows pointers + let rowsIndices = + (rowsVectors, indices) + ||> Array.map2 (fun array -> create processor allocationMode array.Values.Length) + + Array.map2 createMatrix rowsVectors rowsIndices + |> concatMatrix processor allocationMode matrix.ColumnCount matrix.RowCount + + let map (clContext: ClContext) workGroupSize = + + let map2 = Vector.Sparse.Map2.run clContext workGroupSize + + let map = Vector // TODO() + + fun (processor: MailboxProcessor<'a>) -> + + () + diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/DenseVector.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs rename to src/GraphBLAS-sharp.Backend/Vector/Dense/DenseVector.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs new file mode 100644 index 00000000..2819f293 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -0,0 +1,99 @@ +namespace GraphBLAS.FSharp.Backend.Vector.Sparse + +open Brahma.FSharp +open Microsoft.FSharp.Control +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Quotes +open FSharp.Quotations +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +module internal Map = + let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = + // we can decrease memory requirements by two pass map (like choose) + let preparePositions (op: Expr<'a option -> 'b option>) = + <@ fun (ndRange: Range1D) dataLength vectorLength (values: ClArray<'a>) (indices: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultIndices: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < vectorLength then + + let value = + (%Search.Bin.byKey) dataLength gid indices values + + match (%op) value with + | Some resultValue -> + resultValues.[gid] <- resultValue + resultIndices.[gid] <- gid + + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> + + let kernel = + clContext.Compile <| preparePositions opAdd + + fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> + + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) + + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, vector.Size) + + let ndRange = + Range1D.CreateValid(vector.Size, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + vector.Values.Length + vector.Size + vector.Values + vector.Indices + resultBitmap + resultValues + resultIndices) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + resultBitmap, resultValues, resultIndices + + let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option>) + workGroupSize + = + + let preparePositions = + preparePositions clContext workGroupSize opAdd + + let setPositions = + Common.setPositions<'b> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> + + let bitmap, values, indices = + preparePositions queue vector + + let resultValues, resultIndices = + setPositions queue allocationMode values indices bitmap + + bitmap.Free queue + values.Free queue + indices.Free queue + + { Context = clContext + Indices = resultIndices + Values = resultValues + Size = vector.Size } + + module AtLeastOne = diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2AtLeastOne.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2AtLeastOne.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs similarity index 76% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs index bf0a9e1a..64a1a7ea 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs @@ -68,3 +68,24 @@ module SparseVector = Reduce.reduce clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values + + let concat<'a> (clContext: ClContext) workGroupSize = + + let concatValues = ClArray.concat clContext workGroupSize + + let concatIndices = ClArray.concat clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (vectors: ClVector.Sparse<'a> seq) -> + + let resultValues = + Seq.map (fun vector -> vector.Values) vectors + |> concatValues processor allocationMode + + let resultIndices = + Seq.map (fun vector -> vector.Indices) vectors + |> concatIndices processor allocationMode + + { Context = clContext + Indices = resultIndices + Values = resultValues + Size = resultValues.Length } // TODO(size) From d0133ecffc2c495120299553510008a1a93fac31 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 14 Apr 2023 20:47:08 +0300 Subject: [PATCH 069/143] wip: Vector.map2 --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 2 -- src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 6 ++++++ src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs | 14 ++++++++++++++ 3 files changed, 20 insertions(+), 2 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index d8349331..88fead0b 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -489,5 +489,3 @@ module ClArray = processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange firstPosition (firstPosition + count) value targetArray)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - () diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 58ad1026..c1808456 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -22,6 +22,12 @@ module Map = | Some _ -> 1 | None -> 0 @> + let choose2Bitmap<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c option>) = + <@ fun (leftItem: 'a) (rightItem: 'b) -> + match (%map) leftItem rightItem with + | Some _ -> 1 + | None -> 0 @> + let fst () = <@ fun fst _ -> fst @> let snd () = <@ fun _ snd -> snd @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs index 2819f293..8b174b51 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Quotes open FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Common module internal Map = let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = @@ -97,3 +98,16 @@ module internal Map = Size = vector.Size } module AtLeastOne = + let run (clContext: ClContext) workGroupSize op = + + let getOptionBitmap = + ClArray.map2 clContext workGroupSize + <| Map.choose2Bitmap op + + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + + let scatter = Scatter.runInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) -> + + () From 4b7c3ed0974a82059b80194ed76cd921b79edc99 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 16 Apr 2023 16:19:26 +0300 Subject: [PATCH 070/143] wip: expand refactor, tests in progress --- paket.dependencies | 2 +- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 32 ++- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 152 ++++++++-- .../GraphBLAS-sharp.Backend.fsproj | 6 +- .../Matrix/CSR/Matrix.fs | 61 +--- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 10 +- .../Matrix/Rows/Matrix.fs | 12 +- .../Matrix/{CSR/SpGEMM => SpGeMM}/Expand.fs | 272 ++++++++---------- .../Matrix/{CSR/SpGEMM => SpGeMM}/Masked.fs | 2 +- src/GraphBLAS-sharp.Backend/Quotes/Convert.fs | 8 + .../Vector/Sparse/Map.fs | 23 +- src/GraphBLAS-sharp.Backend/paket.references | 2 +- .../Common/ClArray/Assign.fs | 51 ++++ .../{chunkBySize.fs => ChunkBySize.fs} | 0 .../Common/ClArray/Concat.fs | 48 ++++ .../GraphBLAS-sharp.Tests.fsproj | 4 +- 16 files changed, 442 insertions(+), 243 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/{CSR/SpGEMM => SpGeMM}/Expand.fs (55%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSR/SpGEMM => SpGeMM}/Masked.fs (99%) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs rename tests/GraphBLAS-sharp.Tests/Common/ClArray/{chunkBySize.fs => ChunkBySize.fs} (100%) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs diff --git a/paket.dependencies b/paket.dependencies index c1c5211c..a434e23e 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -59,4 +59,4 @@ group Docs group Analyzers source https://www.nuget.org/api/v2 source https://api.nuget.org/v3/index.json - nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2 + nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2 \ No newline at end of file diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index e683b135..a10698e8 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -335,7 +335,7 @@ module ClArray = let getUniqueBitmap2LastOccurrence clContext = getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext - let private assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) = + let assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) = let assign = <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) resultLength -> @@ -574,7 +574,7 @@ module ClArray = let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) allocationMode (targetArray: ClArray<'a>) startPosition (appendedArray: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (targetArray: ClArray<'a>) startPosition (appendedArray: ClArray<'a>) -> if startPosition < 0 then failwith "The starting position cannot be less than zero" @@ -605,9 +605,9 @@ module ClArray = |> Seq.sumBy (fun array -> array.Length) let result = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let assign = assign processor allocationMode result + let assign = assign processor result // write each array to result Seq.fold @@ -652,3 +652,27 @@ module ClArray = ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let pairwise (clContext: ClContext) workGroupSize = + + let idGather = + Gather.runInit Map.id clContext workGroupSize + + let incGather = + Gather.runInit Map.inc clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) -> + + let resultLength = values.Length - 1 + + let firstItems = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + idGather processor values firstItems + + let secondItems = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + incGather processor values secondItems + + firstItems, secondItems diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index bdf1840d..40b8d8c9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -315,7 +315,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - reducedKeys, reducedValues + reducedValues, reducedKeys /// /// Reduces values by key. Each segment is reduced by one work item. @@ -381,7 +381,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - reducedKeys, reducedValues + reducedValues, reducedKeys /// /// Reduces values by key. One work group participates in the reduction. @@ -470,8 +470,120 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - reducedKeys, reducedValues + reducedValues, reducedKeys + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let segmentSequentialOption<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (resultPositions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] + + let firstSourceKey = keys.[startPosition] + + let mutable sum = Some values.[startPosition] + + let mutable currentPosition = startPosition + 1 + + while currentPosition < keysLength + && firstSourceKey = keys.[currentPosition] do + + match sum with + | Some value -> + let result = + ((%reduceOp) value values.[currentPosition]) // brahma error + + sum <- result + | None -> sum <- Some values.[currentPosition] + + currentPosition <- currentPosition + 1 + + match sum with + | Some value -> + reducedValues.[gid] <- value + resultPositions.[gid] <- 1 + | None -> resultPositions.[gid] <- 0 + + firstReducedKeys.[gid] <- firstSourceKey @> + + let kernel = clContext.Compile kernel + + let scatterData = + Scatter.lastOccurrence clContext workGroupSize + + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let reducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let resultPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + keys.Length + offsets + keys + values + reducedValues + reducedKeys + resultPositions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let resultLength = + (prefixSum processor resultPositions) + .ToHostAndFree processor + + if resultLength = 0 then None + else + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterData processor resultPositions reducedValues resultValues + + reducedValues.Free processor + + let resultKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterIndices processor resultPositions reducedKeys resultKeys // TODO(mb error) + + reducedKeys.Free processor + resultPositions.Free processor + + Some (resultValues, reducedKeys) module ByKey2D = /// /// Reduce an array of values by 2D keys using a single work item. @@ -550,7 +662,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - firstReducedKeys, secondReducedKeys, reducedValues + reducedValues, firstReducedKeys, secondReducedKeys /// /// Reduces values by key. Each segment is reduced by one work item. @@ -625,7 +737,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - firstReducedKeys, secondReducedKeys, reducedValues + reducedValues, firstReducedKeys, secondReducedKeys /// /// Reduces values by key. Each segment is reduced by one work item. @@ -729,27 +841,29 @@ module Reduce = (prefixSum processor resultPositions) .ToHostAndFree processor - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + if resultLength = 0 then None + else + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterData processor resultPositions reducedValues resultValues + scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free processor - let resultFirstKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let resultFirstKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterIndices processor resultPositions firstReducedKeys resultFirstKeys + scatterIndices processor resultPositions firstReducedKeys resultFirstKeys - firstReducedKeys.Free processor + firstReducedKeys.Free processor - let resultSecondKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let resultSecondKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterIndices processor resultPositions secondReducedKeys resultSecondKeys + scatterIndices processor resultPositions secondReducedKeys resultSecondKeys - secondReducedKeys.Free processor + secondReducedKeys.Free processor - resultPositions.Free processor + resultPositions.Free processor - resultFirstKeys, resultSecondKeys, resultValues + Some (resultValues, resultFirstKeys, resultSecondKeys) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 6feb4ba4..d0e03da6 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -30,8 +30,8 @@ + - @@ -51,10 +51,10 @@ - - + + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 48ecc06a..1f7eadd8 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -40,7 +40,7 @@ module Matrix = Columns = cols Values = values } - let toCOOInplace (clContext: ClContext) workGroupSize = + let toCOOInPlace (clContext: ClContext) workGroupSize = let prepare = Common.expandRowPointers clContext workGroupSize @@ -77,35 +77,35 @@ module Matrix = Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize - let transposeInplace (clContext: ClContext) workGroupSize = + let transposeInPlace (clContext: ClContext) workGroupSize = - let toCOOInplace = toCOOInplace clContext workGroupSize + let toCOOInPlace = toCOOInPlace clContext workGroupSize - let transposeInplace = + let transposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize - let toCSRInplace = + let toCSRInPlace = COO.Matrix.toCSRInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - toCOOInplace queue allocationMode matrix - |> transposeInplace queue - |> toCSRInplace queue allocationMode + toCOOInPlace queue allocationMode matrix + |> transposeInPlace queue + |> toCSRInPlace queue allocationMode let transpose (clContext: ClContext) workGroupSize = let toCOO = toCOO clContext workGroupSize - let transposeInplace = + let transposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize - let toCSRInplace = + let toCSRInPlace = COO.Matrix.toCSRInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix - |> transposeInplace queue - |> toCSRInplace queue allocationMode + |> transposeInPlace queue + |> toCSRInPlace queue allocationMode let byRowsLazy (clContext: ClContext) workGroupSize = @@ -148,40 +148,3 @@ module Matrix = runLazy processor allocationMode matrix |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray - - module SpGeMM = - let masked - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - = - - let run = - SpGeMM.Masked.run clContext workGroupSize opAdd opMul - - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> - - run queue matrixLeft matrixRight mask - - let expand - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - = - - let run = - SpGeMM.Expand.run clContext workGroupSize opAdd opMul - - fun (queue: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - - let values, columns, rows = - run queue allocationMode leftMatrix rightMatrix - - { COO.Context = clContext - ColumnCount = rightMatrix.ColumnCount - RowCount = leftMatrix.RowCount - Values = values - Columns = columns - Rows = rows } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index ccf76ec7..2c15238d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -97,7 +97,7 @@ module Matrix = COO.Matrix.toCSRInplace clContext workGroupSize let transposeInPlace = - CSR.Matrix.transposeInplace clContext workGroupSize + CSR.Matrix.transposeInPlace clContext workGroupSize let rowsToCSR = Rows.Matrix.toCSR clContext workGroupSize @@ -151,7 +151,7 @@ module Matrix = ///Should be a power of 2 and greater than 1. let toCOOInPlace (clContext: ClContext) workGroupSize = let toCOOInPlace = - CSR.Matrix.toCOOInplace clContext workGroupSize + CSR.Matrix.toCOOInPlace clContext workGroupSize let transposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize @@ -212,7 +212,7 @@ module Matrix = COO.Matrix.toCSRInplace clContext workGroupSize let transposeCSRInplace = - CSR.Matrix.transposeInplace clContext workGroupSize + CSR.Matrix.transposeInPlace clContext workGroupSize let transposeCOOInplace = COO.Matrix.transposeInplace clContext workGroupSize @@ -388,7 +388,7 @@ module Matrix = = let runCSRnCSC = - CSR.Matrix.SpGeMM.masked clContext workGroupSize opAdd opMul + SpGeMM.Masked.run clContext workGroupSize opAdd opMul fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> match matrix1, matrix2, mask with @@ -403,7 +403,7 @@ module Matrix = = let run = - CSR.Matrix.SpGeMM.expand clContext workGroupSize opAdd opMul + SpGeMM.Expand.run clContext workGroupSize opAdd opMul fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> match leftMatrix, rightMatrix with diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs index 2e1ab6e2..db3a986c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs @@ -7,6 +7,8 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Quotes +open FSharp.Quotations.Evaluator module Matrix = let toCSR (clContext: ClContext) workGroupSize = @@ -74,13 +76,3 @@ module Matrix = Array.map2 createMatrix rowsVectors rowsIndices |> concatMatrix processor allocationMode matrix.ColumnCount matrix.RowCount - - // let map (clContext: ClContext) workGroupSize = - // - // let map2 = Vector.Sparse.Map2.run clContext workGroupSize - // - // let map = Vector // TODO() - // - // fun (processor: MailboxProcessor<'a>) -> - // - // () diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs similarity index 55% rename from src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs rename to src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 489902f7..d4b8cda6 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +namespace GraphBLAS.FSharp.Backend.Matrix.SpGeMM open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common @@ -10,58 +10,46 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell open FSharp.Quotations +open GraphBLAS.FSharp.Backend.Vector.Sparse +open GraphBLAS.FSharp.Backend.Objects.ClVector type Indices = ClArray type Values<'a> = ClArray<'a> module Expand = - let getSegmentPointers (clContext: ClContext) workGroupSize = - + let getRowsLength (clContext: ClContext) workGroupSize = let subtract = ClArray.map2 clContext workGroupSize Map.subtraction - let idGather = - Gather.runInit Map.id clContext workGroupSize - - let incGather = - Gather.runInit Map.inc clContext workGroupSize + let pairwise = ClArray.pairwise clContext workGroupSize - let gather = Gather.run clContext workGroupSize - - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + fun (processor: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'b>) -> - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let firstPointers, secondPointers = + pairwise processor DeviceOnly matrix.RowPointers - let positionsLength = rightMatrix.RowPointers.Length - 1 + let rowsLength = subtract processor DeviceOnly secondPointers firstPointers - // extract first rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers - // (right matrix row pointers without last item) - let firstPointers = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) + firstPointers.Free processor + secondPointers.Free processor - idGather processor rightMatrix.RowPointers firstPointers + rowsLength - // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers - // (right matrix row pointers without first item) - let lastPointers = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) + let getSegmentPointers (clContext: ClContext) workGroupSize = - incGather processor rightMatrix.RowPointers lastPointers + let gather = Gather.run clContext workGroupSize - // subtract - let rightMatrixRowsLengths = - subtract processor DeviceOnly lastPointers firstPointers + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - firstPointers.Free processor - lastPointers.Free processor + fun (processor: MailboxProcessor<_>) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrixRowsLengths: ClArray) -> let segmentsLengths = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.Columns.Length) + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRow.Indices.Length) // extract needed lengths by left matrix nnz - gather processor leftMatrix.Columns rightMatrixRowsLengths segmentsLengths + gather processor leftMatrixRow.Indices rightMatrixRowsLengths segmentsLengths rightMatrixRowsLengths.Free processor @@ -72,46 +60,6 @@ module Expand = length, segmentsLengths - let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = - let getBitmap = - ClArray.map2<'a, 'b, int> clContext workGroupSize - <| Map.choose2Bitmap predicate - - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize - - let assignValues = - ClArray.assignOption2 clContext workGroupSize predicate - - let scatter = - Scatter.lastOccurrence clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: Indices) (rows: Indices) -> - - let positions = - getBitmap processor DeviceOnly firstValues secondValues - - let resultLength = - (prefixSum processor positions) - .ToHostAndFree(processor) - - let resultColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - scatter processor positions columns resultColumns - - let resultRows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - scatter processor positions rows resultRows - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - assignValues processor firstValues secondValues positions resultValues - - resultValues, resultColumns, resultRows - let expand (clContext: ClContext) workGroupSize = let idScatter = @@ -136,14 +84,11 @@ module Expand = let removeDuplicates = ClArray.removeDuplications clContext workGroupSize - let expandRowPointers = - Common.expandRowPointers clContext workGroupSize - let leftMatrixGather = Gather.run clContext workGroupSize let rightMatrixGather = Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute left matrix positions let leftMatrixPositions = zeroCreate processor DeviceOnly lengths @@ -157,9 +102,9 @@ module Expand = let rightMatrixPositions = create processor DeviceOnly lengths 1 let requiredRightMatrixPointers = - zeroCreate processor DeviceOnly leftMatrix.Columns.Length + zeroCreate processor DeviceOnly leftMatrixRow.Indices.Length - gather processor leftMatrix.Columns rightMatrix.RowPointers requiredRightMatrixPointers + gather processor leftMatrixRow.Indices rightMatrix.RowPointers requiredRightMatrixPointers scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions @@ -179,22 +124,11 @@ module Expand = gather processor rightMatrixPositions rightMatrix.Columns columns - // compute rows - let leftMatrixRows = - expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount - - let rows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - - gather processor leftMatrixPositions leftMatrixRows rows - - leftMatrixRows.Free processor - // compute left matrix values let leftMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues + leftMatrixGather processor leftMatrixPositions leftMatrixRow.Values leftMatrixValues leftMatrixPositions.Free processor @@ -207,12 +141,46 @@ module Expand = rightMatrixPositions.Free processor // left, right matrix values, columns and rows indices - leftMatrixValues, rightMatrixValues, columns, rows + leftMatrixValues, rightMatrixValues, columns + + let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let getBitmap = + ClArray.map2<'a, 'b, int> clContext workGroupSize + <| Map.choose2Bitmap predicate - let sortByColumnsAndRows (clContext: ClContext) workGroupSize = + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let sortByKeyIndices = - Radix.runByKeysStandard clContext workGroupSize + let assignValues = + ClArray.assignOption2 clContext workGroupSize predicate + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: Indices) -> + + let positions = + getBitmap processor DeviceOnly firstValues secondValues + + let resultLength = + (prefixSum processor positions) + .ToHostAndFree(processor) + + if resultLength = 0 then None + else + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions columns resultIndices + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + assignValues processor firstValues secondValues positions resultValues + + Some (resultValues, resultIndices) + + let sortByColumns (clContext: ClContext) workGroupSize = let sortByKeyValues = Radix.runByKeysStandard clContext workGroupSize @@ -220,38 +188,22 @@ module Expand = let sortKeys = Radix.standardRunKeysOnly clContext workGroupSize - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) -> // sort by columns - let valuesSortedByColumns = + let sortedValues = sortByKeyValues processor DeviceOnly columns values - let rowsSortedByColumns = - sortByKeyIndices processor DeviceOnly columns rows - let sortedColumns = sortKeys processor columns - // sort by rows - let valuesSortedByRows = - sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns - - let columnsSortedByRows = - sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns - - let sortedRows = sortKeys processor rowsSortedByColumns - - valuesSortedByColumns.Free processor - rowsSortedByColumns.Free processor - sortedColumns.Free processor - - valuesSortedByRows, columnsSortedByRows, sortedRows + sortedValues, sortedColumns let reduce (clContext: ClContext) workGroupSize opAdd = let reduce = - Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd + Reduce.ByKey.segmentSequentialOption clContext workGroupSize opAdd // TODO(tests) let getUniqueBitmap = - ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize + ClArray.getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize @@ -259,10 +211,10 @@ module Expand = let idScatter = Scatter.initFirsOccurrence Map.id clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) -> let bitmap = - getUniqueBitmap processor DeviceOnly columns rows + getUniqueBitmap processor DeviceOnly columns let uniqueKeysCount = (prefixSum processor bitmap) @@ -275,15 +227,14 @@ module Expand = bitmap.Free processor - let reducedColumns, reducedRows, reducedValues = // by size variance TODO() - reduce processor allocationMode uniqueKeysCount offsets columns rows values + let reduceResult = // by size variance TODO() + reduce processor allocationMode uniqueKeysCount offsets columns values offsets.Free processor - reducedValues, reducedColumns, reducedRows - - let run (clContext: ClContext) workGroupSize opAdd opMul = + reduceResult + let runRow (clContext: ClContext) workGroupSize opAdd opMul = let getSegmentPointers = getSegmentPointers clContext workGroupSize @@ -291,43 +242,74 @@ module Expand = let multiply = multiply clContext workGroupSize opMul - let sort = - sortByColumnsAndRows clContext workGroupSize + let sort = sortByColumns clContext workGroupSize let reduce = reduce clContext workGroupSize opAdd - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - + // left matrix last --- for curring + fun (processor: MailboxProcessor<_>) allocationMode (rightMatrix: ClMatrix.CSR<'b>) (leftMatrixRowsLengths: Indices) (leftMatrixRow: ClVector.Sparse<'a>) -> + // TODO(sort in range) + // required right matrix lengths let length, segmentPointers = - getSegmentPointers processor leftMatrix rightMatrix + getSegmentPointers processor leftMatrixRow leftMatrixRowsLengths // expand - let leftMatrixValues, rightMatrixValues, columns, rows = - expand processor length segmentPointers leftMatrix rightMatrix + let leftMatrixValues, rightMatrixValues, columns = + expand processor length segmentPointers leftMatrixRow rightMatrix - // multiply - let resultValues, resultColumns, resultRows = - multiply processor leftMatrixValues rightMatrixValues columns rows + // multiplication + let mulResult = + multiply processor leftMatrixValues rightMatrixValues columns leftMatrixValues.Free processor rightMatrixValues.Free processor columns.Free processor - rows.Free processor - // sort - let sortedValues, sortedColumns, sortedRows = - sort processor resultValues resultColumns resultRows + // check multiplication result + mulResult + |> Option.bind (fun (resultValues, resultColumns) -> + // sort + let sortedValues, sortedColumns = + sort processor resultValues resultColumns + + resultValues.Free processor + resultColumns.Free processor + + let reduceResult = + reduce processor allocationMode sortedValues sortedColumns + + sortedValues.Free processor + sortedColumns.Free processor + + // create sparse vector (TODO(empty vector)) + reduceResult + |> Option.bind (fun (values, columns) -> + { Context = clContext + Indices = columns + Values = values + Size = rightMatrix.ColumnCount } + |> Some)) + + let run<'a, 'b, 'c when 'a : struct and 'b : struct and 'c : struct> + (clContext: ClContext) + workGroupSize + opAdd + (opMul: Expr<'a -> 'b -> 'c option>) = - resultValues.Free processor - resultColumns.Free processor - resultRows.Free processor + let getRowsLength = + getRowsLength clContext workGroupSize - // addition - let reducedValues, reducedColumns, reducedRows = - reduce processor allocationMode sortedValues sortedColumns sortedRows + let split = CSR.Matrix.byRowsLazy clContext workGroupSize + + let runRow = runRow clContext workGroupSize opAdd opMul + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let rightMatrixRowsLengths = + getRowsLength processor rightMatrix - sortedValues.Free processor - sortedColumns.Free processor - sortedRows.Free processor + let runRow = + runRow processor allocationMode rightMatrix rightMatrixRowsLengths - reducedValues, reducedColumns, reducedRows + split processor allocationMode leftMatrix + |> Seq.map (fun lazyRow -> Option.bind runRow lazyRow.Value) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs similarity index 99% rename from src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs rename to src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs index b4f3fcbd..c1b0d2a9 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +namespace GraphBLAS.FSharp.Backend.Matrix.SpGeMM open GraphBLAS.FSharp.Backend.Common open Brahma.FSharp diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs index 774b41f2..561f8993 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs @@ -23,3 +23,11 @@ module Convert = match rightItem with | Some _ -> (%op) leftItem None | None -> (%op) leftItem (Some value) @> + + let map2ToMapLeftNone (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun rightItem -> (%op) None rightItem @> + + let map2ToMapRightNone (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun leftItem -> (%op) leftItem None @> + + let map2ToNoneNone (op: Expr<'a option -> 'b option -> 'c option>) = <@ (%op) None None @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs index 8405ec60..7cb77404 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -12,7 +12,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Common module internal Map = - let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = + let private preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = // we can decrease memory requirements by two pass map (like choose) let preparePositions (op: Expr<'a option -> 'b option>) = <@ fun (ndRange: Range1D) dataLength vectorLength (values: ClArray<'a>) (indices: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultIndices: ClArray) -> @@ -71,8 +71,8 @@ module internal Map = let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option>) workGroupSize + (opAdd: Expr<'a option -> 'b option>) = let preparePositions = @@ -97,7 +97,7 @@ module internal Map = Values = resultValues Size = vector.Size } - module AtLeastOne = + module OnlySome = let run (clContext: ClContext) workGroupSize op = let getOptionBitmap = @@ -110,6 +110,8 @@ module internal Map = let scatter = Scatter.lastOccurrence clContext workGroupSize + let setOption = ClArray.assignOption clContext workGroupSize op + fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> let bitmap = @@ -119,4 +121,17 @@ module internal Map = (prefixSum processor bitmap) .ToHostAndFree processor - () + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + setOption processor vector.Values bitmap resultValues + + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatter processor vector.Indices bitmap resultIndices + + { Context = clContext + Indices = resultIndices + Values = resultValues + Size = vector.Size } diff --git a/src/GraphBLAS-sharp.Backend/paket.references b/src/GraphBLAS-sharp.Backend/paket.references index 6f164f37..6051b92a 100644 --- a/src/GraphBLAS-sharp.Backend/paket.references +++ b/src/GraphBLAS-sharp.Backend/paket.references @@ -1,4 +1,4 @@ FSharp.Core Microsoft.SourceLink.GitHub - Brahma.FSharp +FSharp.Quotations.Evaluator \ No newline at end of file diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs new file mode 100644 index 00000000..12e868de --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs @@ -0,0 +1,51 @@ +module GraphBLAS.FSharp.Tests.Backned.Common.ClArray.Assign + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual testFun (source: 'a []) (target: 'a []) = + + if source.Length > 0 + && target.Length > 0 then + + let clSource = context.CreateClArray source + let clTarget = context.CreateClArray target + let targetPosition = 0 + + testFun processor clSource targetPosition clTarget + + let actual = clSource.ToHostAndFree processor + clTarget.Free processor + + // write to target --- target expected + Array.blit source 0 target targetPosition source.Length + + "Results should be the same" + |> Utils.compareArrays isEqual actual target + +let createTest<'a when 'a : equality> isEqual = + ClArray.assign context Utils.defaultWorkGroupSize + |> makeTest isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest (=) + + createTest (=) + createTest (=) ] + |> testList "Assign" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/chunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/chunkBySize.fs rename to tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs new file mode 100644 index 00000000..fd44df09 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs @@ -0,0 +1,48 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Concat + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual testFun (arrays: 'a [] seq) = + + if Seq.length arrays > 0 then + + let clArrays = arrays |> Seq.map context.CreateClArray + + let clActual: ClArray<'a> = testFun processor HostInterop clArrays + + // release + let actual = clActual.ToHostAndFree processor + clArrays |> Seq.iter (fun array -> array.Free processor) + + let expected = Seq.concat arrays |> Seq.toArray + + "Results must be the same" + |> Utils.compareArrays isEqual actual expected + +let createTest<'a> isEqual = + ClArray.concat context Utils.defaultWorkGroupSize + |> makeTest isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest (=) + + createTest (=) + createTest (=) ] diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 258d8e67..50905bde 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -25,7 +25,9 @@ - + + + From 7d1ee0e3c2b1211dee490fb05185281eb32662c3 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 16 Apr 2023 18:13:03 +0300 Subject: [PATCH 071/143] add: Reduce.ByKey.Option.sequintialSegments --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 349 ++++++------ src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 45 +- .../Matrix/SpGeMM/Expand.fs | 2 +- .../Objects/MatrixExtensions.fs | 1 + .../Common/ClArray/Fill.fs | 49 ++ .../Common/ClArray/Pairwise.fs | 52 ++ .../Common/Reduce/ReduceByKey.fs | 139 ++++- tests/GraphBLAS-sharp.Tests/Generators.fs | 77 +++ .../GraphBLAS-sharp.Tests.fsproj | 2 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 2 +- .../Matrix/SpGeMM/Expand.fs | 532 +++++++++--------- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 12 files changed, 757 insertions(+), 495 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 40b8d8c9..df2b3c1b 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -472,118 +472,121 @@ module Reduce = reducedValues, reducedKeys - /// - /// Reduces values by key. Each segment is reduced by one work item. - /// - /// ClContext. - /// Work group size. - /// Operation for reducing values. - /// - /// The length of the result must be calculated in advance. - /// - let segmentSequentialOption<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = + module Option = + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = - let kernel = - <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (resultPositions: ClArray) -> + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (resultPositions: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < uniqueKeyCount then - let startPosition = offsets.[gid] + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] - let firstSourceKey = keys.[startPosition] + let firstSourceKey = keys.[startPosition] - let mutable sum = Some values.[startPosition] + let mutable sum = Some values.[startPosition] - let mutable currentPosition = startPosition + 1 + let mutable currentPosition = startPosition + 1 - while currentPosition < keysLength - && firstSourceKey = keys.[currentPosition] do + while currentPosition < keysLength + && firstSourceKey = keys.[currentPosition] do - match sum with - | Some value -> - let result = - ((%reduceOp) value values.[currentPosition]) // brahma error + match sum with + | Some value -> + let result = + ((%reduceOp) value values.[currentPosition]) // brahma error - sum <- result - | None -> sum <- Some values.[currentPosition] + sum <- result + | None -> sum <- Some values.[currentPosition] - currentPosition <- currentPosition + 1 + currentPosition <- currentPosition + 1 - match sum with - | Some value -> - reducedValues.[gid] <- value - resultPositions.[gid] <- 1 - | None -> resultPositions.[gid] <- 0 + match sum with + | Some value -> + reducedValues.[gid] <- value + resultPositions.[gid] <- 1 + | None -> resultPositions.[gid] <- 0 - firstReducedKeys.[gid] <- firstSourceKey @> + firstReducedKeys.[gid] <- firstSourceKey @> - let kernel = clContext.Compile kernel + let kernel = clContext.Compile kernel - let scatterData = - Scatter.lastOccurrence clContext workGroupSize + let scatterData = + Scatter.lastOccurrence clContext workGroupSize - let scatterIndices = - Scatter.lastOccurrence clContext workGroupSize + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> - let reducedValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let reducedKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let resultPositions = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) - let kernel = kernel.GetKernel() + let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - keys.Length - offsets - keys - values - reducedValues - reducedKeys - resultPositions) - ) + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + keys.Length + offsets + keys + values + reducedValues + reducedKeys + resultPositions) + ) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let resultLength = - (prefixSum processor resultPositions) - .ToHostAndFree processor + let resultLength = + (prefixSum processor resultPositions) + .ToHostAndFree processor - if resultLength = 0 then None - else - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + if resultLength = 0 then None + else + // write values + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterData processor resultPositions reducedValues resultValues + scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free processor - let resultKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + // write keys + let resultKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterIndices processor resultPositions reducedKeys resultKeys // TODO(mb error) + scatterIndices processor resultPositions reducedKeys resultKeys - reducedKeys.Free processor - resultPositions.Free processor + reducedKeys.Free processor + resultPositions.Free processor - Some (resultValues, reducedKeys) + Some (resultValues, resultKeys) module ByKey2D = /// /// Reduce an array of values by 2D keys using a single work item. @@ -739,131 +742,135 @@ module Reduce = reducedValues, firstReducedKeys, secondReducedKeys - /// - /// Reduces values by key. Each segment is reduced by one work item. - /// - /// ClContext. - /// Work group size. - /// Operation for reducing values. - /// - /// The length of the result must be calculated in advance. - /// - let segmentSequentialOption<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = + module Option = + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = - let kernel = - <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) (resultPositions: ClArray) -> + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) (resultPositions: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < uniqueKeyCount then - let startPosition = offsets.[gid] + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] - let firstSourceKey = firstKeys.[startPosition] - let secondSourceKey = secondKeys.[startPosition] + let firstSourceKey = firstKeys.[startPosition] + let secondSourceKey = secondKeys.[startPosition] - let mutable sum = Some values.[startPosition] + let mutable sum = Some values.[startPosition] - let mutable currentPosition = startPosition + 1 + let mutable currentPosition = startPosition + 1 - while currentPosition < keysLength - && firstSourceKey = firstKeys.[currentPosition] - && secondSourceKey = secondKeys.[currentPosition] do + while currentPosition < keysLength + && firstSourceKey = firstKeys.[currentPosition] + && secondSourceKey = secondKeys.[currentPosition] do - match sum with - | Some value -> - let result = - ((%reduceOp) value values.[currentPosition]) // brahma error + match sum with + | Some value -> + let result = + ((%reduceOp) value values.[currentPosition]) // brahma error - sum <- result - | None -> sum <- Some values.[currentPosition] + sum <- result + | None -> sum <- Some values.[currentPosition] - currentPosition <- currentPosition + 1 + currentPosition <- currentPosition + 1 - match sum with - | Some value -> - reducedValues.[gid] <- value - resultPositions.[gid] <- 1 - | None -> resultPositions.[gid] <- 0 + match sum with + | Some value -> + reducedValues.[gid] <- value + resultPositions.[gid] <- 1 + | None -> resultPositions.[gid] <- 0 - firstReducedKeys.[gid] <- firstSourceKey - secondReducedKeys.[gid] <- secondSourceKey @> + firstReducedKeys.[gid] <- firstSourceKey + secondReducedKeys.[gid] <- secondSourceKey @> - let kernel = clContext.Compile kernel + let kernel = clContext.Compile kernel - let scatterData = - Scatter.lastOccurrence clContext workGroupSize + let scatterData = + Scatter.lastOccurrence clContext workGroupSize - let scatterIndices = - Scatter.lastOccurrence clContext workGroupSize + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> - let reducedValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let firstReducedKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let secondReducedKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let resultPositions = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) - let kernel = kernel.GetKernel() + let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - firstKeys.Length - offsets - firstKeys - secondKeys - values - reducedValues - firstReducedKeys - secondReducedKeys - resultPositions) - ) + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + resultPositions) + ) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let resultLength = - (prefixSum processor resultPositions) - .ToHostAndFree processor + let resultLength = + (prefixSum processor resultPositions) + .ToHostAndFree processor - if resultLength = 0 then None - else - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + if resultLength = 0 then None + else + // write value + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterData processor resultPositions reducedValues resultValues + scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free processor - let resultFirstKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + // write first keys + let resultFirstKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterIndices processor resultPositions firstReducedKeys resultFirstKeys + scatterIndices processor resultPositions firstReducedKeys resultFirstKeys - firstReducedKeys.Free processor + firstReducedKeys.Free processor - let resultSecondKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + // write second keys + let resultSecondKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterIndices processor resultPositions secondReducedKeys resultSecondKeys + scatterIndices processor resultPositions secondReducedKeys resultSecondKeys - secondReducedKeys.Free processor + secondReducedKeys.Free processor - resultPositions.Free processor + resultPositions.Free processor - Some (resultValues, resultFirstKeys, resultSecondKeys) + Some (resultValues, resultFirstKeys, resultSecondKeys) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 2c15238d..baf88f47 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -99,9 +99,6 @@ module Matrix = let transposeInPlace = CSR.Matrix.transposeInPlace clContext workGroupSize - let rowsToCSR = - Rows.Matrix.toCSR clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> @@ -112,7 +109,7 @@ module Matrix = m.ToCSR |> transposeInPlace processor allocationMode |> ClMatrix.CSR - | _ -> failwith "not yet supported" + | _ -> failwith "Not yet implemented" /// /// Creates a new matrix, represented in COO format, that is equal to the given one. @@ -156,9 +153,6 @@ module Matrix = let transposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize - let rowsToCOO = - Rows.Matrix.toCOO clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> matrix @@ -170,7 +164,7 @@ module Matrix = |> toCOOInPlace processor allocationMode |> transposeInPlace processor |> ClMatrix.COO - | _ -> failwith "not yet supported" + | _ -> failwith "Not yet implemented" /// /// Creates a new matrix, represented in CSC format, that is equal to the given one. @@ -199,7 +193,7 @@ module Matrix = |> COOtoCSR processor allocationMode) .ToCSC |> ClMatrix.CSC - | _ -> failwith "not yet supported" + | _ -> failwith "Not yet implemented" /// /// Returns the matrix, represented in CSC format, that is equal to the given one. @@ -245,6 +239,7 @@ module Matrix = | ClMatrix.CSC m -> (mapCSR processor allocationMode m.ToCSR).ToCSC |> ClMatrix.CSC + | _ -> failwith "Not yet implemented" let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = // TODO() let map2COO = @@ -395,19 +390,19 @@ module Matrix = | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" - let expand - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - = - - let run = - SpGeMM.Expand.run clContext workGroupSize opAdd opMul - - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> - match leftMatrix, rightMatrix with - | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> - run processor allocationMode leftMatrix rightMatrix - |> ClMatrix.COO - | _ -> failwith "Matrix formats are not matching" + // let expand // TODO() + // (clContext: ClContext) + // workGroupSize + // (opAdd: Expr<'c -> 'c -> 'c option>) + // (opMul: Expr<'a -> 'b -> 'c option>) + // = + // + // let run = + // SpGeMM.Expand.run clContext workGroupSize opAdd opMul + // + // fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + // match leftMatrix, rightMatrix with + // | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> + // run processor allocationMode leftMatrix rightMatrix + // |> ClMatrix.COO + // | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index d4b8cda6..194461eb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -200,7 +200,7 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = let reduce = - Reduce.ByKey.segmentSequentialOption clContext workGroupSize opAdd // TODO(tests) + Reduce.ByKey.Option.segmentSequential clContext workGroupSize opAdd let getUniqueBitmap = ClArray.getUniqueBitmapLastOccurrence clContext workGroupSize diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index b30ff16e..f3019cce 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -68,3 +68,4 @@ module MatrixExtensions = Values = values } Matrix.CSC result + | _ -> failwith "Not yet implemented" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs new file mode 100644 index 00000000..34c8b991 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs @@ -0,0 +1,49 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Fill + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual testFun (value: 'a, targetIndex, count, target: 'a [] ) = + + if target.Length > 0 then + + let clTarget = context.CreateClArray target + let clValue = context.CreateClCell value + + testFun processor clValue 0 0 clTarget + + // release + let actual = clTarget.ToHostAndFree processor + + // write to target + Array.fill target targetIndex count value + + "Results must be the same" + |> Utils.compareArrays isEqual actual target + +let createTest<'a> isEqual = + ClArray.fill context Utils.defaultWorkGroupSize + |> makeTest isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest (=) + + createTest (=) + createTest (=) ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs new file mode 100644 index 00000000..5d35eae6 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs @@ -0,0 +1,52 @@ +module GraphBLAS.FSharp.Tests.Common.Backend.ClArray.Pairwise + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual testFun (array: 'a [] ) = + if array.Length > 0 then + + let clArray = context.CreateClArray array + + let (clFirstActual: ClArray<_>), (clSecondActual: ClArray<_>) + = testFun processor HostInterop clArray + + let firstActual = clFirstActual.ToHostAndFree processor + let secondActual = clSecondActual.ToHostAndFree processor + + let firstExpected, secondExpected = + Array.pairwise array + |> Array.unzip + + "First results must be the same" + |> Utils.compareArrays isEqual firstActual firstExpected + + "Second results must be the same" + |> Utils.compareArrays isEqual secondActual secondExpected + +let createTest<'a> isEqual = + ClArray.pairwise context Utils.defaultWorkGroupSize + |> makeTest isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest (=) + + createTest (=) + createTest (=) ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 09e0b21a..9226fd9b 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -49,7 +49,7 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let resultLength = Array.length <| Array.distinct keys - let clActualKeys, clActualValues: ClArray * ClArray<'a> = + let clActualValues, clActualKeys: ClArray<'a> * ClArray = reduce processor HostInterop resultLength clKeys clValues clValues.Free processor @@ -155,7 +155,7 @@ let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let clReducedKeys, clReducedValues: ClArray * ClArray<'a> = + let clReducedValues, clReducedKeys: ClArray<'a> * ClArray = reduce processor DeviceOnly resultLength clOffsets clKeys clValues let reducedKeys = clReducedKeys.ToHostAndFree processor @@ -232,7 +232,7 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = Array.length <| Array.distinctBy (fun (fst, snd, _) -> (fst, snd)) array - let clFirstActualKeys, clSecondActualKeys, clActualValues: ClArray * ClArray * ClArray<'a> = + let clActualValues, clFirstActualKeys, clSecondActualKeys: ClArray<'a> * ClArray * ClArray = reduce processor HostInterop resultLength clFirstKeys clSecondKeys clValues clValues.Free processor @@ -257,7 +257,7 @@ let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = makeTest2D isEqual reduce reduceOp |> testPropertyWithConfig { config with - arbitrary = [ typeof ] + arbitrary = [ typeof ] endSize = 10 } $"test on {typeof<'a>}" @@ -316,7 +316,7 @@ let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = + let clReducedValues, clFirstActualKeys, clSecondActualKeys: ClArray<'a> * ClArray * ClArray = reduce processor DeviceOnly resultLength clOffsets clFirstKeys clSecondKeys clValues let reducedFirsKeys = @@ -336,7 +336,7 @@ let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp redu makeTestSequentialSegments2D isEqual reduce reduceOp |> testPropertyWithConfig { config with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } $"test on {typeof<'a>}" let sequentialSegment2DTests = @@ -366,15 +366,92 @@ let sequentialSegment2DTests = testList "Sequential segments 2D" [ addTests; mulTests ] -let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp = - - let reduceOp left right = +// segments sequential Option +let createReduceOp reduceOp left right = match left, right with | Some left, Some right -> reduceOp left right | Some value, None | None, Some value -> Some value | _ -> None +let checkResultOption isEqual keys values reduceOp actual = + + let reduceOp = createReduceOp reduceOp + + let expectedKeys, expectedValues = + Array.zip keys values + |> Array.groupBy fst + |> Array.map (fun (key, array) -> key, Array.map snd array) + |> Array.map + (fun (key, array) -> + Array.map Some array + |> Array.reduce reduceOp + |> fun result -> key, result) + |> Array.choose + (fun (key, value) -> + match value with + | Some value -> Some(key, value) + | _ -> None) + |> Array.unzip + + match actual with + | Some (actualValues, actualKeys) -> + "First keys must be the same" + |> Utils.compareArrays (=) actualKeys expectedKeys + + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + | None -> + Expect.isTrue (expectedValues.Length = 0) "Result should be Some _" + +let testOption<'a> isEqual reduceOp testFun (array: (int * 'a) []) = + if array.Length > 0 then + let array = Array.sortBy fst array + + let offsets = getOffsets array + + let keys, values = Array.unzip array + + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + testFun processor HostInterop offsets.Length clOffsets clKeys clValues + |> Option.bind (fun ((clActualValues, clActualKeys): ClArray<_> * ClArray<_>) -> + let actualValues = clActualValues.ToHostAndFree processor + let actualKeys = clActualKeys.ToHostAndFree processor + + Some (actualValues, actualKeys)) + |> checkResultOption isEqual keys values reduceOp + +let createTestOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = + Reduce.ByKey.Option.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + |> testOption<'a> isEqual reduceOp + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" + +let testsSegmentsSequentialOption = + [ createTestOption (=) ArithmeticOperations.intAdd + + if Utils.isFloat64Available context.ClDevice then + createTestOption Utils.floatIsEqual ArithmeticOperations.floatAdd + + createTestOption Utils.float32IsEqual ArithmeticOperations.float32Add + createTestOption (=) ArithmeticOperations.boolAdd ] + |> testList "option" + + +// segments sequential Option 2D +let checkResult2DOption isEqual firstKeys secondKeys values reduceOp actual = + let reduceOp = createReduceOp reduceOp + let expectedFirstKeys, expectedSecondKeys, expectedValues = let keys = Array.zip firstKeys secondKeys @@ -393,16 +470,19 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi | _ -> None) |> Array.unzip3 - "First keys must be the same" - |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys + match actual with + | Some (actualValues, firstActualKeys, secondActualKeys) -> + "First keys must be the same" + |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys - "Second keys must be the same" - |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys + "Second keys must be the same" + |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys - "Values must the same" - |> Utils.compareArrays isEqual actualValues expectedValues + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + | None -> Expect.isTrue (expectedValues.Length = 0) "Result should be Some _" -let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = +let test2DOption<'a> isEqual reduceOp reduce (array: (int * int * 'a) []) = if array.Length > 0 then let array = Array.sortBy (fun (fst, snd, _) -> fst, snd) array @@ -423,27 +503,25 @@ let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = - reduce processor DeviceOnly offsets.Length clOffsets clFirstKeys clSecondKeys clValues + reduce processor DeviceOnly offsets.Length clOffsets clFirstKeys clSecondKeys clValues + |> Option.bind (fun ((clReducedValues, clFirstActualKeys, clSecondActualKeys): ClArray<'a> * ClArray * ClArray) -> + let reducedFirstKeys = + clFirstActualKeys.ToHostAndFree processor - let reducedFirsKeys = - clFirstActualKeys.ToHostAndFree processor + let reducedSecondKeys = + clSecondActualKeys.ToHostAndFree processor - let reducesSecondKeys = - clSecondActualKeys.ToHostAndFree processor - - let reducedValues = clReducedValues.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor - checkResult2DOption isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp + Some (reducedValues, reducedFirstKeys, reducedSecondKeys)) + |> checkResult2DOption isEqual firstKeys secondKeys values reduceOp let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = - let reduce = - Reduce.ByKey2D.segmentSequentialOption context Utils.defaultWorkGroupSize reduceOpQ - - test2DOption<'a> isEqual reduce reduceOp + Reduce.ByKey2D.Option.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + |> test2DOption<'a> isEqual reduceOp |> testPropertyWithConfig { config with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } $"test on {typeof<'a>}" let testsSegmentsSequential2DOption = @@ -464,4 +542,5 @@ let allTests = sequentialSegmentTests sequential2DTest sequentialSegment2DTests + testsSegmentsSequentialOption testsSegmentsSequential2DOption ] diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index c45a6f6c..37ec7d81 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -511,6 +511,83 @@ module Generators = |> Arb.fromGen type ArrayOfDistinctKeys() = + static let arrayOfDistinctKeysGenerator (keysGenerator: Gen<'n>) (valuesGenerator: Gen<'a>) = + let tuplesGenerator = + Gen.zip + <| keysGenerator + <| valuesGenerator + + gen { + let! length = Gen.sized <| fun size -> Gen.choose (1, size) + + let! array = Gen.arrayOfLength <| length <| tuplesGenerator + + return Array.distinctBy fst array + } + + static member IntType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + type ArrayOfDistinctKeys2D() = static let arrayOfDistinctKeysGenerator (keysGenerator: Gen<'n>) (valuesGenerator: Gen<'a>) = let tuplesGenerator = Gen.zip3 diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 50905bde..5493767f 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -28,6 +28,8 @@ + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 829d9e65..d39742c7 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -26,7 +26,7 @@ module Utils = typeof typeof typeof - typeof + typeof typeof typeof typeof diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 00ce048d..38d70b6c 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -1,266 +1,266 @@ -module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand - -open Expecto -open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.Test -open Microsoft.FSharp.Collections -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Objects.MatrixExtensions - -let context = Context.defaultContext.ClContext - -let processor = Context.defaultContext.Queue - -let config = - { Utils.defaultConfig with - arbitrary = [ typeof ] - endSize = 100 - maxTest = 100 } - -let createCSRMatrix array isZero = - Utils.createMatrixFromArray2D CSR array isZero - |> Utils.castMatrixToCSR - -let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - Array.map - (fun item -> - rightMatrix.RowPointers.[item + 1] - - rightMatrix.RowPointers.[item]) - leftMatrix.ColumnIndices - |> HostPrimitives.prefixSumExclude 0 (+) - -let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = createCSRMatrix leftArray isZero - - let rightMatrix = createCSRMatrix rightArray isZero - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - let clLeftMatrix = leftMatrix.ToDevice context - - let clRightMatrix = rightMatrix.ToDevice context - - let actualLength, (clActual: ClArray) = - testFun processor clLeftMatrix clRightMatrix - - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - - let actualPointers = clActual.ToHostAndFree processor - - let expectedPointers, expectedLength = - getSegmentsPointers leftMatrix rightMatrix - - "Results lengths must be the same" - |> Expect.equal actualLength expectedLength - - "Result pointers must be the same" - |> Expect.sequenceEqual actualPointers expectedPointers - -let createTest<'a when 'a: struct> (isZero: 'a -> bool) = - - let testFun = - Expand.getSegmentPointers context Utils.defaultWorkGroupSize - - makeTest isZero testFun - |> testPropertyWithConfig config $"test on {typeof<'a>}" - -let getSegmentsTests = - [ createTest ((=) 0) - - if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) - - createTest ((=) 0f) - createTest ((=) false) - createTest ((=) 0uy) ] - |> testList "get segment pointers" - -let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - let extendPointers pointers = - Array.pairwise pointers - |> Array.map (fun (fst, snd) -> snd - fst) - |> Array.mapi (fun index length -> Array.create length index) - |> Array.concat - - let segmentsLengths = - Array.append segmentPointers [| length |] - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) - - let leftMatrixValues, expectedRows = - let tripleFst (fst, _, _) = fst - - Array.zip3 segmentsLengths leftMatrix.Values - <| extendPointers leftMatrix.RowPointers - // select items each segment length not zero - |> Array.filter (tripleFst >> ((=) 0) >> not) - |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) - |> Array.unzip - - let rightMatrixValues, expectedColumns = - let valuesAndColumns = - Array.zip rightMatrix.Values rightMatrix.ColumnIndices - - Array.map2 - (fun column length -> - let rowStart = rightMatrix.RowPointers.[column] - Array.take length valuesAndColumns.[rowStart..]) - leftMatrix.ColumnIndices - segmentsLengths - |> Array.concat - |> Array.unzip - - leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows - -let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = - createCSRMatrix leftArray <| isEqual zero - - let rightMatrix = - createCSRMatrix rightArray <| isEqual zero - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - let segmentPointers, length = - getSegmentsPointers leftMatrix rightMatrix - - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - let clSegmentPointers = context.CreateClArray segmentPointers - - let ((clActualLeftValues: ClArray<'a>), - (clActualRightValues: ClArray<'a>), - (clActualColumns: ClArray), - (clActualRows: ClArray)) = - testFun processor length clSegmentPointers clLeftMatrix clRightMatrix - - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - clSegmentPointers.Free processor - - let actualLeftValues = - clActualLeftValues.ToHostAndFree processor - - let actualRightValues = - clActualRightValues.ToHostAndFree processor - - let actualColumns = clActualColumns.ToHostAndFree processor - let actualRows = clActualRows.ToHostAndFree processor - - let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = - expand length segmentPointers leftMatrix rightMatrix - - "Left values must be the same" - |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues - - "Right values must be the same" - |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues - - "Columns must be the same" - |> Utils.compareArrays (=) actualColumns expectedColumns - - "Rows must be the same" - |> Utils.compareArrays (=) actualRows expectedRows - -let createExpandTest isEqual (zero: 'a) testFun = - - let testFun = - testFun context Utils.defaultWorkGroupSize - - makeExpandTest isEqual zero testFun - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -// expand phase tests -let expandTests = - [ createExpandTest (=) 0 Expand.expand - - if Utils.isFloat64Available context.ClDevice then - createExpandTest Utils.floatIsEqual 0.0 Expand.expand - - createExpandTest Utils.float32IsEqual 0f Expand.expand - createExpandTest (=) false Expand.expand - createExpandTest (=) 0uy Expand.expand ] - |> testList "Expand.expand" - -let checkGeneralResult zero isEqual (actualMatrix: Matrix<'a>) mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = - - let expected = - HostPrimitives.array2DMultiplication zero mul add leftArray rightArray - |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) - - match actualMatrix, expected with - | Matrix.COO actualMatrix, Matrix.COO expected -> - - "Values must be the same" - |> Utils.compareArrays isEqual actualMatrix.Values expected.Values - - "Columns must be the same" - |> Utils.compareArrays (=) actualMatrix.Columns expected.Columns - - "Rows must be the same" - |> Utils.compareArrays (=) actualMatrix.Rows expected.Rows - | _ -> failwith "Matrix format are not matching" - -let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) - - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - try - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - - let (clMatrixActual: ClMatrix<_>) = - testFun processor HostInterop clLeftMatrix clRightMatrix - - let matrixActual = clMatrixActual.ToHost processor - clMatrixActual.Dispose processor - - checkGeneralResult zero isEqual matrixActual opMul opAdd leftArray rightArray - with - | ex when ex.Message = "InvalidBufferSize" -> () - | _ -> reraise () - -let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = - - let testFun = - testFun context Utils.defaultWorkGroupSize opAddQ opMulQ - - makeGeneralTest zero isEqual opMul opAdd testFun - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -let generalTests = - [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand - - if Utils.isFloat64Available context.ClDevice then - createGeneralTest - 0.0 - Utils.floatIsEqual - ArithmeticOperations.floatAdd - ArithmeticOperations.floatMul - Matrix.SpGeMM.expand - - createGeneralTest - 0.0f - Utils.float32IsEqual - ArithmeticOperations.float32Add - ArithmeticOperations.float32Mul - Matrix.SpGeMM.expand - createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] - |> testList "general" + module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand +// TODO() +// open Expecto +// open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +// open GraphBLAS.FSharp.Backend.Quotes +// open GraphBLAS.FSharp.Test +// open Microsoft.FSharp.Collections +// open GraphBLAS.FSharp.Backend +// open GraphBLAS.FSharp.Backend.Matrix +// open GraphBLAS.FSharp.Backend.Objects +// open GraphBLAS.FSharp.Tests +// open GraphBLAS.FSharp.Tests.Backend +// open GraphBLAS.FSharp.Objects +// open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +// open Brahma.FSharp +// open GraphBLAS.FSharp.Backend.Objects.ClContext +// open GraphBLAS.FSharp.Objects.MatrixExtensions +// +// let context = Context.defaultContext.ClContext +// +// let processor = Context.defaultContext.Queue +// +// let config = +// { Utils.defaultConfig with +// arbitrary = [ typeof ] +// endSize = 100 +// maxTest = 100 } +// +// let createCSRMatrix array isZero = +// Utils.createMatrixFromArray2D CSR array isZero +// |> Utils.castMatrixToCSR +// +// let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = +// Array.map +// (fun item -> +// rightMatrix.RowPointers.[item + 1] +// - rightMatrix.RowPointers.[item]) +// leftMatrix.ColumnIndices +// |> HostPrimitives.prefixSumExclude 0 (+) +// +// let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = +// +// let leftMatrix = createCSRMatrix leftArray isZero +// +// let rightMatrix = createCSRMatrix rightArray isZero +// +// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then +// +// let clLeftMatrix = leftMatrix.ToDevice context +// +// let clRightMatrix = rightMatrix.ToDevice context +// +// let actualLength, (clActual: ClArray) = +// testFun processor clLeftMatrix clRightMatrix +// +// clLeftMatrix.Dispose processor +// clRightMatrix.Dispose processor +// +// let actualPointers = clActual.ToHostAndFree processor +// +// let expectedPointers, expectedLength = +// getSegmentsPointers leftMatrix rightMatrix +// +// "Results lengths must be the same" +// |> Expect.equal actualLength expectedLength +// +// "Result pointers must be the same" +// |> Expect.sequenceEqual actualPointers expectedPointers +// +// let createTest<'a when 'a: struct> (isZero: 'a -> bool) = +// +// let testFun = +// Expand.getSegmentPointers context Utils.defaultWorkGroupSize +// +// makeTest isZero testFun +// |> testPropertyWithConfig config $"test on {typeof<'a>}" +// +// let getSegmentsTests = +// [ createTest ((=) 0) +// +// if Utils.isFloat64Available context.ClDevice then +// createTest ((=) 0.0) +// +// createTest ((=) 0f) +// createTest ((=) false) +// createTest ((=) 0uy) ] +// |> testList "get segment pointers" +// +// let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = +// let extendPointers pointers = +// Array.pairwise pointers +// |> Array.map (fun (fst, snd) -> snd - fst) +// |> Array.mapi (fun index length -> Array.create length index) +// |> Array.concat +// +// let segmentsLengths = +// Array.append segmentPointers [| length |] +// |> Array.pairwise +// |> Array.map (fun (fst, snd) -> snd - fst) +// +// let leftMatrixValues, expectedRows = +// let tripleFst (fst, _, _) = fst +// +// Array.zip3 segmentsLengths leftMatrix.Values +// <| extendPointers leftMatrix.RowPointers +// // select items each segment length not zero +// |> Array.filter (tripleFst >> ((=) 0) >> not) +// |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) +// |> Array.unzip +// +// let rightMatrixValues, expectedColumns = +// let valuesAndColumns = +// Array.zip rightMatrix.Values rightMatrix.ColumnIndices +// +// Array.map2 +// (fun column length -> +// let rowStart = rightMatrix.RowPointers.[column] +// Array.take length valuesAndColumns.[rowStart..]) +// leftMatrix.ColumnIndices +// segmentsLengths +// |> Array.concat +// |> Array.unzip +// +// leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows +// +// let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = +// +// let leftMatrix = +// createCSRMatrix leftArray <| isEqual zero +// +// let rightMatrix = +// createCSRMatrix rightArray <| isEqual zero +// +// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then +// +// let segmentPointers, length = +// getSegmentsPointers leftMatrix rightMatrix +// +// let clLeftMatrix = leftMatrix.ToDevice context +// let clRightMatrix = rightMatrix.ToDevice context +// let clSegmentPointers = context.CreateClArray segmentPointers +// +// let ((clActualLeftValues: ClArray<'a>), +// (clActualRightValues: ClArray<'a>), +// (clActualColumns: ClArray), +// (clActualRows: ClArray)) = +// testFun processor length clSegmentPointers clLeftMatrix clRightMatrix +// +// clLeftMatrix.Dispose processor +// clRightMatrix.Dispose processor +// clSegmentPointers.Free processor +// +// let actualLeftValues = +// clActualLeftValues.ToHostAndFree processor +// +// let actualRightValues = +// clActualRightValues.ToHostAndFree processor +// +// let actualColumns = clActualColumns.ToHostAndFree processor +// let actualRows = clActualRows.ToHostAndFree processor +// +// let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = +// expand length segmentPointers leftMatrix rightMatrix +// +// "Left values must be the same" +// |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues +// +// "Right values must be the same" +// |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues +// +// "Columns must be the same" +// |> Utils.compareArrays (=) actualColumns expectedColumns +// +// "Rows must be the same" +// |> Utils.compareArrays (=) actualRows expectedRows +// +// let createExpandTest isEqual (zero: 'a) testFun = +// +// let testFun = +// testFun context Utils.defaultWorkGroupSize +// +// makeExpandTest isEqual zero testFun +// |> testPropertyWithConfig config $"test on %A{typeof<'a>}" +// +// // expand phase tests +// let expandTests = +// [ createExpandTest (=) 0 Expand.expand +// +// if Utils.isFloat64Available context.ClDevice then +// createExpandTest Utils.floatIsEqual 0.0 Expand.expand +// +// createExpandTest Utils.float32IsEqual 0f Expand.expand +// createExpandTest (=) false Expand.expand +// createExpandTest (=) 0uy Expand.expand ] +// |> testList "Expand.expand" +// +// let checkGeneralResult zero isEqual (actualMatrix: Matrix<'a>) mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = +// +// let expected = +// HostPrimitives.array2DMultiplication zero mul add leftArray rightArray +// |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) +// +// match actualMatrix, expected with +// | Matrix.COO actualMatrix, Matrix.COO expected -> +// +// "Values must be the same" +// |> Utils.compareArrays isEqual actualMatrix.Values expected.Values +// +// "Columns must be the same" +// |> Utils.compareArrays (=) actualMatrix.Columns expected.Columns +// +// "Rows must be the same" +// |> Utils.compareArrays (=) actualMatrix.Rows expected.Rows +// | _ -> failwith "Matrix format are not matching" +// +// let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = +// +// let leftMatrix = +// Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) +// +// let rightMatrix = +// Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) +// +// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then +// try +// let clLeftMatrix = leftMatrix.ToDevice context +// let clRightMatrix = rightMatrix.ToDevice context +// +// let (clMatrixActual: ClMatrix<_>) = +// testFun processor HostInterop clLeftMatrix clRightMatrix +// +// let matrixActual = clMatrixActual.ToHost processor +// clMatrixActual.Dispose processor +// +// checkGeneralResult zero isEqual matrixActual opMul opAdd leftArray rightArray +// with +// | ex when ex.Message = "InvalidBufferSize" -> () +// | _ -> reraise () +// +// let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = +// +// let testFun = +// testFun context Utils.defaultWorkGroupSize opAddQ opMulQ +// +// makeGeneralTest zero isEqual opMul opAdd testFun +// |> testPropertyWithConfig config $"test on %A{typeof<'a>}" +// +// let generalTests = +// [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand +// +// if Utils.isFloat64Available context.ClDevice then +// createGeneralTest +// 0.0 +// Utils.floatIsEqual +// ArithmeticOperations.floatAdd +// ArithmeticOperations.floatMul +// Matrix.SpGeMM.expand +// +// createGeneralTest +// 0.0f +// Utils.float32IsEqual +// ArithmeticOperations.float32Add +// ArithmeticOperations.float32Mul +// Matrix.SpGeMM.expand +// createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] +// |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index bd0e20fc..aba6d04c 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,5 +95,5 @@ open GraphBLAS.FSharp.Tests [] let main argv = - Common.ClArray.chunkBySize.allTests + testList "lol" [ Common.Reduce.ByKey.testsSegmentsSequentialOption ] |> runTestsWithCLIArgs [] argv From 98d41dd61efa358bdf12002278f897d87aede53e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 16 Apr 2023 18:48:03 +0300 Subject: [PATCH 072/143] add: ClArray.assign tests --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 18 +++--- .../Common/ClArray/Assign.fs | 17 +++--- .../Common/ClArray/ChunkBySize.fs | 2 +- tests/GraphBLAS-sharp.Tests/Generators.fs | 60 +++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 5 files changed, 79 insertions(+), 20 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index a10698e8..4008e720 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -562,34 +562,34 @@ module ClArray = let assign<'a> (clContext: ClContext) workGroupSize = let assign = - <@ fun (ndRange: Range1D) startPosition appendedArrayLength (inputArray: ClArray<'a>) (result: ClArray<'a>) -> + <@ fun (ndRange: Range1D) targetPosition sourceArrayLength (sourceArray: ClArray<'a>) (targetArray: ClArray<'a>) -> let gid = ndRange.GlobalID0 - let resultPosition = gid + startPosition + let resultPosition = gid + targetPosition - if gid < appendedArrayLength then + if gid < sourceArrayLength then - result.[resultPosition] <- inputArray.[gid] @> + targetArray.[resultPosition] <- sourceArray.[gid] @> let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (targetArray: ClArray<'a>) startPosition (appendedArray: ClArray<'a>) -> - if startPosition < 0 then + fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) targetPosition (targetArray: ClArray<'a>) -> + if targetPosition < 0 then failwith "The starting position cannot be less than zero" - if startPosition + appendedArray.Length > targetArray.Length then + if targetPosition + sourceArray.Length > targetArray.Length then failwith "The array should fit completely" let ndRange = - Range1D.CreateValid(appendedArray.Length, workGroupSize) + Range1D.CreateValid(targetArray.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments (fun () -> - kernel.KernelFunc ndRange appendedArray.Length appendedArray.Length appendedArray targetArray) + kernel.KernelFunc ndRange targetPosition sourceArray.Length sourceArray targetArray) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs index 12e868de..65f2c0c5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backned.Common.ClArray.Assign +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Assign open Expecto open Brahma.FSharp @@ -13,21 +13,20 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } -let makeTest<'a> isEqual testFun (source: 'a []) (target: 'a []) = +let makeTest<'a> isEqual testFun (source: 'a [], target: 'a [], targetPosition: int) = if source.Length > 0 && target.Length > 0 then let clSource = context.CreateClArray source let clTarget = context.CreateClArray target - let targetPosition = 0 testFun processor clSource targetPosition clTarget - let actual = clSource.ToHostAndFree processor - clTarget.Free processor + clSource.Free processor + let actual = clTarget.ToHostAndFree processor // write to target --- target expected Array.blit source 0 target targetPosition source.Length @@ -37,15 +36,15 @@ let makeTest<'a> isEqual testFun (source: 'a []) (target: 'a []) = let createTest<'a when 'a : equality> isEqual = ClArray.assign context Utils.defaultWorkGroupSize - |> makeTest isEqual + |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let tests = [ createTest (=) if Utils.isFloat64Available context.ClDevice then - createTest (=) + createTest Utils.floatIsEqual - createTest (=) + createTest Utils.float32IsEqual createTest (=) ] |> testList "Assign" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs index 7f6e0b47..4501fa23 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.chunkBySize +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.ChunkBySize open Expecto open Brahma.FSharp diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 37ec7d81..63e07275 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -956,3 +956,63 @@ module Generators = static member BoolType() = arrayAndChunkPosition <| Arb.generate |> Arb.fromGen + + type AssignArray() = + static let pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) = + gen { + let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (2, size) + + let! targetArray = Gen.arrayOfLength targetArrayLength valuesGenerator + + let! sourceArrayLength = Gen.choose (1, targetArrayLength) + + let! sourceArray = Gen.arrayOfLength sourceArrayLength valuesGenerator + + let! startPosition = Gen.choose (0, targetArrayLength - sourceArrayLength) + + return (sourceArray, targetArray, startPosition) + } + + static member IntType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfVectorsOfEqualSize + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfVectorsOfEqualSize + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index aba6d04c..e1f76f9f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,5 +95,5 @@ open GraphBLAS.FSharp.Tests [] let main argv = - testList "lol" [ Common.Reduce.ByKey.testsSegmentsSequentialOption ] + testList "lol" [ Common.ClArray.Assign.tests ] |> runTestsWithCLIArgs [] argv From 1f273d1d93835d0c772e829a922cf9b25bc4a884 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 16 Apr 2023 19:10:33 +0300 Subject: [PATCH 073/143] add: ClArray.concat tests --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 6 ++---- .../Common/ClArray/Concat.fs | 17 ++++++++--------- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 3 files changed, 11 insertions(+), 14 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 4008e720..69b3ed5a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -607,12 +607,10 @@ module ClArray = let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let assign = assign processor result - // write each array to result Seq.fold - (fun previousLength array -> - assign previousLength array + (fun previousLength (array: ClArray<_>) -> + assign processor array previousLength result previousLength + array.Length) 0 sourceArrays diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs index fd44df09..4e807e8f 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs @@ -3,7 +3,6 @@ module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Concat open Expecto open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext @@ -12,13 +11,12 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let config = - { Utils.defaultConfig with - arbitrary = [ typeof ] } +let config = Utils.defaultConfig -let makeTest<'a> isEqual testFun (arrays: 'a [] seq) = +let makeTest<'a> isEqual testFun (arrays: 'a [] []) = - if Seq.length arrays > 0 then + if Seq.length arrays > 0 + && arrays |> Seq.forall (fun array -> array.Length > 0) then let clArrays = arrays |> Seq.map context.CreateClArray @@ -35,14 +33,15 @@ let makeTest<'a> isEqual testFun (arrays: 'a [] seq) = let createTest<'a> isEqual = ClArray.concat context Utils.defaultWorkGroupSize - |> makeTest isEqual + |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let tests = [ createTest (=) if Utils.isFloat64Available context.ClDevice then - createTest (=) + createTest Utils.floatIsEqual - createTest (=) + createTest Utils.float32IsEqual createTest (=) ] + |> testList "Concat" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index e1f76f9f..a556294c 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,5 +95,5 @@ open GraphBLAS.FSharp.Tests [] let main argv = - testList "lol" [ Common.ClArray.Assign.tests ] + testList "lol" [ Common.ClArray.Concat.tests ] |> testSequenced |> runTestsWithCLIArgs [] argv From 830b2f9577fa79c37fb9401c842ddb5088b1cc7a Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 17 Apr 2023 10:14:22 +0300 Subject: [PATCH 074/143] wip: ClArray.pairwise --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 55 +++++++++------- .../Matrix/SpGeMM/Expand.fs | 19 +++--- .../Common/ClArray/Fill.fs | 12 ++-- .../Common/ClArray/Pairwise.fs | 30 ++++----- tests/GraphBLAS-sharp.Tests/Generators.fs | 62 ++++++++++++++++++- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 6 files changed, 125 insertions(+), 55 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 69b3ed5a..6fa25b54 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -621,35 +621,36 @@ module ClArray = let fill (clContext: ClContext) workGroupSize = let fill = - <@ fun (ndRange: Range1D) firstPosition endPosition (value: ClCell<'a>) (targetArray: ClArray<'a>) -> + <@ fun (ndRange: Range1D) firstPosition count (value: ClCell<'a>) (targetArray: ClArray<'a>) -> let gid = ndRange.GlobalID0 let writePosition = gid + firstPosition - if writePosition < endPosition then - + if gid < count then targetArray.[writePosition] <- value.Value @> let kernel = clContext.Compile fill fun (processor: MailboxProcessor<_>) value firstPosition count (targetArray: ClArray<'a>) -> - if firstPosition + count > targetArray.Length then - failwith "" + if count = 0 then () + else + if firstPosition + count > targetArray.Length then + failwith "" - if firstPosition < 0 then failwith "" - if count <= 0 then failwith "" // TODO() + if firstPosition < 0 then failwith "" + if count < 0 then failwith "" // TODO() - let ndRange = - Range1D.CreateValid(count, workGroupSize) + let ndRange = + Range1D.CreateValid(count, workGroupSize) - let kernel = kernel.GetKernel() + let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange firstPosition (firstPosition + count) value targetArray) - ) + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange firstPosition count value targetArray) + ) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let pairwise (clContext: ClContext) workGroupSize = @@ -659,18 +660,26 @@ module ClArray = let incGather = Gather.runInit Map.inc clContext workGroupSize + let map = map2 clContext workGroupSize <@ fun first second -> (first, second) @> + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) -> + if values.Length > 1 then + let resultLength = values.Length - 1 - let resultLength = values.Length - 1 + let firstItems = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let firstItems = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + idGather processor values firstItems - idGather processor values firstItems + let secondItems = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let secondItems = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + incGather processor values secondItems + + let result = map processor allocationMode firstItems secondItems - incGather processor values secondItems + firstItems.Free processor + secondItems.Free processor - firstItems, secondItems + Some result + else None diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 194461eb..efab851d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -26,15 +26,16 @@ module Expand = fun (processor: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'b>) -> - let firstPointers, secondPointers = - pairwise processor DeviceOnly matrix.RowPointers - - let rowsLength = subtract processor DeviceOnly secondPointers firstPointers - - firstPointers.Free processor - secondPointers.Free processor - - rowsLength + // let firstPointers, secondPointers = + // pairwise processor DeviceOnly matrix.RowPointers + + // let rowsLength = subtract processor DeviceOnly secondPointers firstPointers + // + // firstPointers.Free processor + // secondPointers.Free processor + // + // rowsLength + clContext.CreateClArray [| |] let getSegmentPointers (clContext: ClContext) workGroupSize = diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs index 34c8b991..196d89f6 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs @@ -14,29 +14,28 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } - -let makeTest<'a> isEqual testFun (value: 'a, targetIndex, count, target: 'a [] ) = + arbitrary = [ typeof ] } +let makeTest<'a> isEqual testFun (value: 'a, targetPosition, count, target: 'a [] ) = if target.Length > 0 then let clTarget = context.CreateClArray target let clValue = context.CreateClCell value - testFun processor clValue 0 0 clTarget + testFun processor clValue targetPosition count clTarget // release let actual = clTarget.ToHostAndFree processor // write to target - Array.fill target targetIndex count value + Array.fill target targetPosition count value "Results must be the same" |> Utils.compareArrays isEqual actual target let createTest<'a> isEqual = ClArray.fill context Utils.defaultWorkGroupSize - |> makeTest isEqual + |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let tests = @@ -47,3 +46,4 @@ let tests = createTest (=) createTest (=) ] + |> testList "Fill" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs index 5d35eae6..c78ac497 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Common.Backend.ClArray.Pairwise +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Pairwise open Expecto open Brahma.FSharp @@ -14,32 +14,31 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } let makeTest<'a> isEqual testFun (array: 'a [] ) = if array.Length > 0 then let clArray = context.CreateClArray array - let (clFirstActual: ClArray<_>), (clSecondActual: ClArray<_>) - = testFun processor HostInterop clArray + testFun processor HostInterop clArray + |> Option.bind (fun (clFirstActual: ClArray<_>, clSecondActual: ClArray<_>) -> + let firstActual = clFirstActual.ToHostAndFree processor + let secondActual = clSecondActual.ToHostAndFree processor - let firstActual = clFirstActual.ToHostAndFree processor - let secondActual = clSecondActual.ToHostAndFree processor + let firstExpected, secondExpected = Array.pairwise array |> Array.unzip - let firstExpected, secondExpected = - Array.pairwise array - |> Array.unzip + "First results must be the same" + |> Utils.compareArrays isEqual firstActual firstExpected - "First results must be the same" - |> Utils.compareArrays isEqual firstActual firstExpected - - "Second results must be the same" - |> Utils.compareArrays isEqual secondActual secondExpected + "Second results must be the same" + |> Utils.compareArrays isEqual secondActual secondExpected + None) + |> ignore let createTest<'a> isEqual = ClArray.pairwise context Utils.defaultWorkGroupSize - |> makeTest isEqual + |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let tests = @@ -50,3 +49,4 @@ let tests = createTest (=) createTest (=) ] + |> testList "Pairwise" diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 63e07275..aa84f71b 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -960,7 +960,7 @@ module Generators = type AssignArray() = static let pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) = gen { - let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (2, size) + let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (2, size + 2) let! targetArray = Gen.arrayOfLength targetArrayLength valuesGenerator @@ -1016,3 +1016,63 @@ module Generators = static member BoolType() = pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen + + type Fill() = + static let pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) = + gen { + let! value = valuesGenerator + + let! targetArrayLength = Gen.sized <| fun size -> Gen.choose(1, size + 1) + + let! targetArray = Gen.arrayOfLength targetArrayLength valuesGenerator + + let! targetPosition = Gen.choose (0, targetArrayLength) + + let! targetCount = Gen.choose(0, targetArrayLength - targetPosition) + + return (value, targetPosition, targetCount, targetArray) + } + + static member IntType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfVectorsOfEqualSize + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfVectorsOfEqualSize + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index a556294c..19e04826 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,5 +95,5 @@ open GraphBLAS.FSharp.Tests [] let main argv = - testList "lol" [ Common.ClArray.Concat.tests ] |> testSequenced + testList "lol" [ Common.ClArray.Pairwise.tests ] |> testSequenced |> runTestsWithCLIArgs [] argv From 92b186f9be24f699a4e4056782932a12510afeb4 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 17 Apr 2023 10:16:49 +0300 Subject: [PATCH 075/143] add: ClArray.pairwise --- tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs index c78ac497..734087c1 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs @@ -22,9 +22,10 @@ let makeTest<'a> isEqual testFun (array: 'a [] ) = let clArray = context.CreateClArray array testFun processor HostInterop clArray - |> Option.bind (fun (clFirstActual: ClArray<_>, clSecondActual: ClArray<_>) -> - let firstActual = clFirstActual.ToHostAndFree processor - let secondActual = clSecondActual.ToHostAndFree processor + |> Option.bind (fun (actual: ClArray<_>) -> + let firstActual, secondActual = + actual.ToHostAndFree processor + |> Array.unzip let firstExpected, secondExpected = Array.pairwise array |> Array.unzip From 089e11ef603babec5dbfe0c2cb6b1f915621b9dd Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 17 Apr 2023 14:34:34 +0300 Subject: [PATCH 076/143] add: Matrix.Rows.Convert --- .../BenchmarksMxm.fs | 2 +- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 6 +- .../Matrix/COO/Matrix.fs | 38 +------- src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs | 2 +- .../Matrix/CSR/Map2.fs | 2 +- .../Matrix/CSR/Map2AtLeastOne.fs | 2 +- .../Matrix/CSR/Matrix.fs | 41 ++++++++- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 86 +++++++++++++------ .../Matrix/Rows/Matrix.fs | 77 ++++++----------- .../Matrix/SpGeMM/Expand.fs | 23 +---- src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 1 + src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 2 + .../Vector/Sparse/SparseVector.fs | 21 ----- src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj | 2 +- src/GraphBLAS-sharp/Objects/Matrix.fs | 42 +++++++++ .../Objects/MatrixExtensions.fs | 86 ++++++------------- src/GraphBLAS-sharp/Objects/Vector.fs | 5 +- .../Objects/VectorExtensions.fs | 21 ++--- tests/GraphBLAS-sharp.Tests/Helpers.fs | 3 + tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs | 82 ++++++------------ tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 21 files changed, 249 insertions(+), 297 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs index f5c706d6..efbe86c9 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs @@ -75,7 +75,7 @@ type MxmBenchmarks<'elem when 'elem : struct>( member this.FunCSR2CSC = match funCSR2CSC with | None -> - let x = Matrix.toCSCInplace this.OclContext this.WorkGroupSize + let x = Matrix.toCSCInPlace this.OclContext this.WorkGroupSize funCSR2CSC <- Some x x | Some x -> x diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 6fa25b54..80e4f5a9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -635,10 +635,10 @@ module ClArray = if count = 0 then () else if firstPosition + count > targetArray.Length then - failwith "" + failwith "The array should fit completely" - if firstPosition < 0 then failwith "" - if count < 0 then failwith "" // TODO() + if firstPosition < 0 then failwith "The starting position cannot be less than zero" + if count < 0 then failwith "The count cannot be less than zero" let ndRange = Range1D.CreateValid(count, workGroupSize) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index 61006763..2230f815 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -107,7 +107,7 @@ module Matrix = Columns = cols Values = values } - let toCSRInplace (clContext: ClContext) workGroupSize = + let toCSRInPlace (clContext: ClContext) workGroupSize = let prepare = compressRows clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> @@ -123,7 +123,7 @@ module Matrix = Columns = matrix.Columns Values = matrix.Values } - let transposeInplace (clContext: ClContext) workGroupSize = + let transposeInPlace (clContext: ClContext) workGroupSize = let sort = Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize @@ -140,7 +140,7 @@ module Matrix = let transpose (clContext: ClContext) workGroupSize = - let transposeInplace = transposeInplace clContext workGroupSize + let transposeInPlace = transposeInPlace clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -154,34 +154,4 @@ module Matrix = Rows = copy queue allocationMode matrix.Rows Columns = copy queue allocationMode matrix.Columns Values = copyData queue allocationMode matrix.Values } - |> transposeInplace queue - - let concat (clContext: ClContext) workGroupSize = - - let concatValues = ClArray.concat clContext workGroupSize - - let concatIndices = ClArray.concat clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode columnCount rowCount (matrices: ClMatrix.COO<'a> seq) -> - - let resultValues = - matrices - |> Seq.map (fun matrix -> matrix.Values) - |> concatValues processor allocationMode - - let resultColumns = - matrices - |> Seq.map (fun matrix -> matrix.Columns) - |> concatIndices processor allocationMode - - let resultRows = - matrices - |> Seq.map (fun matrix -> matrix.Rows) - |> concatIndices processor allocationMode - - { Context = clContext - RowCount = rowCount - ColumnCount = columnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues } + |> transposeInPlace queue diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 67e73b93..018c027b 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -122,7 +122,7 @@ module internal Map = let mapToCOO = runToCOO clContext opAdd workGroupSize let toCSRInplace = - Matrix.toCSRInplace clContext workGroupSize + Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> mapToCOO queue allocationMode matrix diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index b189da13..0d363dac 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -144,7 +144,7 @@ module internal Map2 = let map2ToCOO = runToCOO clContext opAdd workGroupSize let toCSRInplace = - Matrix.toCSRInplace clContext workGroupSize + Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> map2ToCOO queue allocationMode matrixLeft matrixRight diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs index 65bc2e42..3ec0a7be 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs @@ -339,7 +339,7 @@ module internal Map2AtLeastOne = let elementwiseToCOO = runToCOO clContext opAdd workGroupSize let toCSRInplace = - Matrix.toCSRInplace clContext workGroupSize + Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> elementwiseToCOO queue allocationMode matrixLeft matrixRight diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 1f7eadd8..05b77c11 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -82,10 +82,10 @@ module Matrix = let toCOOInPlace = toCOOInPlace clContext workGroupSize let transposeInPlace = - COO.Matrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInPlace clContext workGroupSize let toCSRInPlace = - COO.Matrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOOInPlace queue allocationMode matrix @@ -97,10 +97,10 @@ module Matrix = let toCOO = toCOO clContext workGroupSize let transposeInPlace = - COO.Matrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInPlace clContext workGroupSize let toCSRInPlace = - COO.Matrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix @@ -148,3 +148,36 @@ module Matrix = runLazy processor allocationMode matrix |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray + + let toRows (clContext: ClContext) workGroupSize = + + let byRows = byRows clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + let rows = byRows processor allocationMode matrix + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + NNZ = matrix.NNZ } + + let getRowsLength (clContext: ClContext) workGroupSize = + + let pairwise = ClArray.pairwise clContext workGroupSize + + let subtract = + ClArray.map clContext workGroupSize Map.pairSubtraction + + fun (processor: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'b>) -> + let pointerPairs = + pairwise processor DeviceOnly matrix.RowPointers + // since row pointers length in matrix always >= 2 + |> Option.defaultWith (fun () -> + failwith "The state of the matrix is broken. The length of the rowPointers must be >= 2") + + let rowsLength = subtract processor DeviceOnly pointerPairs + + pointerPairs.Free processor + + rowsLength diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index baf88f47..d1b35a2a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -94,7 +94,7 @@ module Matrix = ///Should be a power of 2 and greater than 1. let toCSRInPlace (clContext: ClContext) workGroupSize = let toCSRInPlace = - COO.Matrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInPlace clContext workGroupSize let transposeInPlace = CSR.Matrix.transposeInPlace clContext workGroupSize @@ -121,11 +121,11 @@ module Matrix = let copy = copy clContext workGroupSize - let transposeInplace = - COO.Matrix.transposeInplace clContext workGroupSize + let transposeInPlace = + COO.Matrix.transposeInPlace clContext workGroupSize - let rowsToCOO = - Rows.Matrix.toCOO clContext workGroupSize + let rowsToCSR = + Rows.Matrix.toCSR clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -134,10 +134,11 @@ module Matrix = | ClMatrix.CSC m -> m.ToCSR |> toCOO processor allocationMode - |> transposeInplace processor + |> transposeInPlace processor |> ClMatrix.COO | ClMatrix.Rows m -> - rowsToCOO processor allocationMode m + rowsToCSR processor allocationMode m + |> toCOO processor allocationMode |> ClMatrix.COO /// @@ -151,7 +152,7 @@ module Matrix = CSR.Matrix.toCOOInPlace clContext workGroupSize let transposeInPlace = - COO.Matrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -182,6 +183,8 @@ module Matrix = let transposeCOO = COO.Matrix.transpose clContext workGroupSize + let rowsToCSR = Rows.Matrix.toCSR clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> copy processor allocationMode matrix @@ -193,7 +196,11 @@ module Matrix = |> COOtoCSR processor allocationMode) .ToCSC |> ClMatrix.CSC - | _ -> failwith "Not yet implemented" + | ClMatrix.Rows m -> + rowsToCSR processor allocationMode m + |> transposeCSR processor allocationMode + |> fun m -> m.ToCSC + |> ClMatrix.CSC /// /// Returns the matrix, represented in CSC format, that is equal to the given one. @@ -201,29 +208,56 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let toCSCInplace (clContext: ClContext) workGroupSize = - let toCSRInplace = - COO.Matrix.toCSRInplace clContext workGroupSize + let toCSCInPlace (clContext: ClContext) workGroupSize = + let toCSRInPlace = + COO.Matrix.toCSRInPlace clContext workGroupSize - let transposeCSRInplace = + let transposeCSRInPlace = CSR.Matrix.transposeInPlace clContext workGroupSize - let transposeCOOInplace = - COO.Matrix.transposeInplace clContext workGroupSize + let transposeCOOInPlace = + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> matrix | ClMatrix.CSR m -> - (transposeCSRInplace processor allocationMode m) + (transposeCSRInPlace processor allocationMode m) .ToCSC |> ClMatrix.CSC | ClMatrix.COO m -> - (transposeCOOInplace processor m - |> toCSRInplace processor allocationMode) + (transposeCOOInPlace processor m + |> toCSRInPlace processor allocationMode) .ToCSC |> ClMatrix.CSC - | _ -> failwith "not yet supported" + | _ -> failwith "Not yet implemented" + + let toRows (clContext: ClContext) workGroupSize = + + let copy = copy clContext workGroupSize + + let COOToCSR = COO.Matrix.toCSR clContext workGroupSize + + let transposeCSR = + CSR.Matrix.transposeInPlace clContext workGroupSize + + let CSRToRows = CSR.Matrix.toRows clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + match matrix with + | ClMatrix.CSC m -> + m.ToCSR + |> transposeCSR processor allocationMode + |> CSRToRows processor allocationMode + |> ClMatrix.Rows + | ClMatrix.CSR m -> + CSRToRows processor allocationMode m + |> ClMatrix.Rows + | ClMatrix.COO m -> + COOToCSR processor allocationMode m + |> CSRToRows processor allocationMode + |> ClMatrix.Rows + | ClMatrix.Rows _ -> copy processor allocationMode matrix let map (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) workGroupSize = let mapCOO = @@ -241,7 +275,7 @@ module Matrix = |> ClMatrix.CSC | _ -> failwith "Not yet implemented" - let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = // TODO() + let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = let map2COO = COO.Matrix.map2 clContext opAdd workGroupSize @@ -291,7 +325,7 @@ module Matrix = CSR.Matrix.map2AtLeastOneToCOO clContext opAdd workGroupSize let transposeCOOInPlace = - COO.Matrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with @@ -322,14 +356,14 @@ module Matrix = ///Should be a power of 2 and greater than 1. let transposeInPlace (clContext: ClContext) workGroupSize = let COOTransposeInPlace = - COO.Matrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) matrix -> match matrix with | ClMatrix.COO m -> COOTransposeInPlace processor m |> ClMatrix.COO | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC | ClMatrix.CSC m -> ClMatrix.CSR m.ToCSR - | ClMatrix.Rows _ -> failwith "not yet supported" + | ClMatrix.Rows _ -> failwith "Not yet implemented" /// /// Transposes the given matrix and returns result as a new matrix. @@ -344,7 +378,7 @@ module Matrix = ///OpenCL context. ///Should be a power of 2 and greater than 1. let transpose (clContext: ClContext) workGroupSize = - let COOtranspose = + let COOTranspose = COO.Matrix.transpose clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -354,7 +388,7 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode matrix -> match matrix with | ClMatrix.COO m -> - COOtranspose processor allocationMode m + COOTranspose processor allocationMode m |> ClMatrix.COO | ClMatrix.CSR m -> { Context = m.Context @@ -372,7 +406,7 @@ module Matrix = Columns = copy processor allocationMode m.Rows Values = copyData processor allocationMode m.Values } |> ClMatrix.CSR - | ClMatrix.Rows _ -> failwith "not yet supported" + | ClMatrix.Rows _ -> failwith "Not yet implemented" module SpGeMM = let masked diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs index db3a986c..2f9a0a72 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs @@ -13,66 +13,37 @@ open FSharp.Quotations.Evaluator module Matrix = let toCSR (clContext: ClContext) workGroupSize = - let concatVectors = - Vector.Sparse.SparseVector.concat clContext workGroupSize + let concatIndices = ClArray.concat clContext workGroupSize + + let concatValues = ClArray.concat clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: Rows<'a>) -> - // create row pointers - let rowPointers = + let rowsPointers = matrix.Rows - |> Array.Parallel.map - (function - | None -> 0 - | Some array -> array.Size) - |> Array.scan (+) 0 // mb device prefix sum ??? - - let rowPointers = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, rowPointers) - - // compact columns and values - matrix.Rows - |> Array.Parallel.choose id - |> concatVectors processor allocationMode - |> fun vector -> - { Context = clContext - RowCount = matrix.RowCount - ColumnCount = matrix.ColumnCount - RowPointers = rowPointers - Columns = vector.Indices - Values = vector.Values } - - let toCOO (clContext: ClContext) workGroupSize = - - let create = ClArray.create clContext workGroupSize + |> Array.map (function None -> 0 | Some vector -> vector.Values.Length) + // prefix sum + |> Array.scan (+) 0 + |> fun pointers -> + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, pointers) - let concatMatrix = - COO.Matrix.concat clContext workGroupSize + let valuesByRows, columnsIndicesByRows = + matrix.Rows + |> Array.choose id + |> Array.map (fun vector -> vector.Values, vector.Indices) + |> Array.unzip - fun (processor: MailboxProcessor<_>) allocationMode (matrix: Rows<'a>) -> + let values = + concatValues processor allocationMode valuesByRows - let createMatrix (vector: ClVector.Sparse<_>) rows = - { Context = clContext - RowCount = matrix.RowCount - ColumnCount = matrix.ColumnCount - Rows = rows - Columns = vector.Indices - Values = vector.Values } + let columnsIndices = + concatIndices processor allocationMode columnsIndicesByRows - let indices, rowsVectors = - matrix.Rows - |> Array.Parallel.mapi - (fun index optionRow -> - (match optionRow with - | None -> None - | Some row -> Some(index, row))) - |> Array.Parallel.choose id - |> Array.unzip + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + RowPointers = rowsPointers + Columns = columnsIndices + Values = values } - // creat rows pointers - let rowsIndices = - (rowsVectors, indices) - ||> Array.map2 (fun array -> create processor allocationMode array.Values.Length) - Array.map2 createMatrix rowsVectors rowsIndices - |> concatMatrix processor allocationMode matrix.ColumnCount matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index efab851d..d061072e 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -18,25 +18,6 @@ type Indices = ClArray type Values<'a> = ClArray<'a> module Expand = - let getRowsLength (clContext: ClContext) workGroupSize = - let subtract = - ClArray.map2 clContext workGroupSize Map.subtraction - - let pairwise = ClArray.pairwise clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'b>) -> - - // let firstPointers, secondPointers = - // pairwise processor DeviceOnly matrix.RowPointers - - // let rowsLength = subtract processor DeviceOnly secondPointers firstPointers - // - // firstPointers.Free processor - // secondPointers.Free processor - // - // rowsLength - clContext.CreateClArray [| |] - let getSegmentPointers (clContext: ClContext) workGroupSize = let gather = Gather.run clContext workGroupSize @@ -298,7 +279,7 @@ module Expand = (opMul: Expr<'a -> 'b -> 'c option>) = let getRowsLength = - getRowsLength clContext workGroupSize + CSR.Matrix.getRowsLength clContext workGroupSize let split = CSR.Matrix.byRowsLazy clContext workGroupSize @@ -314,3 +295,5 @@ module Expand = split processor allocationMode leftMatrix |> Seq.map (fun lazyRow -> Option.bind runRow lazyRow.Value) + |> Seq.toArray + diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 822b7c03..ebc7c81f 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -6,6 +6,7 @@ type MatrixFormat = | CSR | COO | CSC + | Rows module ClMatrix = type CSR<'elem when 'elem: struct> = diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 2f74a7c5..9cb476b3 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -30,6 +30,8 @@ module Map = let inc = <@ fun item -> item + 1 @> + let pairSubtraction = <@ fun (first, second) -> first - second @> + let subtraction = <@ fun first second -> first - second @> let fst () = <@ fun fst _ -> fst @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs index 4be224db..bf0a9e1a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs @@ -68,24 +68,3 @@ module SparseVector = Reduce.reduce clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values - - let concat<'a> (clContext: ClContext) workGroupSize = - - let concatValues = ClArray.concat clContext workGroupSize - - let concatIndices = ClArray.concat clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (vectors: ClVector.Sparse<'a> seq) -> - - let resultValues = - Seq.map (fun vector -> vector.Values) vectors - |> concatValues processor allocationMode - - let resultIndices = - Seq.map (fun vector -> vector.Indices) vectors - |> concatIndices processor allocationMode - - { Context = clContext - Indices = resultIndices - Values = resultValues - Size = resultValues.Length } diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index 96e59d55..658f2876 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -18,9 +18,9 @@ + - diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index 5213e750..b064356a 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -135,6 +135,43 @@ module Matrix = ColumnPointers = context.CreateClArray this.ColumnPointers Values = context.CreateClArray this.Values } + type Rows<'a when 'a : struct> = + { RowCount: int + ColumnCount: int + Rows: Vector.Sparse<'a> option [] + NNZ: int } + + static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = + let mutable nnz = 0 + + let rows = + [ for i in 0 .. Array2D.length1 array - 1 do + let vector = Vector.Sparse.FromArray(array.[i, *], isZero) + + nnz <- nnz + vector.NNZ + + if vector.NNZ > 0 then Some vector + else None ] + |> Array.ofList + + { RowCount = Array2D.length1 array + ColumnCount = Array2D.length2 array + Rows = rows + NNZ = nnz } + + member this.ToDevice(context: ClContext) = + + let rows = + this.Rows + |> Array.map (Option.bind + (fun vector -> Some <| vector.ToDevice(context))) + + { Context = context + RowCount = this.RowCount + ColumnCount = this.ColumnCount + Rows = rows + NNZ = this.NNZ } + type Tuples<'a> = { RowIndices: int [] ColumnIndices: int [] @@ -145,27 +182,32 @@ type Matrix<'a when 'a: struct> = | CSR of Matrix.CSR<'a> | COO of Matrix.COO<'a> | CSC of Matrix.CSC<'a> + | Rows of Matrix.Rows<'a> member this.RowCount = match this with | CSR matrix -> matrix.RowCount | COO matrix -> matrix.RowCount | CSC matrix -> matrix.RowCount + | Rows matrix -> matrix.RowCount member this.ColumnCount = match this with | CSR matrix -> matrix.ColumnCount | COO matrix -> matrix.ColumnCount | CSC matrix -> matrix.ColumnCount + | Rows matrix -> matrix.ColumnCount member this.NNZ = match this with | COO m -> m.NNZ | CSR m -> m.NNZ | CSC m -> m.NNZ + | Rows m -> m.NNZ member this.ToDevice(context: ClContext) = match this with | COO matrix -> ClMatrix.COO <| matrix.ToDevice context | CSR matrix -> ClMatrix.CSR <| matrix.ToDevice context | CSC matrix -> ClMatrix.CSC <| matrix.ToDevice context + | Rows matrix -> ClMatrix.Rows <| matrix.ToDevice context diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index f3019cce..6939b345 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -3,69 +3,39 @@ namespace GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects open Brahma.FSharp open Matrix +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClVectorExtensions module MatrixExtensions = type ClMatrix<'a when 'a: struct> with member this.ToHost(q: MailboxProcessor<_>) = match this with | ClMatrix.COO m -> - let rows = Array.zeroCreate m.Rows.Length - let columns = Array.zeroCreate m.Columns.Length - let values = Array.zeroCreate m.Values.Length - - q.Post(Msg.CreateToHostMsg(m.Rows, rows)) - - q.Post(Msg.CreateToHostMsg(m.Columns, columns)) - - ignore - <| q.PostAndReply(fun ch -> Msg.CreateToHostMsg(m.Values, values, ch)) - - let result = - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - Rows = rows - Columns = columns - Values = values } - - Matrix.COO result + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + Rows = m.Rows.ToHost q + Columns = m.Columns.ToHost q + Values = m.Values.ToHost q } + |> Matrix.COO | ClMatrix.CSR m -> - let rows = Array.zeroCreate m.RowPointers.Length - let columns = Array.zeroCreate m.Columns.Length - let values = Array.zeroCreate m.Values.Length - - q.Post(Msg.CreateToHostMsg(m.RowPointers, rows)) - - q.Post(Msg.CreateToHostMsg(m.Columns, columns)) - - ignore - <| q.PostAndReply(fun ch -> Msg.CreateToHostMsg(m.Values, values, ch)) - - let result = - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowPointers = rows - ColumnIndices = columns - Values = values } - - Matrix.CSR result + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + RowPointers = m.RowPointers.ToHost q + ColumnIndices = m.Columns.ToHost q + Values = m.Values.ToHost q } + |> Matrix.CSR | ClMatrix.CSC m -> - let rows = Array.zeroCreate m.Rows.Length - let columns = Array.zeroCreate m.ColumnPointers.Length - let values = Array.zeroCreate m.Values.Length - - q.Post(Msg.CreateToHostMsg(m.Rows, rows)) - - q.Post(Msg.CreateToHostMsg(m.ColumnPointers, columns)) - - ignore - <| q.PostAndReply(fun ch -> Msg.CreateToHostMsg(m.Values, values, ch)) - - let result = - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowIndices = rows - ColumnPointers = columns - Values = values } - - Matrix.CSC result - | _ -> failwith "Not yet implemented" + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + RowIndices = m.Rows.ToHost q + ColumnPointers = m.ColumnPointers.ToHost q + Values = m.Values.ToHost q } + |> Matrix.CSC + | ClMatrix.Rows m -> + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + Rows = + m.Rows + |> Array.map (Option.bind (fun row -> Some <| row.ToHost q)) + NNZ = m.NNZ } + |> Matrix.Rows diff --git a/src/GraphBLAS-sharp/Objects/Vector.fs b/src/GraphBLAS-sharp/Objects/Vector.fs index 7caa47b6..19b7e01a 100644 --- a/src/GraphBLAS-sharp/Objects/Vector.fs +++ b/src/GraphBLAS-sharp/Objects/Vector.fs @@ -33,15 +33,14 @@ module Vector = Size = size } static member FromArray(array: 'a [], isZero: 'a -> bool) = - let (indices, vals) = + let indices, values = array - |> Seq.cast<'a> |> Seq.mapi (fun idx v -> (idx, v)) |> Seq.filter (fun (_, v) -> not (isZero v)) |> Array.ofSeq |> Array.unzip - Sparse.FromTuples(indices, vals, array.Length) + Sparse.FromTuples(indices, values, array.Length) member this.NNZ = this.Values.Length diff --git a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs index ad9333be..23d40b26 100644 --- a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs @@ -2,23 +2,18 @@ namespace GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects -open Brahma.FSharp +open GraphBLAS.FSharp.Objects.Vector module ClVectorExtensions = + type ClVector.Sparse<'a> with + member this.ToHost(q: MailboxProcessor<_>) = + { Indices = this.Indices.ToHost q + Values = this.Values.ToHost q + Size = this.Size } + type ClVector<'a when 'a: struct> with member this.ToHost(q: MailboxProcessor<_>) = match this with | ClVector.Sparse vector -> - let indices = Array.zeroCreate vector.Indices.Length - let values = Array.zeroCreate vector.Values.Length - - q.Post(Msg.CreateToHostMsg(vector.Indices, indices)) - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(vector.Values, values, ch)) - |> ignore - - Vector.Sparse - <| { Indices = indices - Values = values - Size = this.Size } + Vector.Sparse <| vector.ToHost q | ClVector.Dense vector -> Vector.Dense <| vector.ToHost q diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index d39742c7..6e287866 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -63,6 +63,9 @@ module Utils = | CSC -> Matrix.CSC <| Matrix.CSC.FromArray2D(array, isZero) + | Rows -> + Matrix.Rows + <| Matrix.Rows.FromArray2D(array, isZero) let createVectorFromArray vectorCase array isZero = match vectorCase with diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs index 150ec153..a62dade9 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs @@ -18,6 +18,12 @@ let config = Utils.defaultConfig let workGroupSize = Utils.defaultWorkGroupSize +let context = defaultContext.ClContext + +let q = defaultContext.Queue + +q.Error.Add(fun e -> failwithf "%A" e) + let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = let mtx = Utils.createMatrixFromArray2D formatFrom array isZero @@ -42,68 +48,32 @@ let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = "Matrices should be equal" |> Expect.equal actual expected -let testFixtures formatTo = - let getCorrectnessTestName datatype formatFrom = - $"Correctness on %s{datatype}, %A{formatFrom} to %A{formatTo}" +let createTest<'a when 'a : struct and 'a : equality> convertFun formatTo (isZero: 'a -> bool) = + let convertFun = convertFun context Utils.defaultWorkGroupSize - let context = defaultContext.ClContext - let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + Utils.listOfUnionCases + |> List.map (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun isZero + |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>} from %A{formatFrom}") +let testFixtures formatTo = match formatTo with | COO -> - [ let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat + [ createTest Matrix.toCOO formatTo ((=) 0) + createTest Matrix.toCOO formatTo ((=) false) ] | CSR -> - [ let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat + [ createTest Matrix.toCSR formatTo ((=) 0) + createTest Matrix.toCSR formatTo ((=) false) ] | CSC -> - [ let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat + [ createTest Matrix.toCSC formatTo ((=) 0) + createTest Matrix.toCSC formatTo ((=) false) ] + | Rows -> + [ createTest Matrix.toRows formatTo ((=) 0) + createTest Matrix.toRows formatTo ((=) false) ] + |> List.concat + |> testList $"%A{formatTo}" let tests = Utils.listOfUnionCases - |> List.collect testFixtures - |> testList "Convert tests" + |> List.map testFixtures + |> testList "Convert" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 19e04826..a0bf2c8a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,5 +95,5 @@ open GraphBLAS.FSharp.Tests [] let main argv = - testList "lol" [ Common.ClArray.Pairwise.tests ] |> testSequenced + testList "lol" [ Matrix.Convert.tests ] |> testSequenced |> runTestsWithCLIArgs [] argv From 6f2adb3516b2c940b1d4b640e07c0fbb6219b3e9 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 18 Apr 2023 19:08:08 +0300 Subject: [PATCH 077/143] wip: SpGeMM expand phase --- .../Matrix/CSR/Matrix.fs | 2 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 31 +- .../Matrix/SpGeMM/Expand.fs | 139 +++-- src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 2 + src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 2 - .../Objects/MatrixExtensions.fs | 7 + .../Common/ClArray/Pairwise.fs | 20 +- tests/GraphBLAS-sharp.Tests/Generators.fs | 59 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 7 +- .../Matrix/SpGeMM/Expand.fs | 532 +++++++++--------- .../GraphBLAS-sharp.Tests/Matrix/Transpose.fs | 1 + tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 12 files changed, 437 insertions(+), 367 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 05b77c11..0d941012 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -167,7 +167,7 @@ module Matrix = let pairwise = ClArray.pairwise clContext workGroupSize let subtract = - ClArray.map clContext workGroupSize Map.pairSubtraction + ClArray.map clContext workGroupSize <@ fun (fst, snd) -> snd - fst @> fun (processor: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'b>) -> let pointerPairs = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index d1b35a2a..fda92183 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -424,19 +424,18 @@ module Matrix = | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" - // let expand // TODO() - // (clContext: ClContext) - // workGroupSize - // (opAdd: Expr<'c -> 'c -> 'c option>) - // (opMul: Expr<'a -> 'b -> 'c option>) - // = - // - // let run = - // SpGeMM.Expand.run clContext workGroupSize opAdd opMul - // - // fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> - // match leftMatrix, rightMatrix with - // | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> - // run processor allocationMode leftMatrix rightMatrix - // |> ClMatrix.COO - // | _ -> failwith "Matrix formats are not matching" + let expand + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let run = + SpGeMM.Expand.run clContext workGroupSize opAdd opMul + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + match leftMatrix, rightMatrix with + | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> + ClMatrix.Rows <| run processor allocationMode leftMatrix rightMatrix + | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index d061072e..241aa54a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -12,6 +12,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClCell open FSharp.Quotations open GraphBLAS.FSharp.Backend.Vector.Sparse open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Objects.ClMatrix type Indices = ClArray @@ -70,60 +71,62 @@ module Expand = let rightMatrixGather = Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - - // Compute left matrix positions - let leftMatrixPositions = zeroCreate processor DeviceOnly lengths + fun (processor: MailboxProcessor<_>) length (segmentsPointers: Indices) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + if length = 0 then None + else + printfn "expand length: %A" length + // Compute left matrix positions + let leftMatrixPositions = zeroCreate processor DeviceOnly length - idScatter processor segmentsPointers leftMatrixPositions + idScatter processor segmentsPointers leftMatrixPositions - (maxPrefixSum processor leftMatrixPositions 0) - .Free processor + (maxPrefixSum processor leftMatrixPositions 0) + .Free processor - // Compute right matrix positions - let rightMatrixPositions = create processor DeviceOnly lengths 1 + // Compute right matrix positions + let rightMatrixPositions = create processor DeviceOnly length 1 - let requiredRightMatrixPointers = - zeroCreate processor DeviceOnly leftMatrixRow.Indices.Length + let requiredRightMatrixPointers = + zeroCreate processor DeviceOnly leftMatrixRow.Indices.Length - gather processor leftMatrixRow.Indices rightMatrix.RowPointers requiredRightMatrixPointers + gather processor leftMatrixRow.Indices rightMatrix.RowPointers requiredRightMatrixPointers - scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions + scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions - requiredRightMatrixPointers.Free processor + requiredRightMatrixPointers.Free processor - // another way to get offsets ??? - let offsets = - removeDuplicates processor segmentsPointers + // another way to get offsets ??? + let offsets = + removeDuplicates processor segmentsPointers - segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets + segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets - offsets.Free processor + offsets.Free processor - // compute columns - let columns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + // compute columns + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - gather processor rightMatrixPositions rightMatrix.Columns columns + gather processor rightMatrixPositions rightMatrix.Columns columns - // compute left matrix values - let leftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + // compute left matrix values + let leftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - leftMatrixGather processor leftMatrixPositions leftMatrixRow.Values leftMatrixValues + leftMatrixGather processor leftMatrixPositions leftMatrixRow.Values leftMatrixValues - leftMatrixPositions.Free processor + leftMatrixPositions.Free processor - // compute right matrix values - let rightMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + // compute right matrix values + let rightMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues + rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues - rightMatrixPositions.Free processor + rightMatrixPositions.Free processor - // left, right matrix values, columns and rows indices - leftMatrixValues, rightMatrixValues, columns + // left, right matrix values, columns indices + Some (leftMatrixValues, rightMatrixValues, columns) let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = let getBitmap = @@ -235,42 +238,48 @@ module Expand = let length, segmentPointers = getSegmentPointers processor leftMatrixRow leftMatrixRowsLengths + if length < 0 then failwith "length < 0" + // expand - let leftMatrixValues, rightMatrixValues, columns = + let expandResult = expand processor length segmentPointers leftMatrixRow rightMatrix - // multiplication - let mulResult = - multiply processor leftMatrixValues rightMatrixValues columns + segmentPointers.Free processor + + expandResult + |> Option.bind (fun (leftMatrixValues, rightMatrixValues, columns) -> + // multiplication + let mulResult = + multiply processor leftMatrixValues rightMatrixValues columns - leftMatrixValues.Free processor - rightMatrixValues.Free processor - columns.Free processor + leftMatrixValues.Free processor + rightMatrixValues.Free processor + columns.Free processor - // check multiplication result - mulResult - |> Option.bind (fun (resultValues, resultColumns) -> - // sort - let sortedValues, sortedColumns = - sort processor resultValues resultColumns + // check multiplication result + mulResult + |> Option.bind (fun (resultValues, resultColumns) -> + // sort + let sortedValues, sortedColumns = + sort processor resultValues resultColumns - resultValues.Free processor - resultColumns.Free processor + resultValues.Free processor + resultColumns.Free processor - let reduceResult = - reduce processor allocationMode sortedValues sortedColumns + let reduceResult = + reduce processor allocationMode sortedValues sortedColumns - sortedValues.Free processor - sortedColumns.Free processor + sortedValues.Free processor + sortedColumns.Free processor - // create sparse vector (TODO(empty vector)) - reduceResult - |> Option.bind (fun (values, columns) -> - { Context = clContext - Indices = columns - Values = values - Size = rightMatrix.ColumnCount } - |> Some)) + // create sparse vector (TODO(empty vector)) + reduceResult + |> Option.bind (fun (values, columns) -> + { Context = clContext + Indices = columns + Values = values + Size = rightMatrix.ColumnCount } + |> Some))) let run<'a, 'b, 'c when 'a : struct and 'b : struct and 'c : struct> (clContext: ClContext) @@ -296,4 +305,10 @@ module Expand = split processor allocationMode leftMatrix |> Seq.map (fun lazyRow -> Option.bind runRow lazyRow.Value) |> Seq.toArray + |> fun rows -> + { Rows.Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + NNZ = -1 } // TODO(nnz count) diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index fb8cdcc8..f7430242 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -22,6 +22,8 @@ module ClVector = member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + member this.NNZ = this.Values.Length + [] type ClVector<'a when 'a: struct> = | Sparse of ClVector.Sparse<'a> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 9cb476b3..2f74a7c5 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -30,8 +30,6 @@ module Map = let inc = <@ fun item -> item + 1 @> - let pairSubtraction = <@ fun (first, second) -> first - second @> - let subtraction = <@ fun first second -> first - second @> let fst () = <@ fun fst _ -> fst @> diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index 6939b345..0a90c4c3 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -39,3 +39,10 @@ module MatrixExtensions = |> Array.map (Option.bind (fun row -> Some <| row.ToHost q)) NNZ = m.NNZ } |> Matrix.Rows + + member this.ToHostAndDispose(processor: MailboxProcessor<_>) = + let result = this.ToHost processor + + this.Dispose processor + + result diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs index 734087c1..e0ed32d7 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs @@ -21,21 +21,17 @@ let makeTest<'a> isEqual testFun (array: 'a [] ) = let clArray = context.CreateClArray array - testFun processor HostInterop clArray - |> Option.bind (fun (actual: ClArray<_>) -> - let firstActual, secondActual = - actual.ToHostAndFree processor - |> Array.unzip + match testFun processor HostInterop clArray with + | Some (actual: ClArray<_>) -> + let actual = actual.ToHostAndFree processor - let firstExpected, secondExpected = Array.pairwise array |> Array.unzip + let expected = Array.pairwise array "First results must be the same" - |> Utils.compareArrays isEqual firstActual firstExpected - - "Second results must be the same" - |> Utils.compareArrays isEqual secondActual secondExpected - None) - |> ignore + |> Utils.compareArrays isEqual actual expected + | None -> + "Result must be empty" + |> Expect.isTrue (array.Size <= 1) let createTest<'a> isEqual = ClArray.pairwise context Utils.defaultWorkGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index aa84f71b..3d4c3e37 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -318,7 +318,7 @@ module Generators = Arb.generate |> Arb.fromGen - type PairOfSparseVectorAndMatrixOfCompatibleSize() = + type PairOfSparseVectorAndMatrixAndMaskOfCompatibleSize() = static let pairOfVectorAndMatrixOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = gen { let! nRows, nColumns = dimension2DGenerator @@ -376,6 +376,63 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen + type VectorXMatrix() = + static let pairOfVectorAndMatrixOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = + gen { + let! nRows, nColumns = dimension2DGenerator + let! vector = valuesGenerator |> Gen.arrayOfLength nRows + + let! matrix = + valuesGenerator + |> Gen.array2DOfDim (nRows, nColumns) + + return (vector, matrix) + } + + static member IntType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator + 0. + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0.0f (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator false Arb.generate + |> Arb.fromGen + type PairOfMatricesOfCompatibleSize() = static let pairOfMatricesOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = gen { diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 6e287866..751bc6fe 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -25,7 +25,7 @@ module Utils = typeof typeof typeof - typeof + typeof typeof typeof typeof @@ -150,11 +150,6 @@ module Utils = result - let castMatrixToCSR = - function - | Matrix.CSR matrix -> matrix - | _ -> failwith "matrix format must be CSR" - module HostPrimitives = let prefixSumInclude zero add array = Array.scan add zero array diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 38d70b6c..7e9ed80b 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -1,266 +1,266 @@ - module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand -// TODO() -// open Expecto -// open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM -// open GraphBLAS.FSharp.Backend.Quotes -// open GraphBLAS.FSharp.Test -// open Microsoft.FSharp.Collections -// open GraphBLAS.FSharp.Backend -// open GraphBLAS.FSharp.Backend.Matrix -// open GraphBLAS.FSharp.Backend.Objects -// open GraphBLAS.FSharp.Tests -// open GraphBLAS.FSharp.Tests.Backend -// open GraphBLAS.FSharp.Objects -// open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -// open Brahma.FSharp -// open GraphBLAS.FSharp.Backend.Objects.ClContext -// open GraphBLAS.FSharp.Objects.MatrixExtensions -// -// let context = Context.defaultContext.ClContext -// -// let processor = Context.defaultContext.Queue -// -// let config = -// { Utils.defaultConfig with -// arbitrary = [ typeof ] -// endSize = 100 -// maxTest = 100 } -// -// let createCSRMatrix array isZero = -// Utils.createMatrixFromArray2D CSR array isZero -// |> Utils.castMatrixToCSR -// -// let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = -// Array.map -// (fun item -> -// rightMatrix.RowPointers.[item + 1] -// - rightMatrix.RowPointers.[item]) -// leftMatrix.ColumnIndices -// |> HostPrimitives.prefixSumExclude 0 (+) -// -// let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = -// -// let leftMatrix = createCSRMatrix leftArray isZero -// -// let rightMatrix = createCSRMatrix rightArray isZero -// -// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then -// -// let clLeftMatrix = leftMatrix.ToDevice context -// -// let clRightMatrix = rightMatrix.ToDevice context -// -// let actualLength, (clActual: ClArray) = -// testFun processor clLeftMatrix clRightMatrix -// -// clLeftMatrix.Dispose processor -// clRightMatrix.Dispose processor -// -// let actualPointers = clActual.ToHostAndFree processor -// -// let expectedPointers, expectedLength = -// getSegmentsPointers leftMatrix rightMatrix -// -// "Results lengths must be the same" -// |> Expect.equal actualLength expectedLength -// -// "Result pointers must be the same" -// |> Expect.sequenceEqual actualPointers expectedPointers -// -// let createTest<'a when 'a: struct> (isZero: 'a -> bool) = -// -// let testFun = -// Expand.getSegmentPointers context Utils.defaultWorkGroupSize -// -// makeTest isZero testFun -// |> testPropertyWithConfig config $"test on {typeof<'a>}" -// -// let getSegmentsTests = -// [ createTest ((=) 0) -// -// if Utils.isFloat64Available context.ClDevice then -// createTest ((=) 0.0) -// -// createTest ((=) 0f) -// createTest ((=) false) -// createTest ((=) 0uy) ] -// |> testList "get segment pointers" -// -// let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = -// let extendPointers pointers = -// Array.pairwise pointers -// |> Array.map (fun (fst, snd) -> snd - fst) -// |> Array.mapi (fun index length -> Array.create length index) -// |> Array.concat -// -// let segmentsLengths = -// Array.append segmentPointers [| length |] -// |> Array.pairwise -// |> Array.map (fun (fst, snd) -> snd - fst) -// -// let leftMatrixValues, expectedRows = -// let tripleFst (fst, _, _) = fst -// -// Array.zip3 segmentsLengths leftMatrix.Values -// <| extendPointers leftMatrix.RowPointers -// // select items each segment length not zero -// |> Array.filter (tripleFst >> ((=) 0) >> not) -// |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) -// |> Array.unzip -// -// let rightMatrixValues, expectedColumns = -// let valuesAndColumns = -// Array.zip rightMatrix.Values rightMatrix.ColumnIndices -// -// Array.map2 -// (fun column length -> -// let rowStart = rightMatrix.RowPointers.[column] -// Array.take length valuesAndColumns.[rowStart..]) -// leftMatrix.ColumnIndices -// segmentsLengths -// |> Array.concat -// |> Array.unzip -// -// leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows -// -// let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = -// -// let leftMatrix = -// createCSRMatrix leftArray <| isEqual zero -// -// let rightMatrix = -// createCSRMatrix rightArray <| isEqual zero -// -// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then -// -// let segmentPointers, length = -// getSegmentsPointers leftMatrix rightMatrix -// -// let clLeftMatrix = leftMatrix.ToDevice context -// let clRightMatrix = rightMatrix.ToDevice context -// let clSegmentPointers = context.CreateClArray segmentPointers -// -// let ((clActualLeftValues: ClArray<'a>), -// (clActualRightValues: ClArray<'a>), -// (clActualColumns: ClArray), -// (clActualRows: ClArray)) = -// testFun processor length clSegmentPointers clLeftMatrix clRightMatrix -// -// clLeftMatrix.Dispose processor -// clRightMatrix.Dispose processor -// clSegmentPointers.Free processor -// -// let actualLeftValues = -// clActualLeftValues.ToHostAndFree processor -// -// let actualRightValues = -// clActualRightValues.ToHostAndFree processor -// -// let actualColumns = clActualColumns.ToHostAndFree processor -// let actualRows = clActualRows.ToHostAndFree processor -// -// let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = -// expand length segmentPointers leftMatrix rightMatrix -// -// "Left values must be the same" -// |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues -// -// "Right values must be the same" -// |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues -// -// "Columns must be the same" -// |> Utils.compareArrays (=) actualColumns expectedColumns -// -// "Rows must be the same" -// |> Utils.compareArrays (=) actualRows expectedRows -// -// let createExpandTest isEqual (zero: 'a) testFun = -// -// let testFun = -// testFun context Utils.defaultWorkGroupSize -// -// makeExpandTest isEqual zero testFun -// |> testPropertyWithConfig config $"test on %A{typeof<'a>}" -// -// // expand phase tests -// let expandTests = -// [ createExpandTest (=) 0 Expand.expand -// -// if Utils.isFloat64Available context.ClDevice then -// createExpandTest Utils.floatIsEqual 0.0 Expand.expand -// -// createExpandTest Utils.float32IsEqual 0f Expand.expand -// createExpandTest (=) false Expand.expand -// createExpandTest (=) 0uy Expand.expand ] -// |> testList "Expand.expand" -// -// let checkGeneralResult zero isEqual (actualMatrix: Matrix<'a>) mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = -// -// let expected = -// HostPrimitives.array2DMultiplication zero mul add leftArray rightArray -// |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) -// -// match actualMatrix, expected with -// | Matrix.COO actualMatrix, Matrix.COO expected -> -// -// "Values must be the same" -// |> Utils.compareArrays isEqual actualMatrix.Values expected.Values -// -// "Columns must be the same" -// |> Utils.compareArrays (=) actualMatrix.Columns expected.Columns -// -// "Rows must be the same" -// |> Utils.compareArrays (=) actualMatrix.Rows expected.Rows -// | _ -> failwith "Matrix format are not matching" -// -// let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = -// -// let leftMatrix = -// Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) -// -// let rightMatrix = -// Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) -// -// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then -// try -// let clLeftMatrix = leftMatrix.ToDevice context -// let clRightMatrix = rightMatrix.ToDevice context -// -// let (clMatrixActual: ClMatrix<_>) = -// testFun processor HostInterop clLeftMatrix clRightMatrix -// -// let matrixActual = clMatrixActual.ToHost processor -// clMatrixActual.Dispose processor -// -// checkGeneralResult zero isEqual matrixActual opMul opAdd leftArray rightArray -// with -// | ex when ex.Message = "InvalidBufferSize" -> () -// | _ -> reraise () -// -// let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = -// -// let testFun = -// testFun context Utils.defaultWorkGroupSize opAddQ opMulQ -// -// makeGeneralTest zero isEqual opMul opAdd testFun -// |> testPropertyWithConfig config $"test on %A{typeof<'a>}" -// -// let generalTests = -// [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand -// -// if Utils.isFloat64Available context.ClDevice then -// createGeneralTest -// 0.0 -// Utils.floatIsEqual -// ArithmeticOperations.floatAdd -// ArithmeticOperations.floatMul -// Matrix.SpGeMM.expand -// -// createGeneralTest -// 0.0f -// Utils.float32IsEqual -// ArithmeticOperations.float32Add -// ArithmeticOperations.float32Mul -// Matrix.SpGeMM.expand -// createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] -// |> testList "general" +module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand + +open Expecto +open GraphBLAS.FSharp.Backend.Matrix.SpGeMM +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Test +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Objects.MatrixExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = + + let leftMatrixRow = + Vector.Sparse.FromArray(leftArray, isZero) + + let rightMatrix = + Matrix.CSR.FromArray2D(rightArray, isZero) + + if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then + + // compute expected result + let rightMatrixRowsLength = + rightMatrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let expectedPointers, expectedLength = + Array.init leftMatrixRow.Indices.Length (fun index -> + rightMatrixRowsLength.[leftMatrixRow.Indices[index]]) + |> HostPrimitives.prefixSumExclude 0 (+) + + let clLeftMatrixRow = leftMatrixRow.ToDevice context + + let clRightMatrixRowsLength = + context.CreateClArray rightMatrixRowsLength + + let actualLength, (clActual: ClArray) = + testFun processor clLeftMatrixRow clRightMatrixRowsLength + + clLeftMatrixRow.Dispose processor + + let actualPointers = clActual.ToHostAndFree processor + + "Results lengths must be the same" + |> Expect.equal actualLength expectedLength + + "Result pointers must be the same" + |> Expect.sequenceEqual actualPointers expectedPointers + +let createTest<'a when 'a: struct> (isZero: 'a -> bool) = + Expand.getSegmentPointers context Utils.defaultWorkGroupSize + |> makeTest isZero + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +// Debug tests +let getSegmentsTests = + [ createTest ((=) 0) + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) + + createTest ((=) 0f) + createTest ((=) false) + createTest ((=) 0uy) ] + |> testList "get segment pointers" + +let expand (leftMatrixRow: Vector.Sparse<'a>) (rightMatrix: Matrix.CSR<'b>) = + let rightMatrixRowsLengths = + rightMatrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let segmentsLengths = + Array.map (fun columnIndex -> rightMatrixRowsLengths.[columnIndex]) leftMatrixRow.Indices + + let leftMatrixValues = + Array.map2 Array.create segmentsLengths leftMatrixRow.Values + |> Array.concat + + let rightMatrixRowPointers = + Array.map (fun index -> rightMatrix.RowPointers.[index]) leftMatrixRow.Indices + + let rightMatrixValues = + Array.map2(fun rowPointer segmentLength -> + Array.take segmentLength rightMatrix.Values.[rowPointer..]) + rightMatrixRowPointers segmentsLengths + |> Array.concat + + let columns = + Array.map2 (fun rowPointer segmentLength -> + Array.take segmentLength rightMatrix.ColumnIndices.[rowPointer ..]) + rightMatrixRowPointers segmentsLengths + |> Array.concat + + leftMatrixValues, rightMatrixValues, columns + +let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = + + let leftMatrixRow = + Vector.Sparse.FromArray(leftArray, (isEqual zero)) + + let rightMatrix = + Matrix.CSR.FromArray2D(rightArray, (isEqual zero)) + + if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clPointers, lenght = + rightMatrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + |> fun rightMatrixRowsLengths -> + Array.init leftMatrixRow.Indices.Length (fun index -> + rightMatrixRowsLengths.[leftMatrixRow.Indices[index]]) + |> HostPrimitives.prefixSumExclude 0 (+) + |> fun (pointers, length) -> + context.CreateClArray(pointers), length + + let clLeftMatrixRow = leftMatrixRow.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let result + = testFun processor lenght clPointers clLeftMatrixRow clRightMatrix + + clLeftMatrixRow.Dispose processor + clRightMatrix.Dispose processor + clPointers.Free processor + + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns = + expand leftMatrixRow rightMatrix + + match result with + | Some (clActualLeftValues: ClArray<'a>, + clActualRightValues: ClArray<'a>, + clActualColumns: ClArray) -> + + let actualLeftValues = + clActualLeftValues.ToHostAndFree processor + + let actualRightValues = + clActualRightValues.ToHostAndFree processor + + let actualColumns = clActualColumns.ToHostAndFree processor + + "Left values must be the same" + |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues + + "Right values must be the same" + |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expectedColumns + | None -> + "Result must be empty" + |> Expect.isTrue (expectedColumns.Length = 0) + +let createExpandTest isEqual (zero: 'a) testFun = + testFun context Utils.defaultWorkGroupSize + |> makeExpandTest isEqual zero + |> testPropertyWithConfig { config with endSize = 10 ; maxTest = 100 } $"test on %A{typeof<'a>}" + +// (Debug only) expand phase tests +let expandTests = + [ createExpandTest (=) 0 Expand.expand + + if Utils.isFloat64Available context.ClDevice then + createExpandTest Utils.floatIsEqual 0.0 Expand.expand + + createExpandTest Utils.float32IsEqual 0f Expand.expand + createExpandTest (=) false Expand.expand + createExpandTest (=) 0uy Expand.expand ] + |> testList "Expand.expand" + +let compareSparseVectors isEqual (actual: Vector.Sparse<'a>) (expected: Vector.Sparse<'a>) = + "Sparse vector size must be the same" + |> Expect.equal actual.Size expected.Size + + "Value must be the same" + |> Utils.compareArrays isEqual actual.Values expected.Values + + "Indices must be the same" + |> Utils.compareArrays (=) actual.Indices expected.Indices + +let compareLILMatrix isEqual (actual: Matrix.Rows<'a>) (expected: Matrix.Rows<'a>) = + "Column count must be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount + + "Rows count must be the same" + |> Expect.equal actual.RowCount expected.RowCount + + Array.iter2 (fun actualRow expected -> + match actualRow, expected with + | Some actualVector, Some expectedVector -> + compareSparseVectors isEqual actualVector expectedVector + | None, None -> () + | _ -> failwith "Rows are not matching") + <| actual.Rows + <| expected.Rows + +let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clMatrixActual: ClMatrix<_>) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + let matrixActual = clMatrixActual.ToHostAndDispose processor + + match matrixActual with + | Matrix.Rows actual -> + HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray + |> fun array -> Matrix.Rows.FromArray2D(array, (isEqual zero)) + |> compareLILMatrix isEqual actual + | _ -> failwith "Matrix format are not matching" + +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize opAddQ opMulQ + + makeGeneralTest zero isEqual opMul opAdd testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest + 0.0 + Utils.floatIsEqual + ArithmeticOperations.floatAdd + ArithmeticOperations.floatMul + Matrix.SpGeMM.expand + + createGeneralTest + 0.0f + Utils.float32IsEqual + ArithmeticOperations.float32Add + ArithmeticOperations.float32Mul + Matrix.SpGeMM.expand + createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] + |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs index 4e894609..fadc30df 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs @@ -77,6 +77,7 @@ let checkResult areEqual zero actual (expected2D: 'a [,]) = "Value arrays should be equal" |> Utils.compareArrays areEqual actual.Values expected.Values + | _ -> () // TODO() let makeTestRegular context q transposeFun hostTranspose isEqual zero case (array: 'a [,]) = let mtx = diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index a0bf2c8a..19e04826 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,5 +95,5 @@ open GraphBLAS.FSharp.Tests [] let main argv = - testList "lol" [ Matrix.Convert.tests ] |> testSequenced + testList "lol" [ Common.ClArray.Pairwise.tests ] |> testSequenced |> runTestsWithCLIArgs [] argv From cf48196f77c0b5c13339e7ff7b6bbcfc1667cde5 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 19 Apr 2023 14:10:30 +0300 Subject: [PATCH 078/143] add: CSR.RowsLengths tests --- .../Matrix/CSR/Matrix.fs | 4 +- .../Matrix/SpGeMM/Expand.fs | 8 +-- .../GraphBLAS-sharp.Tests.fsproj | 1 + .../Matrix/RowsLengths.fs | 53 +++++++++++++++++++ .../Matrix/SpGeMM/Expand.fs | 48 +++++++++-------- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 6 files changed, 88 insertions(+), 28 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 0d941012..fe28d499 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -169,14 +169,14 @@ module Matrix = let subtract = ClArray.map clContext workGroupSize <@ fun (fst, snd) -> snd - fst @> - fun (processor: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'b>) -> + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'b>) -> let pointerPairs = pairwise processor DeviceOnly matrix.RowPointers // since row pointers length in matrix always >= 2 |> Option.defaultWith (fun () -> failwith "The state of the matrix is broken. The length of the rowPointers must be >= 2") - let rowsLength = subtract processor DeviceOnly pointerPairs + let rowsLength = subtract processor allocationMode pointerPairs pointerPairs.Free processor diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 241aa54a..30308585 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -34,8 +34,6 @@ module Expand = // extract needed lengths by left matrix nnz gather processor leftMatrixRow.Indices rightMatrixRowsLengths segmentsLengths - rightMatrixRowsLengths.Free processor - // compute pointers let length = (prefixSum processor segmentsLengths) @@ -297,11 +295,15 @@ module Expand = fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let rightMatrixRowsLengths = - getRowsLength processor rightMatrix + getRowsLength processor DeviceOnly rightMatrix + + printfn "right matrix rows lengths: %A" <| rightMatrixRowsLengths.ToHost processor let runRow = runRow processor allocationMode rightMatrix rightMatrixRowsLengths + rightMatrixRowsLengths.Free processor + split processor allocationMode leftMatrix |> Seq.map (fun lazyRow -> Option.bind runRow lazyRow.Value) |> Seq.toArray diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 5493767f..64400aa6 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -56,6 +56,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs b/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs new file mode 100644 index 00000000..847c7f74 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs @@ -0,0 +1,53 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.RowsLengths + +open Expecto +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let processor = Context.defaultContext.Queue + +let context = Context.defaultContext.ClContext + +let config = Utils.defaultConfig + +let makeTest isZero testFun (array: 'a [,]) = + + let matrix = Matrix.CSR.FromArray2D(array, isZero) + + if matrix.NNZ > 0 then + + let clMatrix = matrix.ToDevice context + let (clActual: ClArray) = testFun processor HostInterop clMatrix + + clMatrix.Dispose processor + let actual = clActual.ToHostAndFree processor + + let expected = + matrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + "Results must be the same" + |> Utils.compareArrays (=) actual expected + +let createTest<'a when 'a : struct> (isZero: 'a -> bool) = + CSR.Matrix.getRowsLength context Utils.defaultWorkGroupSize + |> makeTest isZero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest <| (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTest <| Utils.floatIsEqual 0.0 + + createTest <| Utils.float32IsEqual 0.0f + createTest <| (=) false ] + |> testList "CSR.RowsLengths" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 7e9ed80b..952fa08a 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -20,9 +20,12 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue +processor.Error.Add(fun e -> failwithf "%A" e) + let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } + arbitrary = [ typeof + typeof ] } let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = @@ -228,6 +231,9 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr let (clMatrixActual: ClMatrix<_>) = testFun processor HostInterop clLeftMatrix clRightMatrix + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + let matrixActual = clMatrixActual.ToHostAndDispose processor match matrixActual with @@ -238,29 +244,27 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr | _ -> failwith "Matrix format are not matching" let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = - - let testFun = - testFun context Utils.defaultWorkGroupSize opAddQ opMulQ - - makeGeneralTest zero isEqual opMul opAdd testFun - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + testFun context Utils.defaultWorkGroupSize opAddQ opMulQ + |> makeGeneralTest zero isEqual opMul opAdd + |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand - if Utils.isFloat64Available context.ClDevice then - createGeneralTest - 0.0 - Utils.floatIsEqual - ArithmeticOperations.floatAdd - ArithmeticOperations.floatMul - Matrix.SpGeMM.expand - - createGeneralTest - 0.0f - Utils.float32IsEqual - ArithmeticOperations.float32Add - ArithmeticOperations.float32Mul - Matrix.SpGeMM.expand - createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] + // if Utils.isFloat64Available context.ClDevice then + // createGeneralTest + // 0.0 + // Utils.floatIsEqual + // ArithmeticOperations.floatAdd + // ArithmeticOperations.floatMul + // Matrix.SpGeMM.expand + // + // createGeneralTest + // 0.0f + // Utils.float32IsEqual + // ArithmeticOperations.float32Add + // ArithmeticOperations.float32Mul + // Matrix.SpGeMM.expand + // createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] + ] |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 19e04826..0fdf40ae 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,5 +95,5 @@ open GraphBLAS.FSharp.Tests [] let main argv = - testList "lol" [ Common.ClArray.Pairwise.tests ] |> testSequenced + testList "lol" [ Matrix.RowsLengths.tests ] |> testSequenced |> runTestsWithCLIArgs [] argv From a60b12a0fa31d7265c4b4667bea1c9f865f8f6f6 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 20 Apr 2023 10:53:32 +0300 Subject: [PATCH 079/143] add: spgemm row wise --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 25 ++- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 11 +- .../Matrix/CSR/Matrix.fs | 9 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 31 +-- .../Matrix/Rows/Matrix.fs | 12 +- .../Matrix/SpGeMM/Expand.fs | 124 ++++++------ src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 16 +- src/GraphBLAS-sharp.Backend/Quotes/Convert.fs | 2 +- .../Vector/Sparse/Map.fs | 3 +- src/GraphBLAS-sharp/Objects/Matrix.fs | 18 +- .../Objects/MatrixExtensions.fs | 12 +- .../Objects/VectorExtensions.fs | 3 +- .../Common/ClArray/Assign.fs | 7 +- .../Common/ClArray/Concat.fs | 9 +- .../Common/ClArray/Fill.fs | 4 +- .../Common/ClArray/Pairwise.fs | 4 +- .../Common/Reduce/ReduceByKey.fs | 41 ++-- .../Common/Sort/Radix.fs | 102 +++++----- tests/GraphBLAS-sharp.Tests/Generators.fs | 8 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 28 ++- tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs | 14 +- .../Matrix/RowsLengths.fs | 22 +- .../Matrix/SpGeMM/Expand.fs | 126 +++++------- tests/GraphBLAS-sharp.Tests/Program.fs | 190 +++++++++--------- 24 files changed, 435 insertions(+), 386 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 80e4f5a9..211984f5 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -588,8 +588,7 @@ module ClArray = processor.Post( Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange targetPosition sourceArray.Length sourceArray targetArray) + (fun () -> kernel.KernelFunc ndRange targetPosition sourceArray.Length sourceArray targetArray) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -632,13 +631,17 @@ module ClArray = let kernel = clContext.Compile fill fun (processor: MailboxProcessor<_>) value firstPosition count (targetArray: ClArray<'a>) -> - if count = 0 then () + if count = 0 then + () else if firstPosition + count > targetArray.Length then failwith "The array should fit completely" - if firstPosition < 0 then failwith "The starting position cannot be less than zero" - if count < 0 then failwith "The count cannot be less than zero" + if firstPosition < 0 then + failwith "The starting position cannot be less than zero" + + if count < 0 then + failwith "The count cannot be less than zero" let ndRange = Range1D.CreateValid(count, workGroupSize) @@ -646,8 +649,7 @@ module ClArray = let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange firstPosition count value targetArray) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange firstPosition count value targetArray) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -660,7 +662,8 @@ module ClArray = let incGather = Gather.runInit Map.inc clContext workGroupSize - let map = map2 clContext workGroupSize <@ fun first second -> (first, second) @> + let map = + map2 clContext workGroupSize <@ fun first second -> (first, second) @> fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) -> if values.Length > 1 then @@ -676,10 +679,12 @@ module ClArray = incGather processor values secondItems - let result = map processor allocationMode firstItems secondItems + let result = + map processor allocationMode firstItems secondItems firstItems.Free processor secondItems.Free processor Some result - else None + else + None diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index df2b3c1b..d243d14e 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -567,7 +567,8 @@ module Reduce = (prefixSum processor resultPositions) .ToHostAndFree processor - if resultLength = 0 then None + if resultLength = 0 then + None else // write values let resultValues = @@ -586,7 +587,8 @@ module Reduce = reducedKeys.Free processor resultPositions.Free processor - Some (resultValues, resultKeys) + Some(resultValues, resultKeys) + module ByKey2D = /// /// Reduce an array of values by 2D keys using a single work item. @@ -845,7 +847,8 @@ module Reduce = (prefixSum processor resultPositions) .ToHostAndFree processor - if resultLength = 0 then None + if resultLength = 0 then + None else // write value let resultValues = @@ -873,4 +876,4 @@ module Reduce = resultPositions.Free processor - Some (resultValues, resultFirstKeys, resultSecondKeys) + Some(resultValues, resultFirstKeys, resultSecondKeys) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index fe28d499..d6009d01 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -162,7 +162,7 @@ module Matrix = Rows = rows NNZ = matrix.NNZ } - let getRowsLength (clContext: ClContext) workGroupSize = + let NNZInRows (clContext: ClContext) workGroupSize = let pairwise = ClArray.pairwise clContext workGroupSize @@ -173,10 +173,11 @@ module Matrix = let pointerPairs = pairwise processor DeviceOnly matrix.RowPointers // since row pointers length in matrix always >= 2 - |> Option.defaultWith (fun () -> - failwith "The state of the matrix is broken. The length of the rowPointers must be >= 2") + |> Option.defaultWith + (fun () -> failwith "The state of the matrix is broken. The length of the rowPointers must be >= 2") - let rowsLength = subtract processor allocationMode pointerPairs + let rowsLength = + subtract processor allocationMode pointerPairs pointerPairs.Free processor diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index fda92183..be3f5521 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -44,7 +44,7 @@ module Matrix = Rows = copy processor allocationMode m.Rows ColumnPointers = copy processor allocationMode m.ColumnPointers Values = copyData processor allocationMode m.Values } - | ClMatrix.Rows matrix -> + | ClMatrix.LIL matrix -> matrix.Rows |> Array.map ( Option.bind @@ -56,7 +56,7 @@ module Matrix = ColumnCount = matrix.ColumnCount Rows = rows NNZ = matrix.NNZ } - |> ClMatrix.Rows + |> ClMatrix.LIL /// /// Creates a new matrix, represented in CSR format, that is equal to the given one. @@ -82,7 +82,7 @@ module Matrix = m.ToCSR |> transpose processor allocationMode |> ClMatrix.CSR - | ClMatrix.Rows m -> + | ClMatrix.LIL m -> rowsToCSR processor allocationMode m |> ClMatrix.CSR @@ -136,7 +136,7 @@ module Matrix = |> toCOO processor allocationMode |> transposeInPlace processor |> ClMatrix.COO - | ClMatrix.Rows m -> + | ClMatrix.LIL m -> rowsToCSR processor allocationMode m |> toCOO processor allocationMode |> ClMatrix.COO @@ -183,7 +183,8 @@ module Matrix = let transposeCOO = COO.Matrix.transpose clContext workGroupSize - let rowsToCSR = Rows.Matrix.toCSR clContext workGroupSize + let rowsToCSR = + Rows.Matrix.toCSR clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -196,7 +197,7 @@ module Matrix = |> COOtoCSR processor allocationMode) .ToCSC |> ClMatrix.CSC - | ClMatrix.Rows m -> + | ClMatrix.LIL m -> rowsToCSR processor allocationMode m |> transposeCSR processor allocationMode |> fun m -> m.ToCSC @@ -241,7 +242,8 @@ module Matrix = let transposeCSR = CSR.Matrix.transposeInPlace clContext workGroupSize - let CSRToRows = CSR.Matrix.toRows clContext workGroupSize + let CSRToRows = + CSR.Matrix.toRows clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -249,15 +251,15 @@ module Matrix = m.ToCSR |> transposeCSR processor allocationMode |> CSRToRows processor allocationMode - |> ClMatrix.Rows + |> ClMatrix.LIL | ClMatrix.CSR m -> CSRToRows processor allocationMode m - |> ClMatrix.Rows + |> ClMatrix.LIL | ClMatrix.COO m -> COOToCSR processor allocationMode m |> CSRToRows processor allocationMode - |> ClMatrix.Rows - | ClMatrix.Rows _ -> copy processor allocationMode matrix + |> ClMatrix.LIL + | ClMatrix.LIL _ -> copy processor allocationMode matrix let map (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) workGroupSize = let mapCOO = @@ -363,7 +365,7 @@ module Matrix = | ClMatrix.COO m -> COOTransposeInPlace processor m |> ClMatrix.COO | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC | ClMatrix.CSC m -> ClMatrix.CSR m.ToCSR - | ClMatrix.Rows _ -> failwith "Not yet implemented" + | ClMatrix.LIL _ -> failwith "Not yet implemented" /// /// Transposes the given matrix and returns result as a new matrix. @@ -406,7 +408,7 @@ module Matrix = Columns = copy processor allocationMode m.Rows Values = copyData processor allocationMode m.Values } |> ClMatrix.CSR - | ClMatrix.Rows _ -> failwith "Not yet implemented" + | ClMatrix.LIL _ -> failwith "Not yet implemented" module SpGeMM = let masked @@ -437,5 +439,6 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> match leftMatrix, rightMatrix with | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> - ClMatrix.Rows <| run processor allocationMode leftMatrix rightMatrix + ClMatrix.LIL + <| run processor allocationMode leftMatrix rightMatrix | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs index 2f9a0a72..b7bea530 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs @@ -17,15 +17,17 @@ module Matrix = let concatValues = ClArray.concat clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: Rows<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (matrix: LIL<'a>) -> let rowsPointers = matrix.Rows - |> Array.map (function None -> 0 | Some vector -> vector.Values.Length) + |> Array.map + (function + | None -> 0 + | Some vector -> vector.Values.Length) // prefix sum |> Array.scan (+) 0 - |> fun pointers -> - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, pointers) + |> fun pointers -> clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, pointers) let valuesByRows, columnsIndicesByRows = matrix.Rows @@ -45,5 +47,3 @@ module Matrix = RowPointers = rowsPointers Columns = columnsIndices Values = values } - - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 30308585..214e8a49 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -29,7 +29,7 @@ module Expand = fun (processor: MailboxProcessor<_>) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrixRowsLengths: ClArray) -> let segmentsLengths = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRow.Indices.Length) + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRow.NNZ) // extract needed lengths by left matrix nnz gather processor leftMatrixRow.Indices rightMatrixRowsLengths segmentsLengths @@ -70,9 +70,9 @@ module Expand = let rightMatrixGather = Gather.run clContext workGroupSize fun (processor: MailboxProcessor<_>) length (segmentsPointers: Indices) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - if length = 0 then None + if length = 0 then + None else - printfn "expand length: %A" length // Compute left matrix positions let leftMatrixPositions = zeroCreate processor DeviceOnly length @@ -124,7 +124,7 @@ module Expand = rightMatrixPositions.Free processor // left, right matrix values, columns indices - Some (leftMatrixValues, rightMatrixValues, columns) + Some(leftMatrixValues, rightMatrixValues, columns) let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = let getBitmap = @@ -149,7 +149,8 @@ module Expand = (prefixSum processor positions) .ToHostAndFree(processor) - if resultLength = 0 then None + if resultLength = 0 then + None else let resultIndices = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) @@ -161,7 +162,7 @@ module Expand = assignValues processor firstValues secondValues positions resultValues - Some (resultValues, resultIndices) + Some(resultValues, resultIndices) let sortByColumns (clContext: ClContext) workGroupSize = @@ -236,8 +237,6 @@ module Expand = let length, segmentPointers = getSegmentPointers processor leftMatrixRow leftMatrixRowsLengths - if length < 0 then failwith "length < 0" - // expand let expandResult = expand processor length segmentPointers leftMatrixRow rightMatrix @@ -245,72 +244,85 @@ module Expand = segmentPointers.Free processor expandResult - |> Option.bind (fun (leftMatrixValues, rightMatrixValues, columns) -> - // multiplication - let mulResult = - multiply processor leftMatrixValues rightMatrixValues columns - - leftMatrixValues.Free processor - rightMatrixValues.Free processor - columns.Free processor - - // check multiplication result - mulResult - |> Option.bind (fun (resultValues, resultColumns) -> - // sort - let sortedValues, sortedColumns = - sort processor resultValues resultColumns - - resultValues.Free processor - resultColumns.Free processor - - let reduceResult = - reduce processor allocationMode sortedValues sortedColumns - - sortedValues.Free processor - sortedColumns.Free processor - - // create sparse vector (TODO(empty vector)) - reduceResult - |> Option.bind (fun (values, columns) -> - { Context = clContext - Indices = columns - Values = values - Size = rightMatrix.ColumnCount } - |> Some))) - - let run<'a, 'b, 'c when 'a : struct and 'b : struct and 'c : struct> + |> Option.bind + (fun (leftMatrixValues, rightMatrixValues, columns) -> + // multiplication + let mulResult = + multiply processor leftMatrixValues rightMatrixValues columns + + leftMatrixValues.Free processor + rightMatrixValues.Free processor + columns.Free processor + + // check multiplication result + mulResult + |> Option.bind + (fun (resultValues, resultColumns) -> + // sort + let sortedValues, sortedColumns = + sort processor resultValues resultColumns + + resultValues.Free processor + resultColumns.Free processor + + let reduceResult = + reduce processor allocationMode sortedValues sortedColumns + + sortedValues.Free processor + sortedColumns.Free processor + + // create sparse vector (TODO(empty vector)) + reduceResult + |> Option.bind + (fun (values, columns) -> + { Context = clContext + Indices = columns + Values = values + Size = rightMatrix.ColumnCount } + |> Some))) + + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) workGroupSize opAdd - (opMul: Expr<'a -> 'b -> 'c option>) = + (opMul: Expr<'a -> 'b -> 'c option>) + = - let getRowsLength = - CSR.Matrix.getRowsLength clContext workGroupSize + let getNNZInRows = + CSR.Matrix.NNZInRows clContext workGroupSize - let split = CSR.Matrix.byRowsLazy clContext workGroupSize + let split = + CSR.Matrix.byRowsLazy clContext workGroupSize - let runRow = runRow clContext workGroupSize opAdd opMul + let runRow = + runRow clContext workGroupSize opAdd opMul fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let rightMatrixRowsLengths = - getRowsLength processor DeviceOnly rightMatrix - - printfn "right matrix rows lengths: %A" <| rightMatrixRowsLengths.ToHost processor + getNNZInRows processor DeviceOnly rightMatrix let runRow = runRow processor allocationMode rightMatrix rightMatrixRowsLengths - rightMatrixRowsLengths.Free processor - split processor allocationMode leftMatrix |> Seq.map (fun lazyRow -> Option.bind runRow lazyRow.Value) |> Seq.toArray |> fun rows -> - { Rows.Context = clContext + rightMatrixRowsLengths.Free processor + + // compute nnz + let nnz = + rows + |> Array.fold + (fun count -> + function + | Some row -> count + row.Size + | None -> count) + 0 + + { LIL.Context = clContext RowCount = leftMatrix.RowCount ColumnCount = rightMatrix.ColumnCount Rows = rows - NNZ = -1 } // TODO(nnz count) - + NNZ = nnz } diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index ebc7c81f..e2a1d76a 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -6,7 +6,7 @@ type MatrixFormat = | CSR | COO | CSC - | Rows + | LIL module ClMatrix = type CSR<'elem when 'elem: struct> = @@ -82,12 +82,12 @@ module ClMatrix = member this.NNZ = this.Values.Length - type Rows<'elem when 'elem: struct> = + type LIL<'elem when 'elem: struct> = { Context: ClContext RowCount: int ColumnCount: int Rows: ClVector.Sparse<'elem> option [] - NNZ: int } // TODO(empty vector) (or only some with row index ???) + NNZ: int } interface IDeviceMemObject with member this.Dispose q = @@ -117,32 +117,32 @@ type ClMatrix<'a when 'a: struct> = | CSR of ClMatrix.CSR<'a> | COO of ClMatrix.COO<'a> | CSC of ClMatrix.CSC<'a> - | Rows of ClMatrix.Rows<'a> + | LIL of ClMatrix.LIL<'a> member this.RowCount = match this with | ClMatrix.CSR matrix -> matrix.RowCount | ClMatrix.COO matrix -> matrix.RowCount | ClMatrix.CSC matrix -> matrix.RowCount - | ClMatrix.Rows matrix -> matrix.RowCount + | ClMatrix.LIL matrix -> matrix.RowCount member this.ColumnCount = match this with | ClMatrix.CSR matrix -> matrix.ColumnCount | ClMatrix.COO matrix -> matrix.ColumnCount | ClMatrix.CSC matrix -> matrix.ColumnCount - | ClMatrix.Rows matrix -> matrix.ColumnCount + | ClMatrix.LIL matrix -> matrix.ColumnCount member this.Dispose q = match this with | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose q | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose q | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.Rows matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.LIL matrix -> (matrix :> IDeviceMemObject).Dispose q member this.NNZ = match this with | ClMatrix.CSR matrix -> matrix.NNZ | ClMatrix.COO matrix -> matrix.NNZ | ClMatrix.CSC matrix -> matrix.NNZ - | ClMatrix.Rows matrix -> matrix.NNZ + | ClMatrix.LIL matrix -> matrix.NNZ diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs index 561f8993..d779ba5a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs @@ -28,6 +28,6 @@ module Convert = <@ fun rightItem -> (%op) None rightItem @> let map2ToMapRightNone (op: Expr<'a option -> 'b option -> 'c option>) = - <@ fun leftItem -> (%op) leftItem None @> + <@ fun leftItem -> (%op) leftItem None @> let map2ToNoneNone (op: Expr<'a option -> 'b option -> 'c option>) = <@ (%op) None None @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs index 7cb77404..08b706c5 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -110,7 +110,8 @@ module internal Map = let scatter = Scatter.lastOccurrence clContext workGroupSize - let setOption = ClArray.assignOption clContext workGroupSize op + let setOption = + ClArray.assignOption clContext workGroupSize op fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index b064356a..8775731b 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -135,7 +135,7 @@ module Matrix = ColumnPointers = context.CreateClArray this.ColumnPointers Values = context.CreateClArray this.Values } - type Rows<'a when 'a : struct> = + type Rows<'a when 'a: struct> = { RowCount: int ColumnCount: int Rows: Vector.Sparse<'a> option [] @@ -146,12 +146,15 @@ module Matrix = let rows = [ for i in 0 .. Array2D.length1 array - 1 do - let vector = Vector.Sparse.FromArray(array.[i, *], isZero) + let vector = + Vector.Sparse.FromArray(array.[i, *], isZero) - nnz <- nnz + vector.NNZ + nnz <- nnz + vector.NNZ - if vector.NNZ > 0 then Some vector - else None ] + if vector.NNZ > 0 then + Some vector + else + None ] |> Array.ofList { RowCount = Array2D.length1 array @@ -163,8 +166,7 @@ module Matrix = let rows = this.Rows - |> Array.map (Option.bind - (fun vector -> Some <| vector.ToDevice(context))) + |> Array.map (Option.bind (fun vector -> Some <| vector.ToDevice(context))) { Context = context RowCount = this.RowCount @@ -210,4 +212,4 @@ type Matrix<'a when 'a: struct> = | COO matrix -> ClMatrix.COO <| matrix.ToDevice context | CSR matrix -> ClMatrix.CSR <| matrix.ToDevice context | CSC matrix -> ClMatrix.CSC <| matrix.ToDevice context - | Rows matrix -> ClMatrix.Rows <| matrix.ToDevice context + | Rows matrix -> ClMatrix.LIL <| matrix.ToDevice context diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index 0a90c4c3..f4bfb15d 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -15,14 +15,14 @@ module MatrixExtensions = ColumnCount = m.ColumnCount Rows = m.Rows.ToHost q Columns = m.Columns.ToHost q - Values = m.Values.ToHost q } + Values = m.Values.ToHost q } |> Matrix.COO | ClMatrix.CSR m -> { RowCount = m.RowCount ColumnCount = m.ColumnCount RowPointers = m.RowPointers.ToHost q - ColumnIndices = m.Columns.ToHost q - Values = m.Values.ToHost q } + ColumnIndices = m.Columns.ToHost q + Values = m.Values.ToHost q } |> Matrix.CSR | ClMatrix.CSC m -> { RowCount = m.RowCount @@ -31,12 +31,12 @@ module MatrixExtensions = ColumnPointers = m.ColumnPointers.ToHost q Values = m.Values.ToHost q } |> Matrix.CSC - | ClMatrix.Rows m -> + | ClMatrix.LIL m -> { RowCount = m.RowCount ColumnCount = m.ColumnCount Rows = - m.Rows - |> Array.map (Option.bind (fun row -> Some <| row.ToHost q)) + m.Rows + |> Array.map (Option.bind (fun row -> Some <| row.ToHost q)) NNZ = m.NNZ } |> Matrix.Rows diff --git a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs index 23d40b26..4bdb6a01 100644 --- a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs @@ -14,6 +14,5 @@ module ClVectorExtensions = type ClVector<'a when 'a: struct> with member this.ToHost(q: MailboxProcessor<_>) = match this with - | ClVector.Sparse vector -> - Vector.Sparse <| vector.ToHost q + | ClVector.Sparse vector -> Vector.Sparse <| vector.ToHost q | ClVector.Dense vector -> Vector.Dense <| vector.ToHost q diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs index 65f2c0c5..092e3cb8 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs @@ -17,8 +17,7 @@ let config = let makeTest<'a> isEqual testFun (source: 'a [], target: 'a [], targetPosition: int) = - if source.Length > 0 - && target.Length > 0 then + if source.Length > 0 && target.Length > 0 then let clSource = context.CreateClArray source let clTarget = context.CreateClArray target @@ -34,7 +33,7 @@ let makeTest<'a> isEqual testFun (source: 'a [], target: 'a [], targetPosition: "Results should be the same" |> Utils.compareArrays isEqual actual target -let createTest<'a when 'a : equality> isEqual = +let createTest<'a when 'a: equality> isEqual = ClArray.assign context Utils.defaultWorkGroupSize |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -43,7 +42,7 @@ let tests = [ createTest (=) if Utils.isFloat64Available context.ClDevice then - createTest Utils.floatIsEqual + createTest Utils.floatIsEqual createTest Utils.float32IsEqual createTest (=) ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs index 4e807e8f..d27cdebf 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs @@ -16,7 +16,8 @@ let config = Utils.defaultConfig let makeTest<'a> isEqual testFun (arrays: 'a [] []) = if Seq.length arrays > 0 - && arrays |> Seq.forall (fun array -> array.Length > 0) then + && arrays + |> Seq.forall (fun array -> array.Length > 0) then let clArrays = arrays |> Seq.map context.CreateClArray @@ -24,7 +25,9 @@ let makeTest<'a> isEqual testFun (arrays: 'a [] []) = // release let actual = clActual.ToHostAndFree processor - clArrays |> Seq.iter (fun array -> array.Free processor) + + clArrays + |> Seq.iter (fun array -> array.Free processor) let expected = Seq.concat arrays |> Seq.toArray @@ -40,7 +43,7 @@ let tests = [ createTest (=) if Utils.isFloat64Available context.ClDevice then - createTest Utils.floatIsEqual + createTest Utils.floatIsEqual createTest Utils.float32IsEqual createTest (=) ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs index 196d89f6..0921ff26 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs @@ -16,7 +16,7 @@ let config = { Utils.defaultConfig with arbitrary = [ typeof ] } -let makeTest<'a> isEqual testFun (value: 'a, targetPosition, count, target: 'a [] ) = +let makeTest<'a> isEqual testFun (value: 'a, targetPosition, count, target: 'a []) = if target.Length > 0 then let clTarget = context.CreateClArray target @@ -42,7 +42,7 @@ let tests = [ createTest (=) if Utils.isFloat64Available context.ClDevice then - createTest (=) + createTest (=) createTest (=) createTest (=) ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs index e0ed32d7..5bd6957d 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs @@ -16,7 +16,7 @@ let config = { Utils.defaultConfig with arbitrary = [ typeof ] } -let makeTest<'a> isEqual testFun (array: 'a [] ) = +let makeTest<'a> isEqual testFun (array: 'a []) = if array.Length > 0 then let clArray = context.CreateClArray array @@ -42,7 +42,7 @@ let tests = [ createTest (=) if Utils.isFloat64Available context.ClDevice then - createTest (=) + createTest (=) createTest (=) createTest (=) ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 9226fd9b..75e0b9dd 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -368,11 +368,11 @@ let sequentialSegment2DTests = // segments sequential Option let createReduceOp reduceOp left right = - match left, right with - | Some left, Some right -> reduceOp left right - | Some value, None - | None, Some value -> Some value - | _ -> None + match left, right with + | Some left, Some right -> reduceOp left right + | Some value, None + | None, Some value -> Some value + | _ -> None let checkResultOption isEqual keys values reduceOp actual = @@ -401,10 +401,9 @@ let checkResultOption isEqual keys values reduceOp actual = "Values must the same" |> Utils.compareArrays isEqual actualValues expectedValues - | None -> - Expect.isTrue (expectedValues.Length = 0) "Result should be Some _" + | None -> Expect.isTrue (expectedValues.Length = 0) "Result should be Some _" -let testOption<'a> isEqual reduceOp testFun (array: (int * 'a) []) = +let testOption<'a> isEqual reduceOp testFun (array: (int * 'a) []) = if array.Length > 0 then let array = Array.sortBy fst array @@ -422,12 +421,13 @@ let testOption<'a> isEqual reduceOp testFun (array: (int * 'a) []) = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) testFun processor HostInterop offsets.Length clOffsets clKeys clValues - |> Option.bind (fun ((clActualValues, clActualKeys): ClArray<_> * ClArray<_>) -> - let actualValues = clActualValues.ToHostAndFree processor - let actualKeys = clActualKeys.ToHostAndFree processor + |> Option.bind + (fun ((clActualValues, clActualKeys): ClArray<_> * ClArray<_>) -> + let actualValues = clActualValues.ToHostAndFree processor + let actualKeys = clActualKeys.ToHostAndFree processor - Some (actualValues, actualKeys)) - |> checkResultOption isEqual keys values reduceOp + Some(actualValues, actualKeys)) + |> checkResultOption isEqual keys values reduceOp let createTestOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = Reduce.ByKey.Option.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ @@ -504,16 +504,17 @@ let test2DOption<'a> isEqual reduceOp reduce (array: (int * int * 'a) []) = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) reduce processor DeviceOnly offsets.Length clOffsets clFirstKeys clSecondKeys clValues - |> Option.bind (fun ((clReducedValues, clFirstActualKeys, clSecondActualKeys): ClArray<'a> * ClArray * ClArray) -> - let reducedFirstKeys = - clFirstActualKeys.ToHostAndFree processor + |> Option.bind + (fun ((clReducedValues, clFirstActualKeys, clSecondActualKeys): ClArray<'a> * ClArray * ClArray) -> + let reducedFirstKeys = + clFirstActualKeys.ToHostAndFree processor - let reducedSecondKeys = - clSecondActualKeys.ToHostAndFree processor + let reducedSecondKeys = + clSecondActualKeys.ToHostAndFree processor - let reducedValues = clReducedValues.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor - Some (reducedValues, reducedFirstKeys, reducedSecondKeys)) + Some(reducedValues, reducedFirstKeys, reducedSecondKeys)) |> checkResult2DOption isEqual firstKeys secondKeys values reduceOp let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs index 049568c5..2f565f3e 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.Sort +module GraphBLAS.FSharp.Tests.Backend.Common.Sort.Radix open Expecto open GraphBLAS.FSharp.Backend.Common.Sort @@ -7,75 +7,77 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects.ClContext -module Radix = - let config = - { Utils.defaultConfig with - startSize = 1000000 } +let config = + { Utils.defaultConfig with + startSize = 1000000 } - let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Utils.defaultWorkGroupSize - let processor = Context.defaultContext.Queue +let processor = Context.defaultContext.Queue - let context = Context.defaultContext.ClContext +let context = Context.defaultContext.ClContext - let checkResultByKeys (inputArray: (int * 'a) []) (actualValues: 'a []) = - let expectedValues = Seq.sortBy fst inputArray |> Seq.map snd +let checkResultByKeys (inputArray: (int * 'a) []) (actualValues: 'a []) = + let expectedValues = Seq.sortBy fst inputArray |> Seq.map snd - "Values must be the same" - |> Expect.sequenceEqual expectedValues actualValues + "Values must be the same" + |> Expect.sequenceEqual expectedValues actualValues - let makeTestByKeys<'a when 'a: equality> sortFun (array: (int * 'a) []) = +let makeTestByKeys<'a when 'a: equality> sortFun (array: (int * 'a) []) = - if array.Length > 0 then - let keys = Array.map fst array - let values = Array.map snd array + if array.Length > 0 then + let keys = Array.map fst array + let values = Array.map snd array - let clKeys = keys.ToDevice context - let clValues = values.ToDevice context + let clKeys = keys.ToDevice context + let clValues = values.ToDevice context - let clActualValues: ClArray<'a> = - sortFun processor HostInterop clKeys clValues + let clActualValues: ClArray<'a> = + sortFun processor HostInterop clKeys clValues - let actualValues = clActualValues.ToHostAndFree processor + let actualValues = clActualValues.ToHostAndFree processor - checkResultByKeys array actualValues + checkResultByKeys array actualValues - let createTestByKeys<'a when 'a: equality and 'a: struct> = - let sort = - Radix.runByKeysStandard context workGroupSize +let createTestByKeys<'a when 'a: equality and 'a: struct> = + let sort = + Radix.runByKeysStandard context workGroupSize - makeTestByKeys<'a> sort - |> testPropertyWithConfig config $"test on {typeof<'a>}" + makeTestByKeys<'a> sort + |> testPropertyWithConfig config $"test on {typeof<'a>}" - let testByKeys = - [ createTestByKeys - createTestByKeys +let testByKeys = + [ createTestByKeys + createTestByKeys - if Utils.isFloat64Available context.ClDevice then - createTestByKeys + if Utils.isFloat64Available context.ClDevice then + createTestByKeys - createTestByKeys - createTestByKeys ] - |> testList "Radix sort by keys" + createTestByKeys + createTestByKeys ] + |> testList "Radix sort by keys" - let makeTestKeysOnly sort (keys: uint []) = - if keys.Length > 0 then - let keys = Array.map int keys +let makeTestKeysOnly sort (keys: uint []) = + if keys.Length > 0 then + let keys = Array.map int keys - let clKeys = keys.ToDevice context + let clKeys = keys.ToDevice context - let actual = - (sort processor clKeys: ClArray) - .ToHostAndFree processor + let actual = + (sort processor clKeys: ClArray) + .ToHostAndFree processor - let expected = Array.sort keys + let expected = Array.sort keys - "Keys must be the same" - |> Expect.sequenceEqual expected actual + "Keys must be the same" + |> Expect.sequenceEqual expected actual - let testKeysOnly = - let sort = - Radix.standardRunKeysOnly context workGroupSize +let testKeysOnly = + let sort = + Radix.standardRunKeysOnly context workGroupSize - makeTestKeysOnly sort - |> testPropertyWithConfig config $"keys only" + makeTestKeysOnly sort + |> testPropertyWithConfig config $"keys only" + +let allTests = + testList "Radix" [ testKeysOnly; testByKeys ] diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 3d4c3e37..7616b6cd 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -570,9 +570,7 @@ module Generators = type ArrayOfDistinctKeys() = static let arrayOfDistinctKeysGenerator (keysGenerator: Gen<'n>) (valuesGenerator: Gen<'a>) = let tuplesGenerator = - Gen.zip - <| keysGenerator - <| valuesGenerator + Gen.zip <| keysGenerator <| valuesGenerator gen { let! length = Gen.sized <| fun size -> Gen.choose (1, size) @@ -1079,13 +1077,13 @@ module Generators = gen { let! value = valuesGenerator - let! targetArrayLength = Gen.sized <| fun size -> Gen.choose(1, size + 1) + let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (1, size + 1) let! targetArray = Gen.arrayOfLength targetArrayLength valuesGenerator let! targetPosition = Gen.choose (0, targetArrayLength) - let! targetCount = Gen.choose(0, targetArrayLength - targetPosition) + let! targetCount = Gen.choose (0, targetArrayLength - targetPosition) return (value, targetPosition, targetCount, targetArray) } diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 751bc6fe..e177a50c 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -63,7 +63,7 @@ module Utils = | CSC -> Matrix.CSC <| Matrix.CSC.FromArray2D(array, isZero) - | Rows -> + | LIL -> Matrix.Rows <| Matrix.Rows.FromArray2D(array, isZero) @@ -120,6 +120,32 @@ module Utils = Actual value is %A{actual.[i, j]}, expected %A{expected.[i, j]}" |> failtestf "%s" + let compareSparseVectors isEqual (actual: Vector.Sparse<'a>) (expected: Vector.Sparse<'a>) = + "Sparse vector size must be the same" + |> Expect.equal actual.Size expected.Size + + "Value must be the same" + |> compareArrays isEqual actual.Values expected.Values + + "Indices must be the same" + |> compareArrays (=) actual.Indices expected.Indices + + let compareLILMatrix isEqual (actual: Matrix.Rows<'a>) (expected: Matrix.Rows<'a>) = + "Column count must be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount + + "Rows count must be the same" + |> Expect.equal actual.RowCount expected.RowCount + + Array.iter2 + (fun actualRow expected -> + match actualRow, expected with + | Some actualVector, Some expectedVector -> compareSparseVectors isEqual actualVector expectedVector + | None, None -> () + | _ -> failwith "Rows are not matching") + <| actual.Rows + <| expected.Rows + let listOfUnionCases<'a> = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs index a62dade9..058337d0 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs @@ -48,13 +48,15 @@ let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = "Matrices should be equal" |> Expect.equal actual expected -let createTest<'a when 'a : struct and 'a : equality> convertFun formatTo (isZero: 'a -> bool) = - let convertFun = convertFun context Utils.defaultWorkGroupSize +let createTest<'a when 'a: struct and 'a: equality> convertFun formatTo (isZero: 'a -> bool) = + let convertFun = + convertFun context Utils.defaultWorkGroupSize Utils.listOfUnionCases - |> List.map (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun isZero - |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>} from %A{formatFrom}") + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun isZero + |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>} from %A{formatFrom}") let testFixtures formatTo = match formatTo with @@ -67,7 +69,7 @@ let testFixtures formatTo = | CSC -> [ createTest Matrix.toCSC formatTo ((=) 0) createTest Matrix.toCSC formatTo ((=) false) ] - | Rows -> + | LIL -> [ createTest Matrix.toRows formatTo ((=) 0) createTest Matrix.toRows formatTo ((=) false) ] |> List.concat diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs b/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs index 847c7f74..6aab0988 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs @@ -30,15 +30,27 @@ let makeTest isZero testFun (array: 'a [,]) = let actual = clActual.ToHostAndFree processor let expected = - matrix.RowPointers - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) + Array.zeroCreate <| Array2D.length1 array + + // count nnz in each row + for i in 0 .. Array2D.length1 array - 1 do + let nnzRowCount = + array.[i, *] + |> Array.fold + (fun count item -> + if not <| isZero item then + count + 1 + else + count) + 0 + + expected.[i] <- nnzRowCount "Results must be the same" |> Utils.compareArrays (=) actual expected -let createTest<'a when 'a : struct> (isZero: 'a -> bool) = - CSR.Matrix.getRowsLength context Utils.defaultWorkGroupSize +let createTest<'a when 'a: struct> (isZero: 'a -> bool) = + CSR.Matrix.NNZInRows context Utils.defaultWorkGroupSize |> makeTest isZero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 952fa08a..71ed17bb 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -24,8 +24,9 @@ processor.Error.Add(fun e -> failwithf "%A" e) let config = { Utils.defaultConfig with - arbitrary = [ typeof - typeof ] } + arbitrary = + [ typeof + typeof ] } let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = @@ -44,8 +45,9 @@ let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = |> Array.map (fun (fst, snd) -> snd - fst) let expectedPointers, expectedLength = - Array.init leftMatrixRow.Indices.Length (fun index -> - rightMatrixRowsLength.[leftMatrixRow.Indices[index]]) + Array.init + leftMatrixRow.Indices.Length + (fun index -> rightMatrixRowsLength.[leftMatrixRow.Indices [ index ]]) |> HostPrimitives.prefixSumExclude 0 (+) let clLeftMatrixRow = leftMatrixRow.ToDevice context @@ -100,15 +102,17 @@ let expand (leftMatrixRow: Vector.Sparse<'a>) (rightMatrix: Matrix.CSR<'b>) = Array.map (fun index -> rightMatrix.RowPointers.[index]) leftMatrixRow.Indices let rightMatrixValues = - Array.map2(fun rowPointer segmentLength -> - Array.take segmentLength rightMatrix.Values.[rowPointer..]) - rightMatrixRowPointers segmentsLengths + Array.map2 + (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.Values.[rowPointer..]) + rightMatrixRowPointers + segmentsLengths |> Array.concat let columns = - Array.map2 (fun rowPointer segmentLength -> - Array.take segmentLength rightMatrix.ColumnIndices.[rowPointer ..]) - rightMatrixRowPointers segmentsLengths + Array.map2 + (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.ColumnIndices.[rowPointer..]) + rightMatrixRowPointers + segmentsLengths |> Array.concat leftMatrixValues, rightMatrixValues, columns @@ -124,33 +128,30 @@ let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then let clPointers, lenght = - rightMatrix.RowPointers - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) - |> fun rightMatrixRowsLengths -> - Array.init leftMatrixRow.Indices.Length (fun index -> - rightMatrixRowsLengths.[leftMatrixRow.Indices[index]]) + rightMatrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + |> fun rightMatrixRowsLengths -> + Array.init + leftMatrixRow.Indices.Length + (fun index -> rightMatrixRowsLengths.[leftMatrixRow.Indices [ index ]]) |> HostPrimitives.prefixSumExclude 0 (+) - |> fun (pointers, length) -> - context.CreateClArray(pointers), length + |> fun (pointers, length) -> context.CreateClArray(pointers), length let clLeftMatrixRow = leftMatrixRow.ToDevice context let clRightMatrix = rightMatrix.ToDevice context - let result - = testFun processor lenght clPointers clLeftMatrixRow clRightMatrix + let result = + testFun processor lenght clPointers clLeftMatrixRow clRightMatrix clLeftMatrixRow.Dispose processor clRightMatrix.Dispose processor clPointers.Free processor - let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns = - expand leftMatrixRow rightMatrix + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns = expand leftMatrixRow rightMatrix match result with - | Some (clActualLeftValues: ClArray<'a>, - clActualRightValues: ClArray<'a>, - clActualColumns: ClArray) -> + | Some (clActualLeftValues: ClArray<'a>, clActualRightValues: ClArray<'a>, clActualColumns: ClArray) -> let actualLeftValues = clActualLeftValues.ToHostAndFree processor @@ -175,7 +176,7 @@ let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = let createExpandTest isEqual (zero: 'a) testFun = testFun context Utils.defaultWorkGroupSize |> makeExpandTest isEqual zero - |> testPropertyWithConfig { config with endSize = 10 ; maxTest = 100 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" // (Debug only) expand phase tests let expandTests = @@ -189,33 +190,7 @@ let expandTests = createExpandTest (=) 0uy Expand.expand ] |> testList "Expand.expand" -let compareSparseVectors isEqual (actual: Vector.Sparse<'a>) (expected: Vector.Sparse<'a>) = - "Sparse vector size must be the same" - |> Expect.equal actual.Size expected.Size - - "Value must be the same" - |> Utils.compareArrays isEqual actual.Values expected.Values - - "Indices must be the same" - |> Utils.compareArrays (=) actual.Indices expected.Indices - -let compareLILMatrix isEqual (actual: Matrix.Rows<'a>) (expected: Matrix.Rows<'a>) = - "Column count must be the same" - |> Expect.equal actual.ColumnCount expected.ColumnCount - - "Rows count must be the same" - |> Expect.equal actual.RowCount expected.RowCount - - Array.iter2 (fun actualRow expected -> - match actualRow, expected with - | Some actualVector, Some expectedVector -> - compareSparseVectors isEqual actualVector expectedVector - | None, None -> () - | _ -> failwith "Rows are not matching") - <| actual.Rows - <| expected.Rows - -let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = +let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = let leftMatrix = Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) @@ -234,37 +209,38 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr clLeftMatrix.Dispose processor clRightMatrix.Dispose processor - let matrixActual = clMatrixActual.ToHostAndDispose processor + let matrixActual = + clMatrixActual.ToHostAndDispose processor match matrixActual with | Matrix.Rows actual -> HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray |> fun array -> Matrix.Rows.FromArray2D(array, (isEqual zero)) - |> compareLILMatrix isEqual actual + |> Utils.compareLILMatrix isEqual actual | _ -> failwith "Matrix format are not matching" let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ - |> makeGeneralTest zero isEqual opMul opAdd - |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" + |> makeGeneralTest<'a> zero isEqual opMul opAdd + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let generalTests = - [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand - - // if Utils.isFloat64Available context.ClDevice then - // createGeneralTest - // 0.0 - // Utils.floatIsEqual - // ArithmeticOperations.floatAdd - // ArithmeticOperations.floatMul - // Matrix.SpGeMM.expand - // - // createGeneralTest - // 0.0f - // Utils.float32IsEqual - // ArithmeticOperations.float32Add - // ArithmeticOperations.float32Mul - // Matrix.SpGeMM.expand - // createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] - ] + [ //createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest + 0.0 + Utils.floatIsEqual + ArithmeticOperations.floatAdd + ArithmeticOperations.floatMul + Matrix.SpGeMM.expand + + createGeneralTest + 0.0f + Utils.float32IsEqual + ArithmeticOperations.float32Add + ArithmeticOperations.float32Mul + Matrix.SpGeMM.expand + + createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 0fdf40ae..e5fec84a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,98 +2,102 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Map.notTests -// Matrix.Map.addTests -// Matrix.Map.mulTests -// Matrix.Mxm.tests -// Matrix.Transpose.tests ] -// |> testSequenced -// -// let commonTests = -// let scanTests = -// testList -// "Scan" -// [ Common.Scan.ByKey.sequentialSegmentsTests -// Common.Scan.PrefixSum.tests ] -// -// let reduceTests = -// testList -// "Reduce" -// [ Common.Reduce.ByKey.sequentialTest -// Common.Reduce.ByKey.sequentialSegmentTests -// Common.Reduce.ByKey.oneWorkGroupTest -// Common.Reduce.Reduce.tests -// Common.Reduce.Sum.tests ] -// -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.tests ] -// -// let sortTests = -// testList -// "Sort" -// [ Common.Sort.Bitonic.tests -// Common.Sort.Radix.testsByKeys -// Common.Sort.Radix.testKeysOnly ] -// -// testList -// "Common tests" -// [ clArrayTests -// sortTests -// reduceTests -// scanTests -// Common.Scatter.tests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced -// -// [] -// let allTests = -// testList -// "All tests" -// [ matrixTests -// commonTests -// vectorTests -// algorithmsTests ] -// |> testSequenced +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Map.notTests + Matrix.Map.addTests + Matrix.Map.mulTests + Matrix.SpGeMM.Expand.generalTests + Matrix.SpGeMM.Masked.tests + Matrix.Transpose.tests + Matrix.RowsLengths.tests ] + |> testSequenced + +let commonTests = + let scanTests = + testList + "Scan" + [ Common.Scan.ByKey.sequentialSegmentsTests + Common.Scan.PrefixSum.tests ] + + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.sequentialTest + Common.Reduce.ByKey.sequentialSegmentTests + Common.Reduce.ByKey.oneWorkGroupTest + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] + + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.tests + Common.ClArray.ChunkBySize.allTests + Common.ClArray.Assign.tests + Common.ClArray.Concat.tests + Common.ClArray.Fill.tests + Common.ClArray.Pairwise.tests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.allTests ] + + testList + "Common tests" + [ clArrayTests + sortTests + reduceTests + scanTests + Common.Scatter.tests ] + |> testSequenced + +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced + +[] +let allTests = + testList + "All tests" + [ matrixTests + commonTests + vectorTests + algorithmsTests ] + |> testSequenced [] -let main argv = - testList "lol" [ Matrix.RowsLengths.tests ] |> testSequenced - |> runTestsWithCLIArgs [] argv +let main argv = allTests |> runTestsWithCLIArgs [] argv From 3d0b07b39bdb3f9818773cc4aa13fe208dffab88 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 20 Apr 2023 11:12:15 +0300 Subject: [PATCH 080/143] refactor: formatting --- .../GraphBLAS-sharp.Backend.fsproj | 2 +- .../Matrix/CSR/Matrix.fs | 2 +- .../Matrix/{Rows => LIL}/Matrix.fs | 7 +------ src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 20 ++++++++----------- src/GraphBLAS-sharp/Objects/Matrix.fs | 12 +++++------ .../Objects/MatrixExtensions.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 6 +++--- tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs | 4 ++-- .../Matrix/SpGeMM/Expand.fs | 12 +++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 4 +--- 10 files changed, 29 insertions(+), 42 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/{Rows => LIL}/Matrix.fs (87%) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index d0e03da6..3157c369 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -52,7 +52,7 @@ - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index d6009d01..1e95a3c0 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -149,7 +149,7 @@ module Matrix = |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray - let toRows (clContext: ClContext) workGroupSize = + let toLIL (clContext: ClContext) workGroupSize = let byRows = byRows clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs similarity index 87% rename from src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs rename to src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs index b7bea530..4cc3944a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Rows/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs @@ -1,14 +1,9 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.Rows +namespace GraphBLAS.FSharp.Backend.Matrix.LIL open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClMatrix -open GraphBLAS.FSharp.Backend.Quotes -open FSharp.Quotations.Evaluator module Matrix = let toCSR (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index be3f5521..cc2d45ad 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -71,8 +71,7 @@ module Matrix = let transpose = CSR.Matrix.transpose clContext workGroupSize - let rowsToCSR = - Rows.Matrix.toCSR clContext workGroupSize + let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -124,8 +123,7 @@ module Matrix = let transposeInPlace = COO.Matrix.transposeInPlace clContext workGroupSize - let rowsToCSR = - Rows.Matrix.toCSR clContext workGroupSize + let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -183,8 +181,7 @@ module Matrix = let transposeCOO = COO.Matrix.transpose clContext workGroupSize - let rowsToCSR = - Rows.Matrix.toCSR clContext workGroupSize + let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -233,7 +230,7 @@ module Matrix = |> ClMatrix.CSC | _ -> failwith "Not yet implemented" - let toRows (clContext: ClContext) workGroupSize = + let toLIL (clContext: ClContext) workGroupSize = let copy = copy clContext workGroupSize @@ -242,22 +239,21 @@ module Matrix = let transposeCSR = CSR.Matrix.transposeInPlace clContext workGroupSize - let CSRToRows = - CSR.Matrix.toRows clContext workGroupSize + let CSRToLIL = CSR.Matrix.toLIL clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC m -> m.ToCSR |> transposeCSR processor allocationMode - |> CSRToRows processor allocationMode + |> CSRToLIL processor allocationMode |> ClMatrix.LIL | ClMatrix.CSR m -> - CSRToRows processor allocationMode m + CSRToLIL processor allocationMode m |> ClMatrix.LIL | ClMatrix.COO m -> COOToCSR processor allocationMode m - |> CSRToRows processor allocationMode + |> CSRToLIL processor allocationMode |> ClMatrix.LIL | ClMatrix.LIL _ -> copy processor allocationMode matrix diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index 8775731b..fd7dcadc 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -135,7 +135,7 @@ module Matrix = ColumnPointers = context.CreateClArray this.ColumnPointers Values = context.CreateClArray this.Values } - type Rows<'a when 'a: struct> = + type LIL<'a when 'a: struct> = { RowCount: int ColumnCount: int Rows: Vector.Sparse<'a> option [] @@ -184,32 +184,32 @@ type Matrix<'a when 'a: struct> = | CSR of Matrix.CSR<'a> | COO of Matrix.COO<'a> | CSC of Matrix.CSC<'a> - | Rows of Matrix.Rows<'a> + | LIL of Matrix.LIL<'a> member this.RowCount = match this with | CSR matrix -> matrix.RowCount | COO matrix -> matrix.RowCount | CSC matrix -> matrix.RowCount - | Rows matrix -> matrix.RowCount + | LIL matrix -> matrix.RowCount member this.ColumnCount = match this with | CSR matrix -> matrix.ColumnCount | COO matrix -> matrix.ColumnCount | CSC matrix -> matrix.ColumnCount - | Rows matrix -> matrix.ColumnCount + | LIL matrix -> matrix.ColumnCount member this.NNZ = match this with | COO m -> m.NNZ | CSR m -> m.NNZ | CSC m -> m.NNZ - | Rows m -> m.NNZ + | LIL m -> m.NNZ member this.ToDevice(context: ClContext) = match this with | COO matrix -> ClMatrix.COO <| matrix.ToDevice context | CSR matrix -> ClMatrix.CSR <| matrix.ToDevice context | CSC matrix -> ClMatrix.CSC <| matrix.ToDevice context - | Rows matrix -> ClMatrix.LIL <| matrix.ToDevice context + | LIL matrix -> ClMatrix.LIL <| matrix.ToDevice context diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index f4bfb15d..47f987f8 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -38,7 +38,7 @@ module MatrixExtensions = m.Rows |> Array.map (Option.bind (fun row -> Some <| row.ToHost q)) NNZ = m.NNZ } - |> Matrix.Rows + |> Matrix.LIL member this.ToHostAndDispose(processor: MailboxProcessor<_>) = let result = this.ToHost processor diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index e177a50c..5325be0c 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -64,8 +64,8 @@ module Utils = Matrix.CSC <| Matrix.CSC.FromArray2D(array, isZero) | LIL -> - Matrix.Rows - <| Matrix.Rows.FromArray2D(array, isZero) + Matrix.LIL + <| Matrix.LIL.FromArray2D(array, isZero) let createVectorFromArray vectorCase array isZero = match vectorCase with @@ -130,7 +130,7 @@ module Utils = "Indices must be the same" |> compareArrays (=) actual.Indices expected.Indices - let compareLILMatrix isEqual (actual: Matrix.Rows<'a>) (expected: Matrix.Rows<'a>) = + let compareLILMatrix isEqual (actual: Matrix.LIL<'a>) (expected: Matrix.LIL<'a>) = "Column count must be the same" |> Expect.equal actual.ColumnCount expected.ColumnCount diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs index 058337d0..c9c171db 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs @@ -70,8 +70,8 @@ let testFixtures formatTo = [ createTest Matrix.toCSC formatTo ((=) 0) createTest Matrix.toCSC formatTo ((=) false) ] | LIL -> - [ createTest Matrix.toRows formatTo ((=) 0) - createTest Matrix.toRows formatTo ((=) false) ] + [ createTest Matrix.toLIL formatTo ((=) 0) + createTest Matrix.toLIL formatTo ((=) false) ] |> List.concat |> testList $"%A{formatTo}" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 71ed17bb..bf946e4f 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -45,9 +45,7 @@ let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = |> Array.map (fun (fst, snd) -> snd - fst) let expectedPointers, expectedLength = - Array.init - leftMatrixRow.Indices.Length - (fun index -> rightMatrixRowsLength.[leftMatrixRow.Indices [ index ]]) + Array.init leftMatrixRow.Indices.Length (fun index -> rightMatrixRowsLength.[leftMatrixRow.Indices.[index]]) |> HostPrimitives.prefixSumExclude 0 (+) let clLeftMatrixRow = leftMatrixRow.ToDevice context @@ -134,7 +132,7 @@ let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = |> fun rightMatrixRowsLengths -> Array.init leftMatrixRow.Indices.Length - (fun index -> rightMatrixRowsLengths.[leftMatrixRow.Indices [ index ]]) + (fun index -> rightMatrixRowsLengths.[leftMatrixRow.Indices.[index]]) |> HostPrimitives.prefixSumExclude 0 (+) |> fun (pointers, length) -> context.CreateClArray(pointers), length @@ -213,9 +211,9 @@ let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftAr clMatrixActual.ToHostAndDispose processor match matrixActual with - | Matrix.Rows actual -> + | Matrix.LIL actual -> HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray - |> fun array -> Matrix.Rows.FromArray2D(array, (isEqual zero)) + |> fun array -> Matrix.LIL.FromArray2D(array, (isEqual zero)) |> Utils.compareLILMatrix isEqual actual | _ -> failwith "Matrix format are not matching" @@ -225,7 +223,7 @@ let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let generalTests = - [ //createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand if Utils.isFloat64Available context.ClDevice then createGeneralTest diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index e5fec84a..637ca279 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -29,9 +29,7 @@ let commonTests = let reduceTests = testList "Reduce" - [ Common.Reduce.ByKey.sequentialTest - Common.Reduce.ByKey.sequentialSegmentTests - Common.Reduce.ByKey.oneWorkGroupTest + [ Common.Reduce.ByKey.allTests Common.Reduce.Reduce.tests Common.Reduce.Sum.tests ] From c75fd575a331c35434cd3abf98198eceb3bf3f52 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 20 Apr 2023 14:14:47 +0300 Subject: [PATCH 081/143] wip: ArithmeticOps --- .../GraphBLAS-sharp.Backend.fsproj | 2 +- .../Quotes/Arithmetic.fs | 139 ++++++------- src/GraphBLAS-sharp.Backend/Quotes/Convert.fs | 7 + .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Program.fs | 190 +++++++++--------- tests/GraphBLAS-sharp.Tests/Vector/Map.fs | 61 ++++++ 6 files changed, 227 insertions(+), 173 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Vector/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 3157c369..88732c3e 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -19,8 +19,8 @@ + - diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 5e0ba6c4..f3cee370 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -3,7 +3,8 @@ open GraphBLAS.FSharp.Backend.Objects module ArithmeticOperations = - let inline mkUnaryOp zero unaryOp = + // unary + let inline optionUnOp zero unaryOp = <@ fun x -> let mutable res = zero @@ -13,113 +14,96 @@ module ArithmeticOperations = if res = zero then None else Some res @> - let inline mkNumericSum zero = - <@ fun (x: 't option) (y: 't option) -> - let mutable res = zero - - match x, y with - | Some f, Some s -> res <- f + s - | Some f, None -> res <- f - | None, Some s -> res <- s - | None, None -> () + let inline addLeftConst zero constant = + optionUnOp zero <@ fun x -> constant + x @> - if res = zero then None else Some res @> + let inline addRightConst zero constant = + optionUnOp zero <@ fun x -> x + constant @> - let inline mkNumericSumAtLeastOne zero = - <@ fun (values: AtLeastOne<'t, 't>) -> - let mutable res = zero + let inline mulLeftConst zero constant = + optionUnOp zero <@ fun x -> constant * x @> - match values with - | Both (f, s) -> res <- f + s - | Left f -> res <- f - | Right s -> res <- s + let inline mulRightConst zero constant = + optionUnOp zero <@ fun x -> x * constant @> - if res = zero then None else Some res @> + // binary - let inline mkNumericMul zero = - <@ fun (x: 't option) (y: 't option) -> + let inline optionBinOpQ zero binOp = + <@ fun (x: 'a option) (y: 'a option) -> let mutable res = zero match x, y with - | Some f, Some s -> res <- f * s - | _ -> () + | Some f, Some s -> res <- (%binOp) f s + | Some f, None -> res <- f + | None, Some s -> res <- s + | None, None -> () if res = zero then None else Some res @> - let inline mkNumericMulAtLeastOne zero = - <@ fun (values: AtLeastOne<'t, 't>) -> + let inline optionBinOp zero binOp = + fun (x: 'a option) (y: 'a option) -> let mutable res = zero - match values with - | Both (f, s) -> res <- f * s - | _ -> () - - if res = zero then None else Some res @> - - let boolSum = - <@ fun (x: bool option) (y: bool option) -> - let mutable res = false - match x, y with + | Some left, Some right -> res <- binOp left right + | Some left, None -> res <- left + | None, Some right -> res <- right | None, None -> () - | _ -> res <- true - if res then Some true else None @> + if res = zero then None else Some res - let inline addLeftConst zero constant = - mkUnaryOp zero <@ fun x -> constant + x @> + let createOptionPair zero opQ op = + optionBinOpQ zero opQ, optionBinOp zero op - let inline addRightConst zero constant = - mkUnaryOp zero <@ fun x -> x + constant @> + let inline createOptionSumPair zero = createOptionPair zero <@ (+) @> (+) - let intSumOption = mkNumericSum 0 - let byteSumOption = mkNumericSum 0uy - let floatSumOption = mkNumericSum 0.0 - let float32SumOption = mkNumericSum 0f + let intSumOption = createOptionSumPair 0 + let byteSumOption = createOptionSumPair 0uy + let floatSumOption = createOptionSumPair 0.0 + let float32SumOption = createOptionSumPair 0f - let boolSumAtLeastOne = - <@ fun (_: AtLeastOne) -> Some true @> + let boolSumOption = createOptionPair false <@ (||) @> (||) - let intSumAtLeastOne = mkNumericSumAtLeastOne 0 - let byteSumAtLeastOne = mkNumericSumAtLeastOne 0uy - let floatSumAtLeastOne = mkNumericSumAtLeastOne 0.0 - let float32SumAtLeastOne = mkNumericSumAtLeastOne 0f + let inline createOptionMulPair zero = createOptionPair zero <@ (*) @> (*) - let boolMulOption = - <@ fun (x: bool option) (y: bool option) -> - let mutable res = false + let intMulOption = createOptionMulPair 0 + let byteMulOption = createOptionMulPair 0uy + let floatMulOption = createOptionMulPair 0.0 + let float32MulOption = createOptionMulPair 0f - match x, y with - | Some _, Some _ -> res <- true - | _ -> () + let boolMulOption = createOptionPair true <@ (&&) @> (&&) - if res then Some true else None @> + let inline atLeastOneBinOpQ zero binOp = + Convert.optionToAtLeastOne <| optionBinOpQ zero binOp - let inline mulLeftConst zero constant = - mkUnaryOp zero <@ fun x -> constant * x @> + let inline atLeastOneBinOp zero binOp = + let optionOp = optionBinOp zero binOp + // convert AtLeastOne -> Option + function + | Both (left, right) -> optionOp (Some left) (Some right) + | Left left -> optionOp (Some left) None + | Right right -> optionOp None (Some right) - let inline mulRightConst zero constant = - mkUnaryOp zero <@ fun x -> x * constant @> + let inline createAtLeastOnePair zero opQ op = + atLeastOneBinOpQ zero opQ, atLeastOneBinOp zero op + + let inline createAtLeastOneSumPair zero = createAtLeastOnePair zero <@ (+) @> (+) - let intMulOption = mkNumericMul 0 - let byteMulOption = mkNumericMul 0uy - let floatMulOption = mkNumericMul 0.0 - let float32MulOption = mkNumericMul 0f + let intSumAtLeastOne = createAtLeastOneSumPair 0 + let byteSumAtLeastOne = createAtLeastOneSumPair 0uy + let floatSumAtLeastOne = createAtLeastOneSumPair 0.0 + let float32SumAtLeastOne = createAtLeastOneSumPair 0f - let boolMulAtLeastOne = - <@ fun (values: AtLeastOne) -> - let mutable res = false + let boolSumAtLeastOne = createAtLeastOnePair false <@ (||) @> (||) - match values with - | Both _ -> res <- true - | _ -> () + let inline createAtLeastOneMulPair zero = createAtLeastOnePair zero <@ (*) @> (*) - if res then Some true else None @> + let intMulAtLeastOne = createAtLeastOneMulPair 0 + let byteMulAtLeastOne = createAtLeastOneMulPair 0uy + let floatMulAtLeastOne = createAtLeastOneMulPair 0.0 + let float32MulAtLeastOne = createAtLeastOneMulPair 0f - let intMulAtLeastOne = mkNumericMulAtLeastOne 0 - let byteMulAtLeastOne = mkNumericMulAtLeastOne 0uy - let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 - let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f + let boolMulAtLeastOne = createAtLeastOnePair true <@ (&&) @> (&&) let notOption = <@ fun x -> @@ -127,6 +111,7 @@ module ArithmeticOperations = | Some true -> None | _ -> Some true @> + // unwrapped operands let inline private binOpQ zero op = <@ fun (left: 'a) (right: 'a) -> let result = (%op) left right diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs index d779ba5a..ce73ed5e 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs @@ -12,6 +12,13 @@ module Convert = | Some left, None -> (%op) (Left left) | None, None -> None @> + let optionToAtLeastOne (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (item: AtLeastOne<'a, 'b>) -> + match item with + | Both (left, right) -> (%op) (Some left) (Some right) + | Left left -> (%op) (Some left) None + | Right right -> (%op) None (Some right) @> + let assignToOption (op: Expr<'a option -> 'a option -> 'a option>) = <@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> match rightItem with diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 64400aa6..8a4a7b11 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -49,6 +49,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 637ca279..e90d3a1f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,100 +2,100 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Map.notTests - Matrix.Map.addTests - Matrix.Map.mulTests - Matrix.SpGeMM.Expand.generalTests - Matrix.SpGeMM.Masked.tests - Matrix.Transpose.tests - Matrix.RowsLengths.tests ] - |> testSequenced - -let commonTests = - let scanTests = - testList - "Scan" - [ Common.Scan.ByKey.sequentialSegmentsTests - Common.Scan.PrefixSum.tests ] - - let reduceTests = - testList - "Reduce" - [ Common.Reduce.ByKey.allTests - Common.Reduce.Reduce.tests - Common.Reduce.Sum.tests ] - - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests - Common.ClArray.ChunkBySize.allTests - Common.ClArray.Assign.tests - Common.ClArray.Concat.tests - Common.ClArray.Fill.tests - Common.ClArray.Pairwise.tests ] - - let sortTests = - testList - "Sort" - [ Common.Sort.Bitonic.tests - Common.Sort.Radix.allTests ] - - testList - "Common tests" - [ clArrayTests - sortTests - reduceTests - scanTests - Common.Scatter.tests ] - |> testSequenced - -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced - -[] -let allTests = - testList - "All tests" - [ matrixTests - commonTests - vectorTests - algorithmsTests ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Map.notTests +// Matrix.Map.addTests +// Matrix.Map.mulTests +// Matrix.SpGeMM.Expand.generalTests +// Matrix.SpGeMM.Masked.tests +// Matrix.Transpose.tests +// Matrix.RowsLengths.tests ] +// |> testSequenced +// +// let commonTests = +// let scanTests = +// testList +// "Scan" +// [ Common.Scan.ByKey.sequentialSegmentsTests +// Common.Scan.PrefixSum.tests ] +// +// let reduceTests = +// testList +// "Reduce" +// [ Common.Reduce.ByKey.allTests +// Common.Reduce.Reduce.tests +// Common.Reduce.Sum.tests ] +// +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.tests +// Common.ClArray.ChunkBySize.allTests +// Common.ClArray.Assign.tests +// Common.ClArray.Concat.tests +// Common.ClArray.Fill.tests +// Common.ClArray.Pairwise.tests ] +// +// let sortTests = +// testList +// "Sort" +// [ Common.Sort.Bitonic.tests +// Common.Sort.Radix.allTests ] +// +// testList +// "Common tests" +// [ clArrayTests +// sortTests +// reduceTests +// scanTests +// Common.Scatter.tests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced +// +// [] +// let allTests = +// testList +// "All tests" +// [ matrixTests +// commonTests +// vectorTests +// algorithmsTests ] +// |> testSequenced [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = Matrix.Transpose.tests |> testSequenced |> runTestsWithCLIArgs [] argv diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map.fs new file mode 100644 index 00000000..b2ae3165 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map.fs @@ -0,0 +1,61 @@ +module GraphBLAS.FSharp.Tests.Vector.Map + +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Tests +open Expecto +open Expecto.Logging +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests +open Context +open TestCases +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Vector +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClVectorExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Quotes + +let processor = Context.defaultContext.Queue + +let context = Context.defaultContext.ClContext + + +let config = Utils.defaultConfig + +let makeTest<'a> op isEqual zero testFun (array: 'a []) = + + let vector = Vector.Sparse.FromArray(array, isEqual zero) + + if vector.NNZ > 0 then + let clVector = vector.ToDevice context + + let (clActual: ClVector.Sparse<'a>) = + testFun processor HostInterop clVector + + let actual = clActual.ToHost processor + + let expectedIndices, expectedValues = + array + // apply op + |> Array.map (fun item -> + if isEqual zero item then None else op <| Some item) + // Dense to Sparse + |> Array.mapi (fun index -> function + | Some value -> Some (index, value) + | None -> None) + |> Array.choose id + |> Array.unzip + + "Indices must be the same" + |> Utils.compareArrays (=) actual.Indices expectedIndices + + "Values must be the same" + |> Utils.compareArrays isEqual actual.Values expectedValues + +let createTest<'a when 'a : struct and 'a : equality> isEqual (zero: 'a) (opQ, op) = + Vector.Sparse.Map.run context Utils.defaultWorkGroupSize opQ + |> makeTest<'a> op isEqual zero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) 0 ] From 244155862509b2edf0d68503adfe180af4d3759e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 21 Apr 2023 15:27:21 +0300 Subject: [PATCH 082/143] refactor: formatting --- .../GraphBLAS-sharp.Backend.fsproj | 44 ++-- .../Quotes/Arithmetic.fs | 139 +++++++------ src/GraphBLAS-sharp.Backend/Quotes/Convert.fs | 7 - src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 17 +- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 42 ++-- tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 50 ++--- .../Matrix/SpGeMM/Expand.fs | 8 +- .../GraphBLAS-sharp.Tests/Matrix/Transpose.fs | 43 ++-- tests/GraphBLAS-sharp.Tests/Program.fs | 190 +++++++++--------- tests/GraphBLAS-sharp.Tests/Vector/Map.fs | 27 ++- 11 files changed, 295 insertions(+), 274 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 88732c3e..cc3db014 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -19,8 +19,8 @@ - + @@ -35,27 +35,27 @@ - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index f3cee370..5e0ba6c4 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -3,8 +3,7 @@ open GraphBLAS.FSharp.Backend.Objects module ArithmeticOperations = - // unary - let inline optionUnOp zero unaryOp = + let inline mkUnaryOp zero unaryOp = <@ fun x -> let mutable res = zero @@ -14,96 +13,113 @@ module ArithmeticOperations = if res = zero then None else Some res @> - let inline addLeftConst zero constant = - optionUnOp zero <@ fun x -> constant + x @> + let inline mkNumericSum zero = + <@ fun (x: 't option) (y: 't option) -> + let mutable res = zero - let inline addRightConst zero constant = - optionUnOp zero <@ fun x -> x + constant @> + match x, y with + | Some f, Some s -> res <- f + s + | Some f, None -> res <- f + | None, Some s -> res <- s + | None, None -> () - let inline mulLeftConst zero constant = - optionUnOp zero <@ fun x -> constant * x @> + if res = zero then None else Some res @> - let inline mulRightConst zero constant = - optionUnOp zero <@ fun x -> x * constant @> + let inline mkNumericSumAtLeastOne zero = + <@ fun (values: AtLeastOne<'t, 't>) -> + let mutable res = zero + + match values with + | Both (f, s) -> res <- f + s + | Left f -> res <- f + | Right s -> res <- s - // binary + if res = zero then None else Some res @> - let inline optionBinOpQ zero binOp = - <@ fun (x: 'a option) (y: 'a option) -> + let inline mkNumericMul zero = + <@ fun (x: 't option) (y: 't option) -> let mutable res = zero match x, y with - | Some f, Some s -> res <- (%binOp) f s - | Some f, None -> res <- f - | None, Some s -> res <- s - | None, None -> () + | Some f, Some s -> res <- f * s + | _ -> () if res = zero then None else Some res @> - let inline optionBinOp zero binOp = - fun (x: 'a option) (y: 'a option) -> + let inline mkNumericMulAtLeastOne zero = + <@ fun (values: AtLeastOne<'t, 't>) -> let mutable res = zero + match values with + | Both (f, s) -> res <- f * s + | _ -> () + + if res = zero then None else Some res @> + + let boolSum = + <@ fun (x: bool option) (y: bool option) -> + let mutable res = false + match x, y with - | Some left, Some right -> res <- binOp left right - | Some left, None -> res <- left - | None, Some right -> res <- right | None, None -> () + | _ -> res <- true - if res = zero then None else Some res + if res then Some true else None @> - let createOptionPair zero opQ op = - optionBinOpQ zero opQ, optionBinOp zero op - - let inline createOptionSumPair zero = createOptionPair zero <@ (+) @> (+) + let inline addLeftConst zero constant = + mkUnaryOp zero <@ fun x -> constant + x @> - let intSumOption = createOptionSumPair 0 - let byteSumOption = createOptionSumPair 0uy - let floatSumOption = createOptionSumPair 0.0 - let float32SumOption = createOptionSumPair 0f + let inline addRightConst zero constant = + mkUnaryOp zero <@ fun x -> x + constant @> - let boolSumOption = createOptionPair false <@ (||) @> (||) + let intSumOption = mkNumericSum 0 + let byteSumOption = mkNumericSum 0uy + let floatSumOption = mkNumericSum 0.0 + let float32SumOption = mkNumericSum 0f - let inline createOptionMulPair zero = createOptionPair zero <@ (*) @> (*) + let boolSumAtLeastOne = + <@ fun (_: AtLeastOne) -> Some true @> - let intMulOption = createOptionMulPair 0 - let byteMulOption = createOptionMulPair 0uy - let floatMulOption = createOptionMulPair 0.0 - let float32MulOption = createOptionMulPair 0f + let intSumAtLeastOne = mkNumericSumAtLeastOne 0 + let byteSumAtLeastOne = mkNumericSumAtLeastOne 0uy + let floatSumAtLeastOne = mkNumericSumAtLeastOne 0.0 + let float32SumAtLeastOne = mkNumericSumAtLeastOne 0f - let boolMulOption = createOptionPair true <@ (&&) @> (&&) + let boolMulOption = + <@ fun (x: bool option) (y: bool option) -> + let mutable res = false - let inline atLeastOneBinOpQ zero binOp = - Convert.optionToAtLeastOne <| optionBinOpQ zero binOp + match x, y with + | Some _, Some _ -> res <- true + | _ -> () - let inline atLeastOneBinOp zero binOp = - let optionOp = optionBinOp zero binOp - // convert AtLeastOne -> Option - function - | Both (left, right) -> optionOp (Some left) (Some right) - | Left left -> optionOp (Some left) None - | Right right -> optionOp None (Some right) + if res then Some true else None @> - let inline createAtLeastOnePair zero opQ op = - atLeastOneBinOpQ zero opQ, atLeastOneBinOp zero op + let inline mulLeftConst zero constant = + mkUnaryOp zero <@ fun x -> constant * x @> - let inline createAtLeastOneSumPair zero = createAtLeastOnePair zero <@ (+) @> (+) + let inline mulRightConst zero constant = + mkUnaryOp zero <@ fun x -> x * constant @> - let intSumAtLeastOne = createAtLeastOneSumPair 0 - let byteSumAtLeastOne = createAtLeastOneSumPair 0uy - let floatSumAtLeastOne = createAtLeastOneSumPair 0.0 - let float32SumAtLeastOne = createAtLeastOneSumPair 0f + let intMulOption = mkNumericMul 0 + let byteMulOption = mkNumericMul 0uy + let floatMulOption = mkNumericMul 0.0 + let float32MulOption = mkNumericMul 0f - let boolSumAtLeastOne = createAtLeastOnePair false <@ (||) @> (||) + let boolMulAtLeastOne = + <@ fun (values: AtLeastOne) -> + let mutable res = false - let inline createAtLeastOneMulPair zero = createAtLeastOnePair zero <@ (*) @> (*) + match values with + | Both _ -> res <- true + | _ -> () - let intMulAtLeastOne = createAtLeastOneMulPair 0 - let byteMulAtLeastOne = createAtLeastOneMulPair 0uy - let floatMulAtLeastOne = createAtLeastOneMulPair 0.0 - let float32MulAtLeastOne = createAtLeastOneMulPair 0f + if res then Some true else None @> - let boolMulAtLeastOne = createAtLeastOnePair true <@ (&&) @> (&&) + let intMulAtLeastOne = mkNumericMulAtLeastOne 0 + let byteMulAtLeastOne = mkNumericMulAtLeastOne 0uy + let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 + let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f let notOption = <@ fun x -> @@ -111,7 +127,6 @@ module ArithmeticOperations = | Some true -> None | _ -> Some true @> - // unwrapped operands let inline private binOpQ zero op = <@ fun (left: 'a) (right: 'a) -> let result = (%op) left right diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs index ce73ed5e..d779ba5a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs @@ -12,13 +12,6 @@ module Convert = | Some left, None -> (%op) (Left left) | None, None -> None @> - let optionToAtLeastOne (op: Expr<'a option -> 'b option -> 'c option>) = - <@ fun (item: AtLeastOne<'a, 'b>) -> - match item with - | Both (left, right) -> (%op) (Some left) (Some right) - | Left left -> (%op) (Some left) None - | Right right -> (%op) None (Some right) @> - let assignToOption (op: Expr<'a option -> 'a option -> 'a option>) = <@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> match rightItem with diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index 658f2876..6e3620cf 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -18,7 +18,7 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 8a4a7b11..b397735d 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -25,11 +25,11 @@ - - - - - + + + + + @@ -37,10 +37,6 @@ - - - - @@ -49,7 +45,6 @@ - @@ -57,7 +52,7 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index b89042a4..cb5b7e51 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -59,33 +59,35 @@ let correctnessGenericTest (case: OperationCase) (matrix: 'a [,]) = + match case.Format with + | LIL -> () + | _ -> + let mtx = + Utils.createMatrixFromArray2D case.Format matrix (isEqual zero) - let mtx = - Utils.createMatrixFromArray2D case.Format matrix (isEqual zero) + if mtx.NNZ > 0 then + try + let m = mtx.ToDevice case.TestContext.ClContext - if mtx.NNZ > 0 then - try - let m = mtx.ToDevice case.TestContext.ClContext + let res = addFun q HostInterop m - let res = addFun q HostInterop m + m.Dispose q - m.Dispose q + let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res + let actual = cooRes.ToHost q - let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res - let actual = cooRes.ToHost q + cooRes.Dispose q + res.Dispose q - cooRes.Dispose q - res.Dispose q + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - checkResult isEqual op zero matrix actual - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual op zero matrix actual + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let getCorrectnessTestName = getCorrectnessTestName case diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index ae5e0e22..9c1fdf6e 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -59,39 +59,41 @@ let correctnessGenericTest (case: OperationCase) (leftMatrix: 'a [,], rightMatrix: 'a [,]) = + match case.Format with // TODO(map2 on LIL) + | LIL -> () + | _ -> + let mtx1 = + Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) - let mtx1 = - Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) + let mtx2 = + Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) - let mtx2 = - Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) + if mtx1.NNZ > 0 && mtx2.NNZ > 0 then + try + let m1 = mtx1.ToDevice case.TestContext.ClContext - if mtx1.NNZ > 0 && mtx2.NNZ > 0 then - try - let m1 = mtx1.ToDevice case.TestContext.ClContext + let m2 = mtx2.ToDevice case.TestContext.ClContext - let m2 = mtx2.ToDevice case.TestContext.ClContext + let res = addFun q HostInterop m1 m2 - let res = addFun q HostInterop m1 m2 + m1.Dispose q + m2.Dispose q - m1.Dispose q - m2.Dispose q + let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res + let actual = cooRes.ToHost q - let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res - let actual = cooRes.ToHost q + cooRes.Dispose q + res.Dispose q - cooRes.Dispose q - res.Dispose q + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - checkResult isEqual op zero leftMatrix rightMatrix actual - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual op zero leftMatrix rightMatrix actual + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = let getCorrectnessTestName = getCorrectnessTestName case diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index bf946e4f..3081f342 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -198,6 +198,8 @@ let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftAr if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + printfn $"left matrix rows count: %A{leftMatrix.RowCount}" + let clLeftMatrix = leftMatrix.ToDevice context let clRightMatrix = rightMatrix.ToDevice context @@ -220,7 +222,11 @@ let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftAr let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ |> makeGeneralTest<'a> zero isEqual opMul opAdd - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + |> testPropertyWithConfig + { config with + endSize = 1000 + maxTest = 2 } + $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs index fadc30df..01e78bf7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs @@ -80,26 +80,29 @@ let checkResult areEqual zero actual (expected2D: 'a [,]) = | _ -> () // TODO() let makeTestRegular context q transposeFun hostTranspose isEqual zero case (array: 'a [,]) = - let mtx = - Utils.createMatrixFromArray2D case.Format array (isEqual zero) - - if mtx.NNZ > 0 then - let actual = - let m = mtx.ToDevice context - let (mT: ClMatrix<'a>) = transposeFun q HostInterop m - let res = mT.ToHost q - m.Dispose q - mT.Dispose q - res - - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) - - let expected2D = hostTranspose array - - checkResult isEqual zero actual expected2D + match case.Format with + | LIL -> () + | _ -> + let mtx = + Utils.createMatrixFromArray2D case.Format array (isEqual zero) + + if mtx.NNZ > 0 then + let actual = + let m = mtx.ToDevice context + let (mT: ClMatrix<'a>) = transposeFun q HostInterop m + let res = mT.ToHost q + m.Dispose q + mT.Dispose q + res + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) + + let expected2D = hostTranspose array + + checkResult isEqual zero actual expected2D let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = let context = case.TestContext.ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index e90d3a1f..637ca279 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,100 +2,100 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Map.notTests -// Matrix.Map.addTests -// Matrix.Map.mulTests -// Matrix.SpGeMM.Expand.generalTests -// Matrix.SpGeMM.Masked.tests -// Matrix.Transpose.tests -// Matrix.RowsLengths.tests ] -// |> testSequenced -// -// let commonTests = -// let scanTests = -// testList -// "Scan" -// [ Common.Scan.ByKey.sequentialSegmentsTests -// Common.Scan.PrefixSum.tests ] -// -// let reduceTests = -// testList -// "Reduce" -// [ Common.Reduce.ByKey.allTests -// Common.Reduce.Reduce.tests -// Common.Reduce.Sum.tests ] -// -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.tests -// Common.ClArray.ChunkBySize.allTests -// Common.ClArray.Assign.tests -// Common.ClArray.Concat.tests -// Common.ClArray.Fill.tests -// Common.ClArray.Pairwise.tests ] -// -// let sortTests = -// testList -// "Sort" -// [ Common.Sort.Bitonic.tests -// Common.Sort.Radix.allTests ] -// -// testList -// "Common tests" -// [ clArrayTests -// sortTests -// reduceTests -// scanTests -// Common.Scatter.tests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced -// -// [] -// let allTests = -// testList -// "All tests" -// [ matrixTests -// commonTests -// vectorTests -// algorithmsTests ] -// |> testSequenced +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Map.notTests + Matrix.Map.addTests + Matrix.Map.mulTests + Matrix.SpGeMM.Expand.generalTests + Matrix.SpGeMM.Masked.tests + Matrix.Transpose.tests + Matrix.RowsLengths.tests ] + |> testSequenced + +let commonTests = + let scanTests = + testList + "Scan" + [ Common.Scan.ByKey.sequentialSegmentsTests + Common.Scan.PrefixSum.tests ] + + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.allTests + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] + + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.tests + Common.ClArray.ChunkBySize.allTests + Common.ClArray.Assign.tests + Common.ClArray.Concat.tests + Common.ClArray.Fill.tests + Common.ClArray.Pairwise.tests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.allTests ] + + testList + "Common tests" + [ clArrayTests + sortTests + reduceTests + scanTests + Common.Scatter.tests ] + |> testSequenced + +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced + +[] +let allTests = + testList + "All tests" + [ matrixTests + commonTests + vectorTests + algorithmsTests ] + |> testSequenced [] -let main argv = Matrix.Transpose.tests |> testSequenced |> runTestsWithCLIArgs [] argv +let main argv = allTests |> runTestsWithCLIArgs [] argv diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map.fs index b2ae3165..7d9a74e6 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map.fs @@ -24,25 +24,31 @@ let config = Utils.defaultConfig let makeTest<'a> op isEqual zero testFun (array: 'a []) = - let vector = Vector.Sparse.FromArray(array, isEqual zero) + let vector = + Vector.Sparse.FromArray(array, isEqual zero) if vector.NNZ > 0 then let clVector = vector.ToDevice context - let (clActual: ClVector.Sparse<'a>) = - testFun processor HostInterop clVector + let (clActual: ClVector.Sparse<'a>) = testFun processor HostInterop clVector let actual = clActual.ToHost processor let expectedIndices, expectedValues = array // apply op - |> Array.map (fun item -> - if isEqual zero item then None else op <| Some item) + |> Array.map + (fun item -> + if isEqual zero item then + None + else + op <| Some item) // Dense to Sparse - |> Array.mapi (fun index -> function - | Some value -> Some (index, value) - | None -> None) + |> Array.mapi + (fun index -> + function + | Some value -> Some(index, value) + | None -> None) |> Array.choose id |> Array.unzip @@ -52,10 +58,9 @@ let makeTest<'a> op isEqual zero testFun (array: 'a []) = "Values must be the same" |> Utils.compareArrays isEqual actual.Values expectedValues -let createTest<'a when 'a : struct and 'a : equality> isEqual (zero: 'a) (opQ, op) = +let createTest<'a when 'a: struct and 'a: equality> isEqual (zero: 'a) (opQ, op) = Vector.Sparse.Map.run context Utils.defaultWorkGroupSize opQ |> makeTest<'a> op isEqual zero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" -let tests = - [ createTest (=) 0 ] +let tests = [ createTest (=) 0 ] From abdd46ccd3c569699d343966d303873390fecd3a Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 21 Apr 2023 15:44:44 +0300 Subject: [PATCH 083/143] refactor: ... --- .../GraphBLAS-sharp.Backend.fsproj | 3 +- .../Vector/Sparse/Map.fs | 138 ------------------ tests/GraphBLAS-sharp.Tests/Vector/Map.fs | 66 --------- 3 files changed, 1 insertion(+), 206 deletions(-) delete mode 100644 src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs delete mode 100644 tests/GraphBLAS-sharp.Tests/Vector/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index cc3db014..2ccc939f 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -30,7 +30,7 @@ - + @@ -39,7 +39,6 @@ - diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs deleted file mode 100644 index 08b706c5..00000000 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ /dev/null @@ -1,138 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.Vector.Sparse - -open Brahma.FSharp -open Microsoft.FSharp.Control -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ClVector -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Backend.Quotes -open FSharp.Quotations -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open GraphBLAS.FSharp.Backend.Objects.ClCell -open GraphBLAS.FSharp.Backend.Common - -module internal Map = - let private preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = - // we can decrease memory requirements by two pass map (like choose) - let preparePositions (op: Expr<'a option -> 'b option>) = - <@ fun (ndRange: Range1D) dataLength vectorLength (values: ClArray<'a>) (indices: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultIndices: ClArray) -> - - let gid = ndRange.GlobalID0 - - if gid < vectorLength then - - let value = - (%Search.Bin.byKey) dataLength gid indices values - - match (%op) value with - | Some resultValue -> - resultValues.[gid] <- resultValue - resultIndices.[gid] <- gid - - resultBitmap.[gid] <- 1 - | None -> resultBitmap.[gid] <- 0 @> - - let kernel = - clContext.Compile <| preparePositions opAdd - - fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> - - let resultBitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) - - let resultIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, vector.Size) - - let ndRange = - Range1D.CreateValid(vector.Size, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vector.Values.Length - vector.Size - vector.Values - vector.Indices - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - resultBitmap, resultValues, resultIndices - - let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'a option -> 'b option>) - = - - let preparePositions = - preparePositions clContext workGroupSize opAdd - - let setPositions = - Common.setPositions<'b> clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> - - let bitmap, values, indices = preparePositions queue vector - - let resultValues, resultIndices = - setPositions queue allocationMode values indices bitmap - - bitmap.Free queue - values.Free queue - indices.Free queue - - { Context = clContext - Indices = resultIndices - Values = resultValues - Size = vector.Size } - - module OnlySome = - let run (clContext: ClContext) workGroupSize op = - - let getOptionBitmap = - ClArray.map clContext workGroupSize - <| Map.chooseBitmap op - - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize - - let scatter = - Scatter.lastOccurrence clContext workGroupSize - - let setOption = - ClArray.assignOption clContext workGroupSize op - - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> - - let bitmap = - getOptionBitmap processor DeviceOnly vector.Values - - let resultLength = - (prefixSum processor bitmap) - .ToHostAndFree processor - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - - setOption processor vector.Values bitmap resultValues - - let resultIndices = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - - scatter processor vector.Indices bitmap resultIndices - - { Context = clContext - Indices = resultIndices - Values = resultValues - Size = vector.Size } diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map.fs deleted file mode 100644 index 7d9a74e6..00000000 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map.fs +++ /dev/null @@ -1,66 +0,0 @@ -module GraphBLAS.FSharp.Tests.Vector.Map - -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Tests -open Expecto -open Expecto.Logging -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Tests -open Context -open TestCases -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Vector -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Objects.ClVectorExtensions -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Backend.Quotes - -let processor = Context.defaultContext.Queue - -let context = Context.defaultContext.ClContext - - -let config = Utils.defaultConfig - -let makeTest<'a> op isEqual zero testFun (array: 'a []) = - - let vector = - Vector.Sparse.FromArray(array, isEqual zero) - - if vector.NNZ > 0 then - let clVector = vector.ToDevice context - - let (clActual: ClVector.Sparse<'a>) = testFun processor HostInterop clVector - - let actual = clActual.ToHost processor - - let expectedIndices, expectedValues = - array - // apply op - |> Array.map - (fun item -> - if isEqual zero item then - None - else - op <| Some item) - // Dense to Sparse - |> Array.mapi - (fun index -> - function - | Some value -> Some(index, value) - | None -> None) - |> Array.choose id - |> Array.unzip - - "Indices must be the same" - |> Utils.compareArrays (=) actual.Indices expectedIndices - - "Values must be the same" - |> Utils.compareArrays isEqual actual.Values expectedValues - -let createTest<'a when 'a: struct and 'a: equality> isEqual (zero: 'a) (opQ, op) = - Vector.Sparse.Map.run context Utils.defaultWorkGroupSize opQ - |> makeTest<'a> op isEqual zero - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -let tests = [ createTest (=) 0 ] From 7bdaf88ada05931d439c6ea7f23fb0391fa73644 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 21 Apr 2023 15:52:15 +0300 Subject: [PATCH 084/143] refactor: include gather tests --- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 637ca279..e2351bab 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -43,7 +43,7 @@ let commonTests = Common.ClArray.Map.tests Common.ClArray.Map2.addTests Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests + Common.ClArray.Choose.allTests Common.ClArray.ChunkBySize.allTests Common.ClArray.Assign.tests Common.ClArray.Concat.tests @@ -62,7 +62,8 @@ let commonTests = sortTests reduceTests scanTests - Common.Scatter.tests ] + Common.Scatter.allTests + Common.Gather.allTests ] |> testSequenced let vectorTests = From ad66391ccea97663361c0f4f4498e770871a57ff Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Apr 2023 00:41:13 +0300 Subject: [PATCH 085/143] refactor: ClArray.assign -> *.blit --- README.md | 15 +++--- src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs | 4 +- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 52 +++++++++++-------- .../GraphBLAS-sharp.Backend.fsproj | 4 +- .../Matrix/COO/Matrix.fs | 7 +-- .../Matrix/CSR/Map2AtLeastOne.fs | 9 ++-- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 4 +- .../Dense/{DenseVector.fs => Vector.fs} | 8 +-- .../Sparse/{SparseVector.fs => Vector.fs} | 2 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 24 ++++----- .../Common/ClArray/{Assign.fs => Blit.fs} | 14 ++--- tests/GraphBLAS-sharp.Tests/Generators.fs | 14 +++-- .../GraphBLAS-sharp.Tests.fsproj | 2 +- .../Matrix/SpGeMM/Expand.fs | 2 - tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 15 files changed, 88 insertions(+), 75 deletions(-) rename src/GraphBLAS-sharp.Backend/Vector/Dense/{DenseVector.fs => Vector.fs} (96%) rename src/GraphBLAS-sharp.Backend/Vector/Sparse/{SparseVector.fs => Vector.fs} (99%) rename tests/GraphBLAS-sharp.Tests/Common/ClArray/{Assign.fs => Blit.fs} (71%) diff --git a/README.md b/README.md index 964b619f..87c72287 100644 --- a/README.md +++ b/README.md @@ -25,23 +25,24 @@ GraphBLAS# is a GPGPU-based [GraphBLAS](https://graphblas.org/)-like API impleme ### Operations - **Matrix-Matrix** - - [x] COO-COO element-wize - - [x] CSR-CSR element-wize - - [ ] CSR-CSR multiplication - - [ ] COO transpose - - [ ] CSR transpose + - [x] COO-COO `map2` + - [x] CSR-CSR `map2` + - [x] CSR-CSR multiplication - **Vector-Matrix** - [x] Dense-CSR multiplication - [ ] COO-CSR multiplication - **Vector-Vector** - [x] Dense-Dense element-wise + - [x] Sparse-Sparse element-wise - [ ] ... - **Matrix** - - [ ] `map` + - [x] `map` + - [x] COO transpose + - [x] CSR transpose - [ ] `iter` - [ ] ... - **Vector** - - [ ] `map` + - [x] `map` - [ ] `iter` - [ ] `filter` - [ ] `contains` diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs index 4dbb9ba4..2a38c25c 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs @@ -29,10 +29,10 @@ module BFS = let ofList = Vector.ofList clContext workGroupSize let maskComplementedTo = - DenseVector.map2Inplace clContext Mask.complementedOp workGroupSize + Vector.map2InPlace clContext Mask.complementedOp workGroupSize let fillSubVectorTo = - DenseVector.assignByMaskInplace clContext (Convert.assignToOption Mask.assign) workGroupSize + Vector.assignByMaskInPlace clContext (Convert.assignToOption Mask.assign) workGroupSize let containsNonZero = ClArray.exists clContext workGroupSize Predicates.isSome diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 211984f5..e784280e 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -559,43 +559,53 @@ module ClArray = |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray - let assign<'a> (clContext: ClContext) workGroupSize = + let blit<'a> (clContext: ClContext) workGroupSize = let assign = - <@ fun (ndRange: Range1D) targetPosition sourceArrayLength (sourceArray: ClArray<'a>) (targetArray: ClArray<'a>) -> + <@ fun (ndRange: Range1D) sourceIndex (sourceArray: ClArray<'a>) (targetArray: ClArray<'a>) targetPosition count -> let gid = ndRange.GlobalID0 - let resultPosition = gid + targetPosition - - if gid < sourceArrayLength then + if gid < count then + let readPosition = gid + sourceIndex + let writePosition = gid + targetPosition - targetArray.[resultPosition] <- sourceArray.[gid] @> + targetArray.[writePosition] <- sourceArray.[readPosition] @> let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) targetPosition (targetArray: ClArray<'a>) -> - if targetPosition < 0 then - failwith "The starting position cannot be less than zero" + fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> + // check count + if count < 0 then failwith "Count must be greater than zero" - if targetPosition + sourceArray.Length > targetArray.Length then - failwith "The array should fit completely" + // check sourceIndex + if sourceIndex < 0 + && sourceIndex + count >= sourceArray.Length + then failwith "The source index does not match" - let ndRange = - Range1D.CreateValid(targetArray.Length, workGroupSize) + // check targetPosition + if targetIndex < 0 + && targetIndex + count >= targetArray.Length + then failwith "The target index does not match" - let kernel = kernel.GetKernel() + if count = 0 then () + // nothing to do + else + let ndRange = + Range1D.CreateValid(targetArray.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange targetPosition sourceArray.Length sourceArray targetArray) - ) + let kernel = kernel.GetKernel() - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange sourceIndex sourceArray targetArray targetIndex count) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let concat (clContext: ClContext) workGroupSize = - let assign = assign clContext workGroupSize + let blit = blit clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (sourceArrays: ClArray<'a> seq) -> @@ -609,7 +619,7 @@ module ClArray = // write each array to result Seq.fold (fun previousLength (array: ClArray<_>) -> - assign processor array previousLength result + blit processor array 0 result previousLength array.Length previousLength + array.Length) 0 sourceArrays diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 2ccc939f..7102f078 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,11 +35,11 @@ - + - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index 2230f815..0ac34ba4 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -6,6 +6,8 @@ open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Matrix = let map = Map.run @@ -78,8 +80,7 @@ module Matrix = processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowIndices nnz rowPointers)) processor.Post(Msg.CreateRunMsg<_, _> kernel) - let result = scan processor rowPointers nnz - processor.Post <| Msg.CreateFreeMsg(result) + (scan processor rowPointers nnz).Free processor rowPointers @@ -114,7 +115,7 @@ module Matrix = let rowPointers = prepare processor allocationMode matrix.Rows matrix.RowCount - processor.Post(Msg.CreateFreeMsg(matrix.Rows)) + matrix.Rows.Free processor { Context = clContext RowCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs index 3ec0a7be..1f379b0b 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs @@ -9,6 +9,7 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Matrix.COO open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module internal Map2AtLeastOne = let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> @@ -310,8 +311,8 @@ module internal Map2AtLeastOne = let positions, allValues = preparePositions queue allColumns leftMergedValues rightMergedValues isRowEnd isLeft - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + leftMergedValues.Free queue + rightMergedValues.Free queue let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode allRows allColumns allValues positions @@ -338,9 +339,9 @@ module internal Map2AtLeastOne = let elementwiseToCOO = runToCOO clContext opAdd workGroupSize - let toCSRInplace = + let toCSRInPlace = Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> elementwiseToCOO queue allocationMode matrixLeft matrixRight - |> toCSRInplace queue allocationMode + |> toCSRInPlace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index cc2d45ad..69fa630b 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -16,7 +16,7 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize let vectorCopy = - Vector.Sparse.SparseVector.copy clContext workGroupSize + Vector.Sparse.Vector.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -237,7 +237,7 @@ module Matrix = let COOToCSR = COO.Matrix.toCSR clContext workGroupSize let transposeCSR = - CSR.Matrix.transposeInPlace clContext workGroupSize + CSR.Matrix.transpose clContext workGroupSize let CSRToLIL = CSR.Matrix.toLIL clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs similarity index 96% rename from src/GraphBLAS-sharp.Backend/Vector/Dense/DenseVector.fs rename to src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index 3d37a595..813f52f6 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -8,8 +8,8 @@ open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell -module DenseVector = - let map2Inplace<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> +module Vector = + let map2InPlace<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize @@ -40,7 +40,7 @@ module DenseVector = let map2AtLeastOne clContext op workGroupSize = map2 clContext (Convert.atLeastOneToOption op) workGroupSize - let assignByMaskInplace<'a, 'b when 'a: struct and 'b: struct> + let assignByMaskInPlace<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) workGroupSize @@ -77,7 +77,7 @@ module DenseVector = = let assignByMask = - assignByMaskInplace clContext maskOp workGroupSize + assignByMaskInPlace clContext maskOp workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> let resultVector = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs similarity index 99% rename from src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index bf0a9e1a..75cb4d7e 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -8,7 +8,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClVector -module SparseVector = +module Vector = let copy (clContext: ClContext) workGroupSize = let copy = ClArray.copy clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index f28c09ad..97a1ca08 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -5,8 +5,6 @@ open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Vector.Dense -open GraphBLAS.FSharp.Backend.Vector.Sparse open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClVector @@ -80,7 +78,7 @@ module Vector = let copy (clContext: ClContext) workGroupSize = let sparseCopy = - SparseVector.copy clContext workGroupSize + Sparse.Vector.copy clContext workGroupSize let copyOptionData = ClArray.copy clContext workGroupSize @@ -95,7 +93,7 @@ module Vector = let toSparse (clContext: ClContext) workGroupSize = let toSparse = - DenseVector.toSparse clContext workGroupSize + Dense.Vector.toSparse clContext workGroupSize let copy = copy clContext workGroupSize @@ -108,7 +106,7 @@ module Vector = let toDense (clContext: ClContext) workGroupSize = let toDense = - SparseVector.toDense clContext workGroupSize + Sparse.Vector.toDense clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -123,10 +121,10 @@ module Vector = let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = let map2Dense = - DenseVector.map2 clContext opAdd workGroupSize + Dense.Vector.map2 clContext opAdd workGroupSize let map2Sparse = - SparseVector.map2 clContext opAdd workGroupSize + Sparse.Vector.map2 clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with @@ -140,10 +138,10 @@ module Vector = let map2AtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let map2Sparse = - SparseVector.map2AtLeastOne clContext opAdd workGroupSize + Sparse.Vector.map2AtLeastOne clContext opAdd workGroupSize let map2Dense = - DenseVector.map2AtLeastOne clContext opAdd workGroupSize + Dense.Vector.map2AtLeastOne clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with @@ -158,10 +156,10 @@ module Vector = let private assignByMaskGeneral<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = let sparseFillVector = - SparseVector.assignByMask clContext op workGroupSize + Sparse.Vector.assignByMask clContext op workGroupSize let denseFillVector = - DenseVector.assignByMask clContext op workGroupSize + Dense.Vector.assignByMask clContext op workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: ClCell<'a>) -> match vector, mask with @@ -181,10 +179,10 @@ module Vector = let reduce (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) = let sparseReduce = - SparseVector.reduce clContext workGroupSize opAdd + Sparse.Vector.reduce clContext workGroupSize opAdd let denseReduce = - DenseVector.reduce clContext workGroupSize opAdd + Dense.Vector.reduce clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Blit.fs similarity index 71% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs rename to tests/GraphBLAS-sharp.Tests/Common/ClArray/Blit.fs index 092e3cb8..771f3501 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Assign.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Blit.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Assign +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Blit open Expecto open Brahma.FSharp @@ -13,28 +13,28 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } -let makeTest<'a> isEqual testFun (source: 'a [], target: 'a [], targetPosition: int) = +let makeTest<'a> isEqual testFun (source: 'a [], sourceIndex, target: 'a [], targetIndex, count) = if source.Length > 0 && target.Length > 0 then let clSource = context.CreateClArray source let clTarget = context.CreateClArray target - testFun processor clSource targetPosition clTarget + testFun processor clSource sourceIndex clTarget targetIndex count clSource.Free processor let actual = clTarget.ToHostAndFree processor // write to target --- target expected - Array.blit source 0 target targetPosition source.Length + Array.blit source sourceIndex target targetIndex count "Results should be the same" |> Utils.compareArrays isEqual actual target let createTest<'a when 'a: equality> isEqual = - ClArray.assign context Utils.defaultWorkGroupSize + ClArray.blit context Utils.defaultWorkGroupSize |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -46,4 +46,4 @@ let tests = createTest Utils.float32IsEqual createTest (=) ] - |> testList "Assign" + |> testList "Blit" diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 7616b6cd..3b737bcf 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -1012,20 +1012,24 @@ module Generators = arrayAndChunkPosition <| Arb.generate |> Arb.fromGen - type AssignArray() = + type Blit() = static let pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) = gen { - let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (2, size + 2) + let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (0, size) let! targetArray = Gen.arrayOfLength targetArrayLength valuesGenerator - let! sourceArrayLength = Gen.choose (1, targetArrayLength) + let! sourceArrayLength = Gen.sized <| fun size -> Gen.choose (0, size) let! sourceArray = Gen.arrayOfLength sourceArrayLength valuesGenerator - let! startPosition = Gen.choose (0, targetArrayLength - sourceArrayLength) + let! targetIndex = Gen.choose(0, targetArrayLength) - return (sourceArray, targetArray, startPosition) + let! sourceIndex = Gen.choose (0, sourceArrayLength) + + let! count = Gen.choose(0, (min (targetArrayLength - targetIndex) (sourceArrayLength - sourceIndex))) + + return (sourceArray, sourceIndex, targetArray, targetIndex, count) } static member IntType() = diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index b397735d..ef0e76d8 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -26,7 +26,7 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 3081f342..69cda013 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -198,8 +198,6 @@ let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftAr if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - printfn $"left matrix rows count: %A{leftMatrix.RowCount}" - let clLeftMatrix = leftMatrix.ToDevice context let clRightMatrix = rightMatrix.ToDevice context diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index e2351bab..b47ee325 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -45,7 +45,7 @@ let commonTests = Common.ClArray.Map2.mulTests Common.ClArray.Choose.allTests Common.ClArray.ChunkBySize.allTests - Common.ClArray.Assign.tests + Common.ClArray.Blit.tests Common.ClArray.Concat.tests Common.ClArray.Fill.tests Common.ClArray.Pairwise.tests ] From 5b9416061cef30efee7edb3e06e56ec683a48e3b Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Apr 2023 09:48:42 +0300 Subject: [PATCH 086/143] refactor: paths --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 16 +++++++++------- .../GraphBLAS-sharp.Backend.fsproj | 4 ++-- tests/GraphBLAS-sharp.Tests/Generators.fs | 4 ++-- .../GraphBLAS-sharp.Tests.fsproj | 2 +- 4 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index e784280e..54b59062 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -576,20 +576,22 @@ module ClArray = fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> // check count - if count < 0 then failwith "Count must be greater than zero" + if count < 0 then + failwith "Count must be greater than zero" // check sourceIndex if sourceIndex < 0 - && sourceIndex + count >= sourceArray.Length - then failwith "The source index does not match" + && sourceIndex + count >= sourceArray.Length then + failwith "The source index does not match" // check targetPosition if targetIndex < 0 - && targetIndex + count >= targetArray.Length - then failwith "The target index does not match" + && targetIndex + count >= targetArray.Length then + failwith "The target index does not match" - if count = 0 then () - // nothing to do + if count = 0 then + () + // nothing to do else let ndRange = Range1D.CreateValid(targetArray.Length, workGroupSize) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 7102f078..920a06f9 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,11 +35,11 @@ - + - + diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 3b737bcf..738224d5 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -1023,11 +1023,11 @@ module Generators = let! sourceArray = Gen.arrayOfLength sourceArrayLength valuesGenerator - let! targetIndex = Gen.choose(0, targetArrayLength) + let! targetIndex = Gen.choose (0, targetArrayLength) let! sourceIndex = Gen.choose (0, sourceArrayLength) - let! count = Gen.choose(0, (min (targetArrayLength - targetIndex) (sourceArrayLength - sourceIndex))) + let! count = Gen.choose (0, (min (targetArrayLength - targetIndex) (sourceArrayLength - sourceIndex))) return (sourceArray, sourceIndex, targetArray, targetIndex, count) } diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index ef0e76d8..9ea04ea9 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -26,7 +26,7 @@ - + From 9cc2155ec06f6fd70199c9f7afc6e917b744d6c3 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Apr 2023 10:23:20 +0300 Subject: [PATCH 087/143] wip: benchmarks --- .../Algorithms/BenchmarksBFS.fs | 164 ++++++++ .../BenchmarksBFS.fs | 6 +- .../Matrix/BenchmarksEWiseAdd.fs | 307 +++++++++++++++ .../Matrix/BenchmarksMxm.fs | 299 ++++++++++++++ .../Vector/BenchmarksMxv.fs | 77 ++++ .../GraphBLAS-sharp.Benchmarks/Vector/Map2.fs | 211 ++++++++++ src/GraphBLAS-sharp/AlgebraicStructures.fs | 55 --- src/GraphBLAS-sharp/Algorithms/BFS.fs | 38 -- .../Algorithms/BetweennessCentrality.fs | 89 ----- .../Algorithms/ShortestPath.fs | 24 -- .../Algorithms/TriangleCounting.fs | 30 -- src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj | 9 - src/GraphBLAS-sharp/GraphblasEvaluation.fs | 88 ----- src/GraphBLAS-sharp/Objects/Matrix.fs | 94 +++-- src/GraphBLAS-sharp/Operations/Matrix.fs | 371 ------------------ src/GraphBLAS-sharp/Operations/Scalar.fs | 44 --- src/GraphBLAS-sharp/Operations/Vector.fs | 316 --------------- src/GraphBLAS-sharp/Predefined/Monoids/Add.fs | 32 -- src/GraphBLAS-sharp/Predefined/Monoids/Any.fs | 8 - src/GraphBLAS-sharp/Predefined/Monoids/Min.fs | 12 - .../Predefined/Semirings/AddMult.fs | 32 -- .../Predefined/Semirings/AnyAll.fs | 8 - .../Predefined/Semirings/MinAdd.fs | 8 - 23 files changed, 1117 insertions(+), 1205 deletions(-) create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksMxm.fs create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs delete mode 100644 src/GraphBLAS-sharp/AlgebraicStructures.fs delete mode 100644 src/GraphBLAS-sharp/Algorithms/BFS.fs delete mode 100644 src/GraphBLAS-sharp/Algorithms/BetweennessCentrality.fs delete mode 100644 src/GraphBLAS-sharp/Algorithms/ShortestPath.fs delete mode 100644 src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs delete mode 100644 src/GraphBLAS-sharp/GraphblasEvaluation.fs delete mode 100644 src/GraphBLAS-sharp/Operations/Matrix.fs delete mode 100644 src/GraphBLAS-sharp/Operations/Scalar.fs delete mode 100644 src/GraphBLAS-sharp/Operations/Vector.fs delete mode 100644 src/GraphBLAS-sharp/Predefined/Monoids/Add.fs delete mode 100644 src/GraphBLAS-sharp/Predefined/Monoids/Any.fs delete mode 100644 src/GraphBLAS-sharp/Predefined/Monoids/Min.fs delete mode 100644 src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs delete mode 100644 src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs delete mode 100644 src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs new file mode 100644 index 00000000..283cbcc2 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs @@ -0,0 +1,164 @@ +namespace GraphBLAS.FSharp.Benchmarks + +open System.IO +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Attributes +open BenchmarkDotNet.Configs +open BenchmarkDotNet.Columns +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Algorithms +open MatrixExtensions +open ArraysExtensions + +[] +[] +[] +[)>] +type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + let mutable funToBenchmark = None + let mutable matrix = Unchecked.defaultof<'matrixT> + let mutable matrixHost = Unchecked.defaultof<_> + + let source = 0 + + member val ResultVector = Unchecked.defaultof> with get,set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvaliableContexts = Utils.avaliableContexts + + static member InputMatricesProviderBuilder pathToConfig = + let datasetFolder = "" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> + MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.ReadMatrix (reader:MtxReader) = + let converter = + match reader.Field with + | Pattern -> converterBool + | _ -> converter + + reader.ReadMatrix converter + + member this.BFS() = + this.ResultVector <- this.FunToBenchmark this.Processor matrix source + + member this.ClearInputMatrix() = + (matrix :> IDeviceMemObject).Dispose this.Processor + + member this.ClearResult() = + this.ResultVector.FreeAndWait this.Processor + + member this.ReadMatrix() = + let matrixReader = this.InputMatrixReader + matrixHost <- this.ReadMatrix matrixReader + + member this.LoadMatrixToGPU() = + matrix <- buildMatrix this.OclContext matrixHost + + abstract member GlobalSetup : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + + abstract member Benchmark : unit -> unit + +type BFSBenchmarksWithoutDataTransfer() = + + inherit BFSBenchmarks, int>( + (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption wgSize), + int, + (fun _ -> Utils.nextInt (System.Random())), + Matrix.ToBackendCSR) + + static member InputMatricesProvider = + BFSBenchmarks<_,_>.InputMatricesProviderBuilder "BFSBenchmarks.txt" + + [] + override this.GlobalSetup() = + this.ReadMatrix () + this.LoadMatrixToGPU () + + [] + override this.IterationCleanup() = + this.ClearResult() + + [] + override this.GlobalCleanup() = + this.ClearInputMatrix() + + [] + override this.Benchmark() = + this.BFS() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + +type BFSBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix, + resultToHost) = + + inherit BFSBenchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrix() + + [] + override this.GlobalCleanup() = () + + [] + override this.IterationCleanup() = + this.ClearInputMatrix() + this.ClearResult() + + [] + override this.Benchmark() = + this.LoadMatrixToGPU() + this.BFS() + this.Processor.PostAndReply Msg.MsgNotifyMe + let res = resultToHost this.ResultVector this.Processor + this.Processor.PostAndReply Msg.MsgNotifyMe + diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index 283cbcc2..93a52dba 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs @@ -31,7 +31,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : member val ResultVector = Unchecked.defaultof> with get,set - [] + [] member val OclContextInfo = Unchecked.defaultof with get, set [] @@ -45,7 +45,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : p.Error.Add(fun e -> failwithf "%A" e) p - static member AvaliableContexts = Utils.avaliableContexts + static member AvailableContexts = Utils.avaliableContexts static member InputMatricesProviderBuilder pathToConfig = let datasetFolder = "" @@ -159,6 +159,6 @@ type BFSBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemOb this.LoadMatrixToGPU() this.BFS() this.Processor.PostAndReply Msg.MsgNotifyMe - let res = resultToHost this.ResultVector this.Processor + resultToHost this.ResultVector this.Processor this.Processor.PostAndReply Msg.MsgNotifyMe diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs new file mode 100644 index 00000000..18aa2cdd --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs @@ -0,0 +1,307 @@ +namespace GraphBLAS.FSharp.Benchmarks + +open System.IO +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Attributes +open BenchmarkDotNet.Configs +open BenchmarkDotNet.Columns +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Objects.Matrix +open GraphBLAS.FSharp.Benchmarks.MatrixExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +[] +[] +[] +[)>] +type EWiseAddBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + let mutable funToBenchmark = None + let mutable firstMatrix = Unchecked.defaultof<'matrixT> + let mutable secondMatrix = Unchecked.defaultof<'matrixT> + let mutable firstMatrixHost = Unchecked.defaultof<_> + let mutable secondMatrixHost = Unchecked.defaultof<_> + + member val ResultMatrix = Unchecked.defaultof<'matrixT> with get,set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvaliableContexts = Utils.avaliableContexts + + static member InputMatricesProviderBuilder pathToConfig = + let datasetFolder = "EWiseAdd" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> + MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.ReadMatrix (reader:MtxReader) = + let converter = + match reader.Field with + | Pattern -> converterBool + | _ -> converter + + reader.ReadMatrix converter + + member this.EWiseAddition() = + this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix + + member this.ClearInputMatrices() = + (firstMatrix :> IDeviceMemObject).Dispose this.Processor + (secondMatrix :> IDeviceMemObject).Dispose this.Processor + + member this.ClearResult() = + (this.ResultMatrix :> IDeviceMemObject).Dispose this.Processor + + member this.ReadMatrices() = + let leftMatrixReader = fst this.InputMatrixReader + let rightMatrixReader = snd this.InputMatrixReader + firstMatrixHost <- this.ReadMatrix leftMatrixReader + secondMatrixHost <- this.ReadMatrix rightMatrixReader + + member this.LoadMatricesToGPU () = + firstMatrix <- buildMatrix this.OclContext firstMatrixHost + secondMatrix <- buildMatrix this.OclContext secondMatrixHost + + abstract member GlobalSetup : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + + abstract member Benchmark : unit -> unit + +type EWiseAddBenchmarksWithoutDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit EWiseAddBenchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices () + this.LoadMatricesToGPU () + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + [] + override this.Benchmark () = + this.EWiseAddition() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + +type EWiseAddBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix, + resultToHost) = + + inherit EWiseAddBenchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup () = + this.ReadMatrices () + + [] + override this.GlobalCleanup () = () + + [] + override this.IterationCleanup () = + this.ClearInputMatrices() + this.ClearResult() + + [] + override this.Benchmark () = + this.LoadMatricesToGPU() + this.EWiseAddition() + this.Processor.PostAndReply Msg.MsgNotifyMe + let res = resultToHost this.ResultMatrix this.Processor + this.Processor.PostAndReply Msg.MsgNotifyMe + +module M = + let resultToHostCOO (resultMatrix: ClMatrix.COO<'a>) (processor :MailboxProcessor<_>) = + let cols = + let a = Array.zeroCreate resultMatrix.ColumnCount + processor.Post(Msg.CreateToHostMsg<_>(resultMatrix.Columns,a)) + a + let rows = + let a = Array.zeroCreate resultMatrix.RowCount + processor.Post(Msg.CreateToHostMsg(resultMatrix.Rows,a)) + a + let vals = + let a = Array.zeroCreate resultMatrix.Values.Length + processor.Post(Msg.CreateToHostMsg(resultMatrix.Values,a)) + a + { + RowCount = resultMatrix.RowCount + ColumnCount = resultMatrix.ColumnCount + Rows = rows + Columns = cols + Values = vals + } + + +type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.ToBackendCOO + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + +type EWiseAddBenchmarks4Float32COOWithDataTransfer() = + + inherit EWiseAddBenchmarksWithDataTransfer,float32>( + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.ToBackendCOO, + M.resultToHostCOO + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + + +type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.boolSum wgSize), + (fun _ -> true), + (fun _ -> true), + Matrix.ToBackendCOO + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" + + +type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( + (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.ToBackendCSR + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" + + +type EWiseAddBenchmarks4BoolCSRWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( + (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.boolSum wgSize), + (fun _ -> true), + (fun _ -> true), + Matrix.ToBackendCSR + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + +// With AtLeastOne + +type EWiseAddAtLeastOneBenchmarks4BoolCOOWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( + (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), + (fun _ -> true), + (fun _ -> true), + Matrix.ToBackendCOO + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + +type EWiseAddAtLeastOneBenchmarks4BoolCSRWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( + (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), + (fun _ -> true), + (fun _ -> true), + Matrix.ToBackendCSR + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + +type EWiseAddAtLeastOneBenchmarks4Float32COOWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( + (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.ToBackendCOO + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + +type EWiseAddAtLeastOneBenchmarks4Float32CSRWithoutDataTransfer() = + + inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( + (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.ToBackendCSR + ) + + static member InputMatricesProvider = + EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksMxm.fs new file mode 100644 index 00000000..efbe86c9 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksMxm.fs @@ -0,0 +1,299 @@ +namespace GraphBLAS.FSharp.Benchmarks + +open System.IO +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Attributes +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Benchmarks.MatrixExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +[] +[] +[] +[)>] +type MxmBenchmarks<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + let mutable funToBenchmark = None + let mutable funCSR2CSC = None + let mutable funCSC2CSR = None + + let mutable firstMatrix = Unchecked.defaultof> + let mutable secondMatrix = Unchecked.defaultof> + let mutable mask = Unchecked.defaultof> + + let mutable firstMatrixHost = Unchecked.defaultof<_> + let mutable secondMatrixHost = Unchecked.defaultof<_> + let mutable maskHost = Unchecked.defaultof> + + member val ResultMatrix = Unchecked.defaultof> with get, set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvaliableContexts = Utils.avaliableContexts + + static member InputMatrixProviderBuilder pathToConfig = + let datasetFolder = "Mxm" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> + MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.FunCSR2CSC = + match funCSR2CSC with + | None -> + let x = Matrix.toCSCInPlace this.OclContext this.WorkGroupSize + funCSR2CSC <- Some x + x + | Some x -> x + + member this.FunCSC2CSR = + match funCSC2CSR with + | None -> + let x = Matrix.toCSRInPlace this.OclContext this.WorkGroupSize + funCSC2CSR <- Some x + x + | Some x -> x + + member this.ReadMatrix (reader:MtxReader) = + let converter = + match reader.Field with + | Pattern -> converterBool + | _ -> converter + + reader.ReadMatrix converter + + member this.Mxm() = + this.ResultMatrix <- this.FunToBenchmark this.Processor firstMatrix secondMatrix mask + + member this.ClearInputMatrices() = + firstMatrix.Dispose this.Processor + secondMatrix.Dispose this.Processor + mask.Dispose this.Processor + + member this.ClearResult() = + this.ResultMatrix.Dispose this.Processor + + member this.ReadMask(maskReader) = + maskHost <- this.ReadMatrix maskReader + + member this.ReadMatrices() = + let matrixReader, maskReader = this.InputMatrixReader + firstMatrixHost <- this.ReadMatrix matrixReader + secondMatrixHost <- this.ReadMatrix matrixReader + this.ReadMask(maskReader) + + member this.LoadMatricesToGPU () = + firstMatrix <- buildMatrix this.OclContext firstMatrixHost + secondMatrix <- buildMatrix this.OclContext secondMatrixHost + mask <- maskHost.ToDevice this.OclContext + + member this.ConvertSecondMatrixToCSC() = + secondMatrix <- this.FunCSR2CSC this.Processor HostInterop secondMatrix + + member this.ConvertSecondMatrixToCSR() = + secondMatrix <- this.FunCSC2CSR this.Processor HostInterop secondMatrix + + abstract member GlobalSetup : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + + abstract member Benchmark : unit -> unit + +type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit MxmBenchmarks<'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices () + this.LoadMatricesToGPU () + this.ConvertSecondMatrixToCSC() + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + [] + override this.Benchmark () = + this.Mxm() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + +type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit MxmBenchmarks<'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup () = + this.ReadMatrices () + this.LoadMatricesToGPU () + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + [] + override this.IterationCleanup () = + this.ClearResult() + this.ConvertSecondMatrixToCSR() + + [] + override this.Benchmark () = + this.ConvertSecondMatrixToCSC() + this.Mxm() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + +module Operations = + let add = <@ fun x y -> Some (x + y) @> + + let addWithFilter = <@ fun x y -> + let res = x + y + if abs res < 1e-8f then None else Some res + @> + + let mult = <@ fun x y -> Some (x * y) @> + + let logicalOr = <@ fun x y -> + let mutable res = None + + match x, y with + | false, false -> res <- None + | _ -> res <- Some true + + res @> + + let logicalAnd = <@ fun x y -> + let mutable res = None + + match x, y with + | true, true -> res <- Some true + | _ -> res <- None + + res @> + +type MxmBenchmarks4Float32MultiplicationOnly() = + + inherit MxmBenchmarksMultiplicationOnly( + (Matrix.SpGeMM.masked Operations.add Operations.mult), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + ) + + static member InputMatrixProvider = + MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + +type MxmBenchmarks4Float32WithTransposing() = + + inherit MxmBenchmarksWithTransposing( + (Matrix.SpGeMM.masked Operations.add Operations.mult), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + ) + + static member InputMatrixProvider = + MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + +type MxmBenchmarks4BoolMultiplicationOnly() = + + inherit MxmBenchmarksMultiplicationOnly( + (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), + (fun _ -> true), + (fun _ -> true), + (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + ) + + static member InputMatrixProvider = + MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" + +type MxmBenchmarks4BoolWithTransposing() = + + inherit MxmBenchmarksWithTransposing( + (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), + (fun _ -> true), + (fun _ -> true), + (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + ) + + static member InputMatrixProvider = + MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" + +type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = + + inherit MxmBenchmarksMultiplicationOnly( + (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + ) + + static member InputMatrixProvider = + MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + +type MxmBenchmarks4Float32WithTransposingWithZerosFilter() = + + inherit MxmBenchmarksWithTransposing( + (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + ) + + static member InputMatrixProvider = + MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs new file mode 100644 index 00000000..62dade8a --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs @@ -0,0 +1,77 @@ +namespace GraphBLAS.FSharp.Benchmarks + +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend +open BenchmarkDotNet.Attributes +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Objects + +[)>] +type MxvBenchmarks() = + let rand = System.Random() + + let mutable matrix = Unchecked.defaultof> + let mutable vector = Unchecked.defaultof> + let semiring = Predefined.AddMult.float + + //TODO fix me + (*[] + member val OclContext = Unchecked.defaultof with get, set + member this.Context = + let (ClContext context) = this.OclContext + context + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + [] + member this.BuildMatrix() = + let inputMatrix = this.InputMatrixReader.ReadMatrixReal(float) + + matrix <- + graphblas { + return! Matrix.switch CSR inputMatrix + >>= Matrix.synchronizeAndReturn + } + |> EvalGB.withClContext this.Context + |> EvalGB.runSync + + [] + member this.BuildVector() = + vector <- + graphblas { + return! + [ for i = 0 to matrix.ColumnCount - 1 do if rand.Next() % 2 = 0 then yield (i, 1.) ] + |> Vector.ofList matrix.ColumnCount + // >>= Vector.synchronizeAndReturn + } + |> EvalGB.withClContext this.Context + |> EvalGB.runSync + + [] + member this.Mxv() = + Matrix.mxv semiring matrix vector + |> EvalGB.withClContext this.Context + |> EvalGB.runSync + + [] + member this.ClearBuffers() = + this.Context.Provider.CloseAllBuffers() + + [] + member this.ClearContext() = + let (ClContext context) = this.OclContext + context.Provider.Dispose() + + static member AvaliableContextsProvider = Utils.avaliableContexts + + static member InputMatricesProvider = + "Common.txt" + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + match Path.GetExtension matrixFilename with + | ".mtx" -> MtxReader(Utils.getFullPathToMatrix "Common" matrixFilename) + | _ -> failwith "Unsupported matrix format" + ) +*) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs new file mode 100644 index 00000000..97d75077 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -0,0 +1,211 @@ +namespace GraphBLAS.FSharp.Benchmarks + +open Expecto +open FsCheck +open BenchmarkDotNet.Attributes +open BenchmarkDotNet.Configs +open BenchmarkDotNet.Columns +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClVectorExtensions +open GraphBLAS.FSharp.Backend.Vector +open GraphBLAS.FSharp.Backend.Objects.ClContext + +type VectorConfig() = + inherit ManualConfig() + + do + base.AddColumn( + StatisticColumn.Min, + StatisticColumn.Max + ) + |> ignore + +[] +[] +[] +[)>] +type VectorEWiseBenchmarks<'elem when 'elem : struct>( + buildFunToBenchmark, + generator: Gen * Vector<'elem>>) = + + let mutable funToBenchmark = None + + let mutable firstVector = Unchecked.defaultof> + + let mutable secondVector = Unchecked.defaultof> + + member val HostVectorPair = Unchecked.defaultof * Vector<'elem>> with get, set + + member val ResultVector = Unchecked.defaultof> with get,set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val Size = Unchecked.defaultof with get, set + + member this.OclContext: ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvaliableContexts = Utils.avaliableContexts + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.EWiseAddition() = + this.ResultVector <- this.FunToBenchmark this.Processor HostInterop firstVector secondVector + + member this.ClearInputVectors()= + firstVector.Dispose this.Processor + secondVector.Dispose this.Processor + + member this.ClearResult() = + this.ResultVector.Dispose this.Processor + + member this.CreateVectors() = + this.HostVectorPair <- List.last (Gen.sample this.Size 1 generator) + + member this.LoadVectorsToGPU() = + firstVector <- (fst this.HostVectorPair).ToDevice this.OclContext + secondVector <- (snd this.HostVectorPair).ToDevice this.OclContext + + abstract member GlobalSetup : unit -> unit + + abstract member IterationSetup: unit -> unit + + abstract member Benchmark : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + + +type VectorEWiseBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( + buildFunToBenchmark, + generator) = + + inherit VectorEWiseBenchmarks<'elem>( + buildFunToBenchmark, + generator) + + [] + override this.GlobalSetup() = () + + [] + override this.IterationSetup() = + this.CreateVectors () + this.LoadVectorsToGPU () + + [] + override this.Benchmark () = + this.EWiseAddition() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.IterationCleanup () = + this.ClearResult() + this.ClearInputVectors() + + [] + override this.GlobalCleanup() = () + +type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( + buildFunToBenchmark, + generator) = + + inherit VectorEWiseBenchmarks<'elem>( + buildFunToBenchmark, + generator) + + [] + override this.GlobalSetup() = () + + [] + override this.IterationSetup() = + this.CreateVectors() + + [] + override this.Benchmark () = + this.LoadVectorsToGPU() + this.EWiseAddition() + this.Processor.PostAndReply Msg.MsgNotifyMe + this.ResultVector.ToHost this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + + [] + override this.IterationCleanup () = + this.ClearInputVectors() + this.ClearResult() + + [] + override this.GlobalCleanup() = () + +/// Without data transfer +/// AtLeastOne +type VectorEWiseBenchmarks4FloatSparseWithoutDataTransfer() = + + inherit VectorEWiseBenchmarksWithoutDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) + +type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = + + inherit VectorEWiseBenchmarksWithoutDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) + +/// General + +type VectorEWiseGeneralBenchmarks4FloatSparseWithoutDataTransfer() = + + inherit VectorEWiseBenchmarksWithoutDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) + +type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = + + inherit VectorEWiseBenchmarksWithoutDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) + +/// With data transfer + +type VectorEWiseBenchmarks4FloatSparseWithDataTransfer() = + + inherit VectorEWiseBenchmarksWithDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) + +type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = + + inherit VectorEWiseBenchmarksWithDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) + +/// General with data transfer + +type VectorEWiseGeneralBenchmarks4FloatSparseWithDataTransfer() = + + inherit VectorEWiseBenchmarksWithDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) + +type VectorEWiseGeneralBenchmarks4Int32SparseWithDataTransfer() = + + inherit VectorEWiseBenchmarksWithDataTransfer( + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) diff --git a/src/GraphBLAS-sharp/AlgebraicStructures.fs b/src/GraphBLAS-sharp/AlgebraicStructures.fs deleted file mode 100644 index 8a048043..00000000 --- a/src/GraphBLAS-sharp/AlgebraicStructures.fs +++ /dev/null @@ -1,55 +0,0 @@ -namespace GraphBLAS.FSharp - -open Microsoft.FSharp.Quotations - -type UnaryOp<'a, 'b> = UnaryOp of Expr<'a -> 'b> -type BinaryOp<'a, 'b, 'c> = BinaryOp of Expr<'a -> 'b -> 'c> - -type ClosedUnaryOp<'a> = ClosedUnaryOp of Expr<'a -> 'a> -type ClosedBinaryOp<'a> = ClosedBinaryOp of Expr<'a -> 'a -> 'a> - -/// Magma with associative (magma is set with closed binary operator) -type ISemigroup<'a> = - abstract Op : ClosedBinaryOp<'a> - -/// Semigroup with identity -type IMonoid<'a> = - abstract Plus : ClosedBinaryOp<'a> - abstract Zero : 'a - -/// Monoid with associative binary operator, -/// for wich Zero is annihilator -type ISemiring<'a> = - abstract Zero : 'a - abstract Plus : ClosedBinaryOp<'a> - abstract Times : ClosedBinaryOp<'a> - -type Semigroup<'a> = - { AssociativeOp: ClosedBinaryOp<'a> } - - interface ISemigroup<'a> with - member this.Op = this.AssociativeOp - -type Monoid<'a> = - { AssociativeOp: ClosedBinaryOp<'a> - Identity: 'a } - - interface ISemigroup<'a> with - member this.Op = this.AssociativeOp - - interface IMonoid<'a> with - member this.Plus = this.AssociativeOp - member this.Zero = this.Identity - -type Semiring<'a> = - { PlusMonoid: Monoid<'a> - TimesSemigroup: Semigroup<'a> } - - interface IMonoid<'a> with - member this.Zero = this.PlusMonoid.Identity - member this.Plus = this.PlusMonoid.AssociativeOp - - interface ISemiring<'a> with - member this.Times = this.TimesSemigroup.AssociativeOp - member this.Zero = this.PlusMonoid.Identity - member this.Plus = this.PlusMonoid.AssociativeOp diff --git a/src/GraphBLAS-sharp/Algorithms/BFS.fs b/src/GraphBLAS-sharp/Algorithms/BFS.fs deleted file mode 100644 index 5972939b..00000000 --- a/src/GraphBLAS-sharp/Algorithms/BFS.fs +++ /dev/null @@ -1,38 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp - -module BFS = - let levelSingleSource (matrix: Matrix) (source: int) = - graphblas { - let vertexCount = Matrix.rowCount matrix - let! levels = Vector.zeroCreate vertexCount // v - let! frontier = Vector.ofList vertexCount [ source, 1 ] // q[s] = true - let! transposed = Matrix.transpose matrix // A' - - let mutable currentLevel = 0 - let mutable break' = false - - while not break' do - currentLevel <- currentLevel + 1 - - let! currentLevelScalar = Scalar.create currentLevel - - let! frontierMask = Vector.mask frontier - do! Vector.fillSubVector levels frontierMask currentLevelScalar // v[q] = d - - let! levelsComplemented = Vector.complemented levels - - do! - Matrix.mxvWithMask AddMult.int levelsComplemented transposed frontier // q[!v] = (A' ||.&& q)' = q' ||.&& A -- replace + comp - >>= Vector.assignVector frontier - - let! succ = - Vector.reduce AddMult.int frontier - >>= Scalar.exportValue - - break' <- succ = 0 - - return levels - } diff --git a/src/GraphBLAS-sharp/Algorithms/BetweennessCentrality.fs b/src/GraphBLAS-sharp/Algorithms/BetweennessCentrality.fs deleted file mode 100644 index f07c1ebc..00000000 --- a/src/GraphBLAS-sharp/Algorithms/BetweennessCentrality.fs +++ /dev/null @@ -1,89 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp - -module BetweennessCentrality = - // NOTE matrix of bool? - let metric (matrix: Matrix) (source: int) = - graphblas { - let n = Matrix.rowCount matrix - let! delta = Vector.zeroCreate n - let! sigma = Matrix.zeroCreate n n - let! q = Vector.ofList n [ source, 1 ] - let! p = Vector.copy q - - let! pMask = Vector.complemented p - - do! - Matrix.vxmWithMask AddMult.int pMask q matrix - >>= Vector.assignVector q - - let mutable d = 0 - let mutable sum = 0 - let mutable break' = false - - while not break' || sum <> 0 do - break' <- true - - do! Matrix.assignRow sigma d q - - do! - Vector.eWiseAdd Add.int p q - >>= Vector.assignVector p // ? - - let! pMask = Vector.complemented p - - do! - Matrix.vxmWithMask AddMult.int pMask q matrix - >>= Vector.assignVector q - - let! sum' = Vector.reduce Add.int q >>= Scalar.exportValue - - sum <- sum' - d <- d + 1 - - let! t1 = Vector.zeroCreate n - let! t2 = Vector.zeroCreate n - let! t3 = Vector.zeroCreate n - let! t4 = Vector.zeroCreate n - - for i = d - 1 downto 1 do - // t1 <- 1 + delta - do! - Vector.apply (UnaryOp <@ (+) 1.f @>) delta - >>= Vector.assignVector t1 - - // t2 <- sigma.[i, *] - do! - Matrix.extractRow sigma i - >>= Vector.apply (UnaryOp <@ float32 @>) - >>= Vector.assignVector t2 - - // t2 <- t1 / t2 - let! qMask = Vector.mask q - - do! - Vector.apply (UnaryOp <@ (/) 1.f @>) t2 - >>= fun x -> Vector.eWiseMultWithMask AddMult.float32 qMask t1 x - >>= Vector.assignVector t2 - - do! - Matrix.apply (UnaryOp <@ float32 @>) matrix - >>= fun matrix -> Matrix.mxv AddMult.float32 matrix t2 - >>= Vector.assignVector t3 - - // t4 <- sigma.[i - 1, *] * t3 - do! - Matrix.extractRow sigma (i - 1) - >>= Vector.apply (UnaryOp <@ float32 @>) - >>= fun x -> Vector.eWiseMult AddMult.float32 x t3 - >>= Vector.assignVector t4 - - // delta <- delta + t4 - do! - Vector.eWiseAdd Add.float32 delta t4 - >>= Vector.assignVector delta - - return delta - } diff --git a/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs b/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs deleted file mode 100644 index 4fa82474..00000000 --- a/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs +++ /dev/null @@ -1,24 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp -open Brahma.FSharp.OpenCL - -module ShortestPath = - // FIXME Unsupported call: min - let singleSource (matrix: Matrix) (source: int) = - graphblas { - let vertexCount = Matrix.rowCount matrix - let! distance = Vector.ofList vertexCount [ source, 0. ] - - let! transposed = Matrix.transpose matrix // A' - - // TODO terminate earlier if we reach a fixed point - for _ = 1 to vertexCount - 1 do - failwith "FIX ME! And rewrite." - //do! - // Matrix.mxv MinAdd.float transposed distance - // >>= Vector.assignVector distance - - return distance - } diff --git a/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs b/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs deleted file mode 100644 index e04a97a4..00000000 --- a/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs +++ /dev/null @@ -1,30 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp - -module TriangleCounting = - let sandia (matrix: Matrix) = - graphblas { - let! lowerTriangular = - matrix - |> Matrix.select (UnaryOp <@ fun (i, j, _) -> i <= j @>) - - let! matrix' = - lowerTriangular - |> Matrix.apply ( - UnaryOp - <@ function - | true -> 1 - | false -> 0 @> - ) - - let! transposed = matrix' |> Matrix.transpose - - let! lowerTriangularMask = lowerTriangular |> Matrix.mask - - return! - Matrix.mxmWithMask AddMult.int lowerTriangularMask matrix' transposed - >>= Matrix.reduce Add.int - >>= Scalar.exportValue - } diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index 6e3620cf..698b8a17 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -16,21 +16,12 @@ - - - - - - - - - Always diff --git a/src/GraphBLAS-sharp/GraphblasEvaluation.fs b/src/GraphBLAS-sharp/GraphblasEvaluation.fs deleted file mode 100644 index 4997a79a..00000000 --- a/src/GraphBLAS-sharp/GraphblasEvaluation.fs +++ /dev/null @@ -1,88 +0,0 @@ -namespace GraphBLAS.FSharp -// -//open Brahma.FSharp.ClTaskImpl -//open Brahma.FSharp.ClTask -//open Brahma.FSharp -// -//type GraphblasContext = { ClContext: ClContext } -// -//type GraphblasEvaluation<'a> = EvalGB of (GraphblasContext -> 'a) -// -//module EvalGB = -// let defaultEnv = { ClContext = ClContext() } -// -// let private runCl env (ClTask f) = f env -// -// let run env (EvalGB action) = action env -// -// let ask = EvalGB id -// -// let asks f = EvalGB f -// -// let bind f reader = -// EvalGB -// <| fun env -> -// let x = run env reader -// run env (f x) -// -// let (>>=) x f = bind f x -// -// let return' x = EvalGB <| fun _ -> x -// -// let returnFrom x = x -// -// let fromCl clEvaluation = -// EvalGB -// <| fun env -> runCl env.ClContext clEvaluation -// -// let withClContext clContext (EvalGB action) = -// ask -// >>= fun env -> -// return' -// <| action { env with ClContext = clContext } -// -// let runSync (EvalGB action) = -// let result = action defaultEnv -// result -// -//type GraphblasBuilder() = -// member this.Bind(x, f) = EvalGB.bind f x -// member this.Return x = EvalGB.return' x -// member this.ReturnFrom x = x -// -// member this.Zero() = EvalGB.return' () -// -// member this.Combine(m1, m2) = -// EvalGB -// <| fun env -> -// EvalGB.run env m1 -// EvalGB.run env m2 -// -// member this.Delay rest = -// EvalGB <| fun env -> EvalGB.run env <| rest () -// -// member this.While(predicate, body) = -// EvalGB -// <| fun env -> -// while predicate () do -// EvalGB.run env body -// -// member this.For(sequence, f) = -// EvalGB -// <| fun env -> -// for elem in sequence do -// EvalGB.run env (f elem) -// -// member this.TryWith(tryBlock, handler) = -// EvalGB -// <| fun env -> -// try -// EvalGB.run env tryBlock -// with -// | e -> EvalGB.run env (handler e) -// -//[] -//module GraphblasBuilder = -// let graphblas = GraphblasBuilder() -// -// let (>>=) x f = EvalGB.bind f x diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index fd7dcadc..e0724e8e 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -5,6 +5,50 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix module Matrix = + type CSR<'a when 'a: struct> = + { RowCount: int + ColumnCount: int + RowPointers: int [] + ColumnIndices: int [] + Values: 'a [] } + + static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = + let rowsCount = array |> Array2D.length1 + let columnsCount = array |> Array2D.length2 + + let convertedMatrix = + [ for i in 0 .. rowsCount - 1 -> array.[i, *] |> List.ofArray ] + |> List.map + (fun row -> + row + |> List.mapi (fun i x -> (x, i)) + |> List.filter (fun pair -> not <| isZero (fst pair))) + |> List.fold + (fun (rowPtrs, valueInx) row -> ((rowPtrs.Head + row.Length) :: rowPtrs), valueInx @ row) + ([ 0 ], []) + + { Values = + convertedMatrix + |> (snd >> List.unzip >> fst) + |> List.toArray + ColumnIndices = + convertedMatrix + |> (snd >> List.unzip >> snd) + |> List.toArray + RowPointers = convertedMatrix |> fst |> List.rev |> List.toArray + RowCount = rowsCount + ColumnCount = columnsCount } + + member this.NNZ = this.Values.Length + + member this.ToDevice(context: ClContext) = + { Context = context + RowCount = this.RowCount + ColumnCount = this.ColumnCount + RowPointers = context.CreateClArray this.RowPointers + Columns = context.CreateClArray this.ColumnIndices + Values = context.CreateClArray this.Values } + type COO<'a when 'a: struct> = { RowCount: int ColumnCount: int @@ -47,49 +91,23 @@ module Matrix = Columns = context.CreateClArray this.Columns Values = context.CreateClArray this.Values } - type CSR<'a when 'a: struct> = - { RowCount: int - ColumnCount: int - RowPointers: int [] - ColumnIndices: int [] - Values: 'a [] } + member this.toCSR = + let rowPointers = + let nnzPerRow = Array.zeroCreate this.RowCount + let rowPointers = Array.zeroCreate this.RowCount - static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = - let rowsCount = array |> Array2D.length1 - let columnsCount = array |> Array2D.length2 + Array.iter (fun rowIndex -> nnzPerRow.[rowIndex] <- nnzPerRow.[rowIndex] + 1) this.Rows - let convertedMatrix = - [ for i in 0 .. rowsCount - 1 -> array.[i, *] |> List.ofArray ] - |> List.map - (fun row -> - row - |> List.mapi (fun i x -> (x, i)) - |> List.filter (fun pair -> not <| isZero (fst pair))) - |> List.fold - (fun (rowPtrs, valueInx) row -> ((rowPtrs.Head + row.Length) :: rowPtrs), valueInx @ row) - ([ 0 ], []) - - { Values = - convertedMatrix - |> (snd >> List.unzip >> fst) - |> List.toArray - ColumnIndices = - convertedMatrix - |> (snd >> List.unzip >> snd) - |> List.toArray - RowPointers = convertedMatrix |> fst |> List.rev |> List.toArray - RowCount = rowsCount - ColumnCount = columnsCount } + for i in 1 .. this.RowCount - 1 do + rowPointers.[i] <- rowPointers.[i - 1] + nnzPerRow.[i - 1] - member this.NNZ = this.Values.Length + rowPointers - member this.ToDevice(context: ClContext) = - { Context = context - RowCount = this.RowCount + { RowCount = this.RowCount ColumnCount = this.ColumnCount - RowPointers = context.CreateClArray this.RowPointers - Columns = context.CreateClArray this.ColumnIndices - Values = context.CreateClArray this.Values } + RowPointers = rowPointers + ColumnIndices = this.Columns + Values = this.Values } type CSC<'a when 'a: struct> = { RowCount: int diff --git a/src/GraphBLAS-sharp/Operations/Matrix.fs b/src/GraphBLAS-sharp/Operations/Matrix.fs deleted file mode 100644 index c36c7973..00000000 --- a/src/GraphBLAS-sharp/Operations/Matrix.fs +++ /dev/null @@ -1,371 +0,0 @@ -namespace GraphBLAS.FSharp - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend - -[] -module Matrix = - - (* - constructors - *) - - let build - (rowCount: int) - (columnCount: int) - (rows: int []) - (columns: int []) - (values: 'a []) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofTuples (rowCount: int) (columnCount: int) (tuples: MatrixTuples<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofList (rowCount: int) (columnCount: int) (elements: (int * int * 'a) list) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - // можно оставить, но с условием, что будет создаваться full matrix, - // которую можно будет проредить потом (но вообще это initом эмулируется) - // let ofArray2D (array: 'a[,]) : GraphblasEvaluation> = - // failwith "Not Implemented yet"" - - let init (rowCount: int) (columnCount: int) (initializer: int -> int -> 'a) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let create (rowCount: int) (columnCount: int) (value: 'a) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let zeroCreate<'a when 'a: struct> (rowCount: int) (columnCount: int) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - (* - methods - *) - - let rowCount (matrix: Matrix<'a>) : int = matrix.RowCount - let columnCount (matrix: Matrix<'a>) : int = matrix.ColumnCount - - let copy (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" - - let resize (rowCount: int) (columnCount: int) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - // NOTE int cant be sync - let nnz (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let tuples (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix with - | MatrixCOO matrix -> COOMatrix.GetTuples.fromMatrix matrix - | MatrixCSR matrix -> CSRMatrix.GetTuples.fromMatrix matrix - |> EvalGB.fromCl - - let mask (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - let complemented (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let switch (matrixFormat: MatrixFromat) (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix, matrixFormat with - | MatrixCOO matrix, CSR -> - opencl { - let! result = CSRMatrix.Convert.fromCoo matrix - return MatrixCSR result - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let synchronize (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let synchronizeAndReturn (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix with - | MatrixCSR matrix -> - opencl { - let! _ = - if matrix.RowPointers.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME! And rewrite." - //ToHost matrix.RowPointers - - let! _ = - if matrix.ColumnIndices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME! And rewrite." - //ToHost matrix.ColumnIndices - - let! _ = - if matrix.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME! And rewrite." - //ToHost matrix.Values - - return MatrixCSR matrix - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - (* - assignment, extraction and filling - *) - - /// mat.[mask] - let extractSubMatrix (matrix: Matrix<'a>) (mask: Mask2D) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// mat.[rowIdx. *] - let extractRow (matrix: Matrix<'a>) (rowIdx: int) : GraphblasEvaluation> = failwith "Not Implemented yet" - - /// mat.[rowIdx, mask] - let extractSubRow (matrix: Matrix<'a>) (rowIdx: int) (mask: Mask2D) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// mat.[*, colIdx] - let extractCol (matrix: Matrix<'a>) (colIdx: int) : GraphblasEvaluation> = failwith "Not Implemented yet" - - /// mat.[mask. colIdx] - let extractSubCol (matrix: Matrix<'a>) (mask: Mask2D) (colIdx: int) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// mat.[rowIdx, colIdx] - let extractValue (matrix: Matrix<'a>) (rowIdx: int) (colIdx: int) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// t <- s - let assignMatrix (target: Matrix<'a>) (source: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[mask] <- s - let assignSubMatrix (target: Matrix<'a>) (mask: Mask2D) (source: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[rowIdx, *] <- s - let assignRow (target: Matrix<'a>) (rowIdx: int) (source: Vector<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[rowIdx, mask] <- s - let assignSubRow - (target: Matrix<'a>) - (rowIdx: int) - (mask: Mask1D) - (source: Vector<'a>) - : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[*, colIdx] <- s - let assignCol (target: Matrix<'a>) (colIdx: int) (source: Vector<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[mask, colIdx] <- s - let assignSubCol - (target: Matrix<'a>) - (colIdx: int) - (mask: Mask1D) - (source: Vector<'a>) - : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[*, *] <- value - let fillMatrix (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - /// mat.[mask] <- value - let fillSubMatrix (mask: Mask2D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[rowIdx, *] <- value - let fillRow (rowIdx: int) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[rowIdx, mask] <- value - let fillSubRow (rowIdx: int) (mask: Mask1D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[*, colIdx] <- value - let fillCol (colIdx: int) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[mask, colIdx] <- value - let fillSubCol (colIdx: int) (mask: Mask1D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - (* - closed unmasked operations - *) - - let mxm - (semiring: ISemiring<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented" - - let mxv (semiring: ISemiring<'a>) (matrix: Matrix<'a>) (vector: Vector<'a>) : GraphblasEvaluation> = - match matrix, vector with - | MatrixCSR matrix, VectorCOO vector -> - opencl { - let! result = CSRMatrix.SpMSpV.unmasked matrix vector semiring - return VectorCOO result - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let vxm (semiring: ISemiring<'a>) (vector: Vector<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented" - - let eWiseAdd - (monoid: IMonoid<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - match leftMatrix, rightMatrix with - | MatrixCOO left, MatrixCOO right -> failwith "FIX ME! And rewrite." - //opencl { - // let! result = COOMatrix.EWiseAdd.run left right None monoid - // return MatrixCOO result - //} - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let eWiseMult - (semiring: ISemiring<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let apply (mapper: UnaryOp<'a, 'b>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let select (predicate: UnaryOp) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceRows (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceCols (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduce (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let transpose (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix with - | MatrixCSR matrix -> - // map - opencl { - let! transposed = CSRMatrix.Transpose.transposeMatrix matrix - return MatrixCSR transposed - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let kronecker - (semiring: ISemiring<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - (* - closed masked operations - *) - - let mxmWithMask - (semiring: ISemiring<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let mxvWithMask - (semiring: ISemiring<'a>) - (mask: Mask1D) - (matrix: Matrix<'a>) - (vector: Vector<'a>) - : GraphblasEvaluation> = - match matrix, vector, mask with - | MatrixCSR matrix, VectorCOO vector, mask when not mask.IsComplemented -> - opencl { - let! result = CSRMatrix.SpMSpV.masked matrix vector semiring mask - return VectorCOO result - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let vxmWithMask - (semiring: ISemiring<'a>) - (mask: Mask1D) - (vector: Vector<'a>) - (matrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseAddWithMask - (monoid: IMonoid<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseMultWithMask - (semiring: ISemiring<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let applyWithMask (mapper: UnaryOp<'a, 'b>) (mask: Mask2D) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let selectWithMask - (predicate: UnaryOp) - (mask: Mask2D) - (matrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceRowsWithMask (monoid: IMonoid<'a>) (mask: Mask1D) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceColsWithMask (monoid: IMonoid<'a>) (mask: Mask1D) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let kroneckerWithMask - (semiring: ISemiring<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - -[] -module MatrixTuples = - let synchronize (matrixTuples: MatrixTuples<'a>) = - opencl { - let! _ = - if matrixTuples.RowIndices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost matrixTuples.RowIndices - - let! _ = - if matrixTuples.ColumnIndices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost matrixTuples.ColumnIndices - - let! _ = - if matrixTuples.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost matrixTuples.Values - - return () - } - |> EvalGB.fromCl diff --git a/src/GraphBLAS-sharp/Operations/Scalar.fs b/src/GraphBLAS-sharp/Operations/Scalar.fs deleted file mode 100644 index 4c39d1da..00000000 --- a/src/GraphBLAS-sharp/Operations/Scalar.fs +++ /dev/null @@ -1,44 +0,0 @@ -namespace GraphBLAS.FSharp -// -//open Brahma.FSharp -// -//[] -//module Scalar = -// -// (* -// constructors -// *) -// -// let create (value: 'a) : GraphblasEvaluation> = -// graphblas { return ScalarWrapped { Value = [| value |] } } -// -// (* -// methods -// *) -// -// let copy (scalar: Scalar<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" -// -// let synchronize (scalar: Scalar<'a>) : GraphblasEvaluation = -// match scalar with -// | ScalarWrapped scalar -> -// opencl { -// failwith "FIX ME!" -// //let! _ = ToHost scalar.Value -// return () -// } -// |> EvalGB.fromCl -// -// (* -// assignment and extraction -// *) -// -// let exportValue (scalar: Scalar<'a>) : GraphblasEvaluation<'a> = -// graphblas { -// do! synchronize scalar -// -// match scalar with -// | ScalarWrapped scalar -> return scalar.Value.[0] -// } -// -// let assignValue (scalar: Scalar<'a>) (target: Scalar<'a>) : GraphblasEvaluation = -// failwith "Not Implemented yet" diff --git a/src/GraphBLAS-sharp/Operations/Vector.fs b/src/GraphBLAS-sharp/Operations/Vector.fs deleted file mode 100644 index 072ddfca..00000000 --- a/src/GraphBLAS-sharp/Operations/Vector.fs +++ /dev/null @@ -1,316 +0,0 @@ -namespace GraphBLAS.FSharp - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Backend.Common - -[] -module Vector = - - (* - constructors - *) - - let build (size: int) (indices: int []) (values: 'a []) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofTuples (size: int) (tuples: VectorTuples<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofList (size: int) (elements: (int * 'a) list) : GraphblasEvaluation> = - let (indices, values) = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip - - graphblas { - return - VectorCOO - <| COOVector.FromTuples(size, indices, values) - } - - // можно оставить, но с условием, что будет создаваться full vector - // let ofArray (array: 'a[]) : GraphblasEvaluation> = - // failwith "Not Implemented yet" - - let init (size: int) (initializer: int -> 'a) : GraphblasEvaluation> = failwith "Not Implemented yet" - - let create (size: int) (value: 'a) : GraphblasEvaluation> = failwith "Not Implemented yet" - - let zeroCreate<'a when 'a: struct> (size: int) : GraphblasEvaluation> = - graphblas { - return - VectorCOO - <| COOVector.FromTuples(size, [||], [||]) - } - - (* - methods - *) - - let size (vector: Vector<'a>) : int = failwith "Not Implemented yet" - let copy (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" - let resize (size: int) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" - - // NOTE int cant be sync - let nnz (vector: Vector<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let tuples (vector: Vector<'a>) : GraphblasEvaluation> = - match vector with - | VectorCOO vector -> - opencl { - if vector.Values.Length = 0 then - return { Indices = [||]; Values = [||] } - else - failwith "FIX ME!" - let ind = [||] //let! ind = Copy.copyArray vector.Indices - let vals = [||] //let! vals = Copy.copyArray vector.Values - - return { Indices = ind; Values = vals } - } - |> EvalGB.fromCl - - let mask (vector: Vector<'a>) : GraphblasEvaluation = - match vector with - | VectorCOO vector -> - opencl { - failwith "FIX ME!" - let indices = [||] //let! indices = Copy.copyArray vector.Indices - return Mask1D(indices, vector.Size, false) - } - |> EvalGB.fromCl - - let complemented (vector: Vector<'a>) : GraphblasEvaluation = - match vector with - | VectorCOO vector -> - opencl { - failwith "FIX ME!" - let indices = [||] //let! indices = Copy.copyArray vector.Indices - - let! complementedMask = - Mask.GetComplemented.mask1D - <| Mask1D(indices, vector.Size, true) - - return complementedMask - } - |> EvalGB.fromCl - - let switch (vectorFormat: VectorFormat) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let synchronize (vector: Vector<'a>) : GraphblasEvaluation = - match vector with - | VectorCOO vector -> - opencl { - let! _ = - if vector.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Indices - - let! _ = - if vector.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Values - - return () - } - |> EvalGB.fromCl - - let synchronizeAndReturn (vector: Vector<'a>) : GraphblasEvaluation> = - match vector with - | VectorCOO vector -> - opencl { - let! _ = - if vector.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Indices - - let! _ = - if vector.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Values - - return VectorCOO vector - } - |> EvalGB.fromCl - - (* - assignment, extraction and filling - *) - - /// vec.[mask] - let extractSubVector (vector: Vector<'a>) (mask: Mask1D) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// vec.[idx] - let extractValue (vector: Vector<'a>) (idx: int) : GraphblasEvaluation> = failwith "Not Implemented yet" - - // assignToVector - /// t <- vec - let assignVector (target: Vector<'a>) (source: Vector<'a>) : GraphblasEvaluation = - if target.Size <> source.Size then - invalidArg "source" - <| sprintf "The size of source vector must be %A. Received: %A" target.Size source.Size - - match source, target with - | VectorCOO source, VectorCOO target -> - opencl { - target.Indices <- source.Indices - target.Values <- source.Values - } - |> EvalGB.fromCl - - /// t.[mask] <- vec - let assignSubVector (target: Vector<'a>) (mask: Mask1D) (source: Vector<'a>) : GraphblasEvaluation = - if target.Size <> mask.Size then - invalidArg "mask" - <| sprintf "The size of mask must be %A. Received: %A" target.Size mask.Size - - if target.Size <> source.Size then - invalidArg "source" - <| sprintf "The size of source vector must be %A. Received: %A" target.Size source.Size - - match source, target, mask with - | VectorCOO source, VectorCOO target, mask when not mask.IsComplemented -> - opencl { - let! (resultIndices, resultValues) = - COOVector.AssignSubVector.run target.Indices target.Values source.Indices source.Values mask.Indices - - target.Indices <- resultIndices - target.Values <- resultValues - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - /// t.[idx] <- value - let assignValue (target: Vector<'a>) (idx: int) (value: Scalar<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// vec.[*] <- value - let fillVector (vector: Vector<'a>) (value: Scalar<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - /// vec.[mask] <- value - let fillSubVector (vector: Vector<'a>) (mask: Mask1D) (value: Scalar<'a>) : GraphblasEvaluation = - match vector, value, mask with - | VectorCOO vector, ScalarWrapped scalar, mask when not mask.IsComplemented -> - opencl { - let! (resultIndices, resultValues) = - COOVector.FillSubVector.run vector.Indices vector.Values mask.Indices scalar.Value - - vector.Indices <- resultIndices - vector.Values <- resultValues - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - (* - operations - *) - - let eWiseAdd - (monoid: IMonoid<'a>) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseMult - (semiring: ISemiring<'a>) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let apply (mapper: UnaryOp<'a, 'b>) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let select (predicate: UnaryOp<'a, bool>) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduce (monoid: IMonoid<'a>) (vector: Vector<'a>) : GraphblasEvaluation> = - let (ClosedBinaryOp plus) = monoid.Plus - - match vector with - | VectorCOO vector -> - opencl { - let! result = Sum.run vector.Values plus monoid.Zero - return ScalarWrapped { Value = result } - } - |> EvalGB.fromCl - - let eWiseAddWithMask - (monoid: IMonoid<'a>) - (mask: Mask1D) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseMultWithMask - (semiring: ISemiring<'a>) - (mask: Mask1D) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let applyWithMask (mapper: UnaryOp<'a, 'b>) (mask: Mask1D) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let selectWithMask - (predicate: UnaryOp<'a, bool>) - (mask: Mask1D) - (vector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - -[] -module VectorTuples = - let synchronize (vectorTuples: VectorTuples<'a>) = - opencl { - let! _ = - if vectorTuples.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Indices - - let! _ = - if vectorTuples.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Values - - return () - } - |> EvalGB.fromCl - - let synchronizeAndReturn (vectorTuples: VectorTuples<'a>) = - opencl { - let! _ = - if vectorTuples.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Indices - - let! _ = - if vectorTuples.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Values - - return vectorTuples - } - |> EvalGB.fromCl diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs deleted file mode 100644 index 24af1458..00000000 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs +++ /dev/null @@ -1,32 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module Add = - let int: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0 } - - let float: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0. } - - let float32: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0.f } - - let sbyte: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0y } - - let byte: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0uy } - - let int16: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0s } - - let uint16: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0us } diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs deleted file mode 100644 index 3cbfa8d3..00000000 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs +++ /dev/null @@ -1,8 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module Any = - let bool: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (||) @> - Identity = false } diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs deleted file mode 100644 index 9249925d..00000000 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs +++ /dev/null @@ -1,12 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module Min = - let int: Monoid = - { AssociativeOp = ClosedBinaryOp <@ fun x y -> System.Math.Min(x, y) @> - Identity = System.Int32.MaxValue } - - let float: Monoid = - { AssociativeOp = ClosedBinaryOp <@ fun x y -> System.Math.Min(x, y) @> - Identity = System.Double.PositiveInfinity } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs b/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs deleted file mode 100644 index 4253e33f..00000000 --- a/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs +++ /dev/null @@ -1,32 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module AddMult = - let int: Semiring = - { PlusMonoid = Add.int - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let float: Semiring = - { PlusMonoid = Add.float - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let float32: Semiring = - { PlusMonoid = Add.float32 - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let sbyte: Semiring = - { PlusMonoid = Add.sbyte - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let byte: Semiring = - { PlusMonoid = Add.byte - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let int16: Semiring = - { PlusMonoid = Add.int16 - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let uint16: Semiring = - { PlusMonoid = Add.uint16 - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs b/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs deleted file mode 100644 index ea0d532b..00000000 --- a/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs +++ /dev/null @@ -1,8 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module AnyAll = - let bool: Semiring = - { PlusMonoid = Any.bool - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (&&) @> } } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs b/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs deleted file mode 100644 index fd23eb3f..00000000 --- a/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs +++ /dev/null @@ -1,8 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module MinAdd = - let float: Semiring = - { PlusMonoid = Min.float - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (+) @> } } From 9e8b9bc5fef06bac0628607fce68826072c7cb95 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Apr 2023 11:20:07 +0300 Subject: [PATCH 088/143] refactor: benchmarks --- .../{BenchmarksBFS.fs => Algorithms/BFS.fs} | 140 ++++---- .../Algorithms/BenchmarksBFS.fs | 164 ---------- .../BenchmarksEWiseAdd.fs | 307 ------------------ .../BenchmarksMxm.fs | 299 ----------------- .../BenchmarksMxv.fs | 77 ----- .../Matrix/BenchmarksEWiseAdd.fs | 307 ------------------ .../Matrix/Map2/Map2.fs | 281 ++++++++++++++++ .../Map2/MathNET.fs} | 13 +- .../{BenchmarksMxm.fs => SpGeMM/Masked.fs} | 102 +++--- .../MatrixExtensions.fs | 91 ------ .../Vector/BenchmarksMxv.fs | 77 ----- .../GraphBLAS-sharp.Benchmarks/Vector/Map2.fs | 75 ++--- .../VectorEWiseAddGen.fs | 211 ------------ 13 files changed, 437 insertions(+), 1707 deletions(-) rename benchmarks/GraphBLAS-sharp.Benchmarks/{BenchmarksBFS.fs => Algorithms/BFS.fs} (50%) delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs rename benchmarks/GraphBLAS-sharp.Benchmarks/{BenchmarksMathNET.fs => Matrix/Map2/MathNET.fs} (88%) rename benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/{BenchmarksMxm.fs => SpGeMM/Masked.fs} (78%) delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/MatrixExtensions.fs delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs similarity index 50% rename from benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs rename to benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs index 93a52dba..1b4c06c3 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -1,43 +1,41 @@ namespace GraphBLAS.FSharp.Benchmarks open System.IO +open BenchmarkDotNet.Attributes +open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.IO -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns open Brahma.FSharp -open GraphBLAS.FSharp.Objects +open Backend.Algorithms.BFS +open Microsoft.FSharp.Core +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Benchmarks open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Algorithms -open MatrixExtensions -open ArraysExtensions [] -[] -[] -[)>] -type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = +[] +[] +[)>] +type BFSBenchmarks<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + binaryConverter, + vertex: int) + = let mutable funToBenchmark = None - let mutable matrix = Unchecked.defaultof<'matrixT> + let mutable matrix = Unchecked.defaultof> let mutable matrixHost = Unchecked.defaultof<_> - let source = 0 - - member val ResultVector = Unchecked.defaultof> with get,set + member val ResultLevels = Unchecked.defaultof> with get,set [] member val OclContextInfo = Unchecked.defaultof with get, set - [] + [] member val InputMatrixReader = Unchecked.defaultof with get, set - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext + member this.OclContext = (fst this.OclContextInfo).ClContext member this.WorkGroupSize = snd this.OclContextInfo member this.Processor = @@ -47,8 +45,8 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : static member AvailableContexts = Utils.avaliableContexts - static member InputMatricesProviderBuilder pathToConfig = - let datasetFolder = "" + static member InputMatrixProviderBuilder pathToConfig = + let datasetFolder = "BFS" pathToConfig |> Utils.getMatricesFilenames |> Seq.map @@ -56,8 +54,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : printfn "%A" matrixFilename match Path.GetExtension matrixFilename with - | ".mtx" -> - MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + | ".mtx" -> MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) | _ -> failwith "Unsupported matrix format") member this.FunToBenchmark = @@ -68,29 +65,24 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : x | Some x -> x - member this.ReadMatrix (reader:MtxReader) = - let converter = - match reader.Field with - | Pattern -> converterBool - | _ -> converter - - reader.ReadMatrix converter - member this.BFS() = - this.ResultVector <- this.FunToBenchmark this.Processor matrix source + this.ResultLevels <- this.FunToBenchmark this.Processor matrix vertex member this.ClearInputMatrix() = (matrix :> IDeviceMemObject).Dispose this.Processor - member this.ClearResult() = - this.ResultVector.FreeAndWait this.Processor + member this.ClearResult() = this.ResultLevels.FreeAndWait this.Processor member this.ReadMatrix() = - let matrixReader = this.InputMatrixReader - matrixHost <- this.ReadMatrix matrixReader + let converter = + match this.InputMatrixReader.Field with + | Pattern -> binaryConverter + | _ -> converter + + matrixHost <- this.InputMatrixReader.ReadMatrix converter member this.LoadMatrixToGPU() = - matrix <- buildMatrix this.OclContext matrixHost + matrix <- matrixHost.ToCSR.ToDevice this.OclContext abstract member GlobalSetup : unit -> unit @@ -100,21 +92,22 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : abstract member Benchmark : unit -> unit -type BFSBenchmarksWithoutDataTransfer() = +type BFSBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + boolConverter, + vertex) = - inherit BFSBenchmarks, int>( - (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption wgSize), - int, - (fun _ -> Utils.nextInt (System.Random())), - Matrix.ToBackendCSR) - - static member InputMatricesProvider = - BFSBenchmarks<_,_>.InputMatricesProviderBuilder "BFSBenchmarks.txt" + inherit BFSBenchmarks<'elem>( + buildFunToBenchmark, + converter, + boolConverter, + vertex) [] override this.GlobalSetup() = - this.ReadMatrix () - this.LoadMatrixToGPU () + this.ReadMatrix() + this.LoadMatrixToGPU() [] override this.IterationCleanup() = @@ -127,27 +120,27 @@ type BFSBenchmarksWithoutDataTransfer() = [] override this.Benchmark() = this.BFS() - this.Processor.PostAndReply(Msg.MsgNotifyMe) + this.Processor.PostAndReply Msg.MsgNotifyMe -type BFSBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix, - resultToHost) = +type BFSBenchmarksWithTransfer<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + boolConverter, + vertex) = - inherit BFSBenchmarks<'matrixT, 'elem>( + inherit BFSBenchmarks<'elem>( buildFunToBenchmark, converter, - converterBool, - buildMatrix) + boolConverter, + vertex) [] override this.GlobalSetup() = this.ReadMatrix() [] - override this.GlobalCleanup() = () + override this.GlobalCleanup() = + this.ClearResult() [] override this.IterationCleanup() = @@ -158,7 +151,28 @@ type BFSBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemOb override this.Benchmark() = this.LoadMatrixToGPU() this.BFS() + this.ResultLevels.ToHost this.Processor |> ignore this.Processor.PostAndReply Msg.MsgNotifyMe - resultToHost this.ResultVector this.Processor - this.Processor.PostAndReply Msg.MsgNotifyMe + +type BFSIntWithoutTransferBenchmark() = + + inherit BFSBenchmarksWithoutDataTransfer( + (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) + + static member InputMatrixProvider = + BFSBenchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + +type BFSIntWithTransferBenchmark() = + + inherit BFSBenchmarksWithTransfer( + (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) + + static member InputMatrixProvider = + BFSBenchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs deleted file mode 100644 index 283cbcc2..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BenchmarksBFS.fs +++ /dev/null @@ -1,164 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open System.IO -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.IO -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open Brahma.FSharp -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Algorithms -open MatrixExtensions -open ArraysExtensions - -[] -[] -[] -[)>] -type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - let mutable funToBenchmark = None - let mutable matrix = Unchecked.defaultof<'matrixT> - let mutable matrixHost = Unchecked.defaultof<_> - - let source = 0 - - member val ResultVector = Unchecked.defaultof> with get,set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - static member InputMatricesProviderBuilder pathToConfig = - let datasetFolder = "" - pathToConfig - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - printfn "%A" matrixFilename - - match Path.GetExtension matrixFilename with - | ".mtx" -> - MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) - | _ -> failwith "Unsupported matrix format") - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.ReadMatrix (reader:MtxReader) = - let converter = - match reader.Field with - | Pattern -> converterBool - | _ -> converter - - reader.ReadMatrix converter - - member this.BFS() = - this.ResultVector <- this.FunToBenchmark this.Processor matrix source - - member this.ClearInputMatrix() = - (matrix :> IDeviceMemObject).Dispose this.Processor - - member this.ClearResult() = - this.ResultVector.FreeAndWait this.Processor - - member this.ReadMatrix() = - let matrixReader = this.InputMatrixReader - matrixHost <- this.ReadMatrix matrixReader - - member this.LoadMatrixToGPU() = - matrix <- buildMatrix this.OclContext matrixHost - - abstract member GlobalSetup : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - abstract member Benchmark : unit -> unit - -type BFSBenchmarksWithoutDataTransfer() = - - inherit BFSBenchmarks, int>( - (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption wgSize), - int, - (fun _ -> Utils.nextInt (System.Random())), - Matrix.ToBackendCSR) - - static member InputMatricesProvider = - BFSBenchmarks<_,_>.InputMatricesProviderBuilder "BFSBenchmarks.txt" - - [] - override this.GlobalSetup() = - this.ReadMatrix () - this.LoadMatrixToGPU () - - [] - override this.IterationCleanup() = - this.ClearResult() - - [] - override this.GlobalCleanup() = - this.ClearInputMatrix() - - [] - override this.Benchmark() = - this.BFS() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - -type BFSBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix, - resultToHost) = - - inherit BFSBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrix() - - [] - override this.GlobalCleanup() = () - - [] - override this.IterationCleanup() = - this.ClearInputMatrix() - this.ClearResult() - - [] - override this.Benchmark() = - this.LoadMatrixToGPU() - this.BFS() - this.Processor.PostAndReply Msg.MsgNotifyMe - let res = resultToHost this.ResultVector this.Processor - this.Processor.PostAndReply Msg.MsgNotifyMe - diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs deleted file mode 100644 index 18aa2cdd..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs +++ /dev/null @@ -1,307 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open System.IO -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.IO -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open Brahma.FSharp -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Objects.Matrix -open GraphBLAS.FSharp.Benchmarks.MatrixExtensions -open GraphBLAS.FSharp.Backend.Objects.ClContext - -[] -[] -[] -[)>] -type EWiseAddBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - let mutable funToBenchmark = None - let mutable firstMatrix = Unchecked.defaultof<'matrixT> - let mutable secondMatrix = Unchecked.defaultof<'matrixT> - let mutable firstMatrixHost = Unchecked.defaultof<_> - let mutable secondMatrixHost = Unchecked.defaultof<_> - - member val ResultMatrix = Unchecked.defaultof<'matrixT> with get,set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - static member InputMatricesProviderBuilder pathToConfig = - let datasetFolder = "EWiseAdd" - pathToConfig - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - printfn "%A" matrixFilename - - match Path.GetExtension matrixFilename with - | ".mtx" -> - MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) - , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) - | _ -> failwith "Unsupported matrix format") - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.ReadMatrix (reader:MtxReader) = - let converter = - match reader.Field with - | Pattern -> converterBool - | _ -> converter - - reader.ReadMatrix converter - - member this.EWiseAddition() = - this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix - - member this.ClearInputMatrices() = - (firstMatrix :> IDeviceMemObject).Dispose this.Processor - (secondMatrix :> IDeviceMemObject).Dispose this.Processor - - member this.ClearResult() = - (this.ResultMatrix :> IDeviceMemObject).Dispose this.Processor - - member this.ReadMatrices() = - let leftMatrixReader = fst this.InputMatrixReader - let rightMatrixReader = snd this.InputMatrixReader - firstMatrixHost <- this.ReadMatrix leftMatrixReader - secondMatrixHost <- this.ReadMatrix rightMatrixReader - - member this.LoadMatricesToGPU () = - firstMatrix <- buildMatrix this.OclContext firstMatrixHost - secondMatrix <- buildMatrix this.OclContext secondMatrixHost - - abstract member GlobalSetup : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - abstract member Benchmark : unit -> unit - -type EWiseAddBenchmarksWithoutDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - inherit EWiseAddBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrices () - this.LoadMatricesToGPU () - - [] - override this.IterationCleanup () = - this.ClearResult() - - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - [] - override this.Benchmark () = - this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - -type EWiseAddBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix, - resultToHost) = - - inherit EWiseAddBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup () = - this.ReadMatrices () - - [] - override this.GlobalCleanup () = () - - [] - override this.IterationCleanup () = - this.ClearInputMatrices() - this.ClearResult() - - [] - override this.Benchmark () = - this.LoadMatricesToGPU() - this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe - let res = resultToHost this.ResultMatrix this.Processor - this.Processor.PostAndReply Msg.MsgNotifyMe - -module M = - let resultToHostCOO (resultMatrix: ClMatrix.COO<'a>) (processor :MailboxProcessor<_>) = - let cols = - let a = Array.zeroCreate resultMatrix.ColumnCount - processor.Post(Msg.CreateToHostMsg<_>(resultMatrix.Columns,a)) - a - let rows = - let a = Array.zeroCreate resultMatrix.RowCount - processor.Post(Msg.CreateToHostMsg(resultMatrix.Rows,a)) - a - let vals = - let a = Array.zeroCreate resultMatrix.Values.Length - processor.Post(Msg.CreateToHostMsg(resultMatrix.Values,a)) - a - { - RowCount = resultMatrix.RowCount - ColumnCount = resultMatrix.ColumnCount - Rows = rows - Columns = cols - Values = vals - } - - -type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type EWiseAddBenchmarks4Float32COOWithDataTransfer() = - - inherit EWiseAddBenchmarksWithDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO, - M.resultToHostCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - - -type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.boolSum wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" - - -type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" - - -type EWiseAddBenchmarks4BoolCSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.boolSum wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -// With AtLeastOne - -type EWiseAddAtLeastOneBenchmarks4BoolCOOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type EWiseAddAtLeastOneBenchmarks4BoolCSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type EWiseAddAtLeastOneBenchmarks4Float32COOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type EWiseAddAtLeastOneBenchmarks4Float32CSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs deleted file mode 100644 index efbe86c9..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs +++ /dev/null @@ -1,299 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open System.IO -open GraphBLAS.FSharp.IO -open BenchmarkDotNet.Attributes -open Brahma.FSharp -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Benchmarks.MatrixExtensions -open GraphBLAS.FSharp.Backend.Objects.ClContext - -[] -[] -[] -[)>] -type MxmBenchmarks<'elem when 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - let mutable funToBenchmark = None - let mutable funCSR2CSC = None - let mutable funCSC2CSR = None - - let mutable firstMatrix = Unchecked.defaultof> - let mutable secondMatrix = Unchecked.defaultof> - let mutable mask = Unchecked.defaultof> - - let mutable firstMatrixHost = Unchecked.defaultof<_> - let mutable secondMatrixHost = Unchecked.defaultof<_> - let mutable maskHost = Unchecked.defaultof> - - member val ResultMatrix = Unchecked.defaultof> with get, set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - static member InputMatrixProviderBuilder pathToConfig = - let datasetFolder = "Mxm" - pathToConfig - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - printfn "%A" matrixFilename - - match Path.GetExtension matrixFilename with - | ".mtx" -> - MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) - , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) - | _ -> failwith "Unsupported matrix format") - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.FunCSR2CSC = - match funCSR2CSC with - | None -> - let x = Matrix.toCSCInPlace this.OclContext this.WorkGroupSize - funCSR2CSC <- Some x - x - | Some x -> x - - member this.FunCSC2CSR = - match funCSC2CSR with - | None -> - let x = Matrix.toCSRInPlace this.OclContext this.WorkGroupSize - funCSC2CSR <- Some x - x - | Some x -> x - - member this.ReadMatrix (reader:MtxReader) = - let converter = - match reader.Field with - | Pattern -> converterBool - | _ -> converter - - reader.ReadMatrix converter - - member this.Mxm() = - this.ResultMatrix <- this.FunToBenchmark this.Processor firstMatrix secondMatrix mask - - member this.ClearInputMatrices() = - firstMatrix.Dispose this.Processor - secondMatrix.Dispose this.Processor - mask.Dispose this.Processor - - member this.ClearResult() = - this.ResultMatrix.Dispose this.Processor - - member this.ReadMask(maskReader) = - maskHost <- this.ReadMatrix maskReader - - member this.ReadMatrices() = - let matrixReader, maskReader = this.InputMatrixReader - firstMatrixHost <- this.ReadMatrix matrixReader - secondMatrixHost <- this.ReadMatrix matrixReader - this.ReadMask(maskReader) - - member this.LoadMatricesToGPU () = - firstMatrix <- buildMatrix this.OclContext firstMatrixHost - secondMatrix <- buildMatrix this.OclContext secondMatrixHost - mask <- maskHost.ToDevice this.OclContext - - member this.ConvertSecondMatrixToCSC() = - secondMatrix <- this.FunCSR2CSC this.Processor HostInterop secondMatrix - - member this.ConvertSecondMatrixToCSR() = - secondMatrix <- this.FunCSC2CSR this.Processor HostInterop secondMatrix - - abstract member GlobalSetup : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - abstract member Benchmark : unit -> unit - -type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - inherit MxmBenchmarks<'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrices () - this.LoadMatricesToGPU () - this.ConvertSecondMatrixToCSC() - - [] - override this.IterationCleanup () = - this.ClearResult() - - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - [] - override this.Benchmark () = - this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - -type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - inherit MxmBenchmarks<'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup () = - this.ReadMatrices () - this.LoadMatricesToGPU () - - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - [] - override this.IterationCleanup () = - this.ClearResult() - this.ConvertSecondMatrixToCSR() - - [] - override this.Benchmark () = - this.ConvertSecondMatrixToCSC() - this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - -module Operations = - let add = <@ fun x y -> Some (x + y) @> - - let addWithFilter = <@ fun x y -> - let res = x + y - if abs res < 1e-8f then None else Some res - @> - - let mult = <@ fun x y -> Some (x * y) @> - - let logicalOr = <@ fun x y -> - let mutable res = None - - match x, y with - | false, false -> res <- None - | _ -> res <- Some true - - res @> - - let logicalAnd = <@ fun x y -> - let mutable res = None - - match x, y with - | true, true -> res <- Some true - | _ -> res <- None - - res @> - -type MxmBenchmarks4Float32MultiplicationOnly() = - - inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.add Operations.mult), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) - ) - - static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" - -type MxmBenchmarks4Float32WithTransposing() = - - inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.add Operations.mult), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) - ) - - static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" - -type MxmBenchmarks4BoolMultiplicationOnly() = - - inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), - (fun _ -> true), - (fun _ -> true), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) - ) - - static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" - -type MxmBenchmarks4BoolWithTransposing() = - - inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), - (fun _ -> true), - (fun _ -> true), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) - ) - - static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" - -type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = - - inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) - ) - - static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" - -type MxmBenchmarks4Float32WithTransposingWithZerosFilter() = - - inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) - ) - - static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs deleted file mode 100644 index 62dade8a..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs +++ /dev/null @@ -1,77 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend -open BenchmarkDotNet.Attributes -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Objects - -[)>] -type MxvBenchmarks() = - let rand = System.Random() - - let mutable matrix = Unchecked.defaultof> - let mutable vector = Unchecked.defaultof> - let semiring = Predefined.AddMult.float - - //TODO fix me - (*[] - member val OclContext = Unchecked.defaultof with get, set - member this.Context = - let (ClContext context) = this.OclContext - context - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - [] - member this.BuildMatrix() = - let inputMatrix = this.InputMatrixReader.ReadMatrixReal(float) - - matrix <- - graphblas { - return! Matrix.switch CSR inputMatrix - >>= Matrix.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.BuildVector() = - vector <- - graphblas { - return! - [ for i = 0 to matrix.ColumnCount - 1 do if rand.Next() % 2 = 0 then yield (i, 1.) ] - |> Vector.ofList matrix.ColumnCount - // >>= Vector.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.Mxv() = - Matrix.mxv semiring matrix vector - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.ClearBuffers() = - this.Context.Provider.CloseAllBuffers() - - [] - member this.ClearContext() = - let (ClContext context) = this.OclContext - context.Provider.Dispose() - - static member AvaliableContextsProvider = Utils.avaliableContexts - - static member InputMatricesProvider = - "Common.txt" - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - match Path.GetExtension matrixFilename with - | ".mtx" -> MtxReader(Utils.getFullPathToMatrix "Common" matrixFilename) - | _ -> failwith "Unsupported matrix format" - ) -*) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs deleted file mode 100644 index 18aa2cdd..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksEWiseAdd.fs +++ /dev/null @@ -1,307 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open System.IO -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.IO -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open Brahma.FSharp -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Objects.Matrix -open GraphBLAS.FSharp.Benchmarks.MatrixExtensions -open GraphBLAS.FSharp.Backend.Objects.ClContext - -[] -[] -[] -[)>] -type EWiseAddBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - let mutable funToBenchmark = None - let mutable firstMatrix = Unchecked.defaultof<'matrixT> - let mutable secondMatrix = Unchecked.defaultof<'matrixT> - let mutable firstMatrixHost = Unchecked.defaultof<_> - let mutable secondMatrixHost = Unchecked.defaultof<_> - - member val ResultMatrix = Unchecked.defaultof<'matrixT> with get,set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - static member InputMatricesProviderBuilder pathToConfig = - let datasetFolder = "EWiseAdd" - pathToConfig - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - printfn "%A" matrixFilename - - match Path.GetExtension matrixFilename with - | ".mtx" -> - MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) - , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) - | _ -> failwith "Unsupported matrix format") - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.ReadMatrix (reader:MtxReader) = - let converter = - match reader.Field with - | Pattern -> converterBool - | _ -> converter - - reader.ReadMatrix converter - - member this.EWiseAddition() = - this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix - - member this.ClearInputMatrices() = - (firstMatrix :> IDeviceMemObject).Dispose this.Processor - (secondMatrix :> IDeviceMemObject).Dispose this.Processor - - member this.ClearResult() = - (this.ResultMatrix :> IDeviceMemObject).Dispose this.Processor - - member this.ReadMatrices() = - let leftMatrixReader = fst this.InputMatrixReader - let rightMatrixReader = snd this.InputMatrixReader - firstMatrixHost <- this.ReadMatrix leftMatrixReader - secondMatrixHost <- this.ReadMatrix rightMatrixReader - - member this.LoadMatricesToGPU () = - firstMatrix <- buildMatrix this.OclContext firstMatrixHost - secondMatrix <- buildMatrix this.OclContext secondMatrixHost - - abstract member GlobalSetup : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - abstract member Benchmark : unit -> unit - -type EWiseAddBenchmarksWithoutDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - inherit EWiseAddBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrices () - this.LoadMatricesToGPU () - - [] - override this.IterationCleanup () = - this.ClearResult() - - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - [] - override this.Benchmark () = - this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - -type EWiseAddBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix, - resultToHost) = - - inherit EWiseAddBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup () = - this.ReadMatrices () - - [] - override this.GlobalCleanup () = () - - [] - override this.IterationCleanup () = - this.ClearInputMatrices() - this.ClearResult() - - [] - override this.Benchmark () = - this.LoadMatricesToGPU() - this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe - let res = resultToHost this.ResultMatrix this.Processor - this.Processor.PostAndReply Msg.MsgNotifyMe - -module M = - let resultToHostCOO (resultMatrix: ClMatrix.COO<'a>) (processor :MailboxProcessor<_>) = - let cols = - let a = Array.zeroCreate resultMatrix.ColumnCount - processor.Post(Msg.CreateToHostMsg<_>(resultMatrix.Columns,a)) - a - let rows = - let a = Array.zeroCreate resultMatrix.RowCount - processor.Post(Msg.CreateToHostMsg(resultMatrix.Rows,a)) - a - let vals = - let a = Array.zeroCreate resultMatrix.Values.Length - processor.Post(Msg.CreateToHostMsg(resultMatrix.Values,a)) - a - { - RowCount = resultMatrix.RowCount - ColumnCount = resultMatrix.ColumnCount - Rows = rows - Columns = cols - Values = vals - } - - -type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type EWiseAddBenchmarks4Float32COOWithDataTransfer() = - - inherit EWiseAddBenchmarksWithDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO, - M.resultToHostCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - - -type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.boolSum wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" - - -type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" - - -type EWiseAddBenchmarks4BoolCSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.boolSum wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -// With AtLeastOne - -type EWiseAddAtLeastOneBenchmarks4BoolCOOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type EWiseAddAtLeastOneBenchmarks4BoolCSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type EWiseAddAtLeastOneBenchmarks4Float32COOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type EWiseAddAtLeastOneBenchmarks4Float32CSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs new file mode 100644 index 00000000..da62a739 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs @@ -0,0 +1,281 @@ +namespace GraphBLAS.FSharp.Benchmarks + +open System.IO +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Attributes +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Benchmarks + +[] +[] +[] +[)>] +type Map2Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix: Matrix.COO<_> -> Matrix<_>) = + + let mutable funToBenchmark = None + let mutable firstMatrix = Unchecked.defaultof> + let mutable secondMatrix = Unchecked.defaultof> + let mutable firstMatrixHost = Unchecked.defaultof<_> + let mutable secondMatrixHost = Unchecked.defaultof<_> + + member val ResultMatrix = Unchecked.defaultof> with get,set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext: ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvailableContexts = Utils.avaliableContexts + + static member InputMatricesProviderBuilder pathToConfig = + let datasetFolder = "EWiseAdd" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> + MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.ReadMatrix (reader: MtxReader) = + let converter = + match reader.Field with + | Pattern -> converterBool + | _ -> converter + + reader.ReadMatrix converter + + member this.EWiseAddition() = + this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix + + member this.ClearInputMatrices() = + firstMatrix.Dispose this.Processor + secondMatrix.Dispose this.Processor + + member this.ClearResult() = + this.ResultMatrix.Dispose this.Processor + + member this.ReadMatrices() = + firstMatrixHost <- this.ReadMatrix <| fst this.InputMatrixReader + secondMatrixHost <- this.ReadMatrix <| snd this.InputMatrixReader + + member this.LoadMatricesToGPU () = + firstMatrix <- (buildMatrix firstMatrixHost).ToDevice this.OclContext + secondMatrix <- (buildMatrix secondMatrixHost).ToDevice this.OclContext + + abstract member GlobalSetup: unit -> unit + + abstract member Benchmark: unit -> unit + + abstract member IterationCleanup: unit -> unit + + abstract member GlobalCleanup: unit -> unit + +type Map2BenchmarksWithoutDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit Map2Benchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices () + this.LoadMatricesToGPU () + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.Benchmark () = + this.EWiseAddition() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + +type Map2BenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix, + resultToHost) = + + inherit Map2Benchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices() + + [] + override this.GlobalCleanup() = () + + [] + override this.IterationCleanup() = + this.ClearInputMatrices() + this.ClearResult() + + [] + override this.Benchmark() = + this.LoadMatricesToGPU() + this.EWiseAddition() + this.Processor.PostAndReply Msg.MsgNotifyMe + resultToHost this.ResultMatrix this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + +type MatrixCOOMap2Float32WithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,float32>( + (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO + ) + + static member InputMatricesProvider = + Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + +type MatrixCOOMap2Float32WithTransferBenchmark() = + + inherit Map2BenchmarksWithDataTransfer,float32>( + (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO, + (fun matrix -> matrix.ToHost) + ) + + static member InputMatricesProvider = + Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + + +type MatrixCOOMap2BoolWithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,bool>( + (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), + (fun _ -> true), + (fun _ -> true), + Matrix.COO + ) + + static member InputMatricesProvider = + Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" + + +type MatrixCSRMap2Float32WithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,float32>( + (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" + + +type MatrixCSRMap2BoolWithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,bool>( + (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), + (fun _ -> true), + (fun _ -> true), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + +// AtLeastOne + +type MatrixCOOMap2AtLeastOne4BoolWithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,bool>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), + (fun _ -> true), + (fun _ -> true), + Matrix.COO + ) + + static member InputMatricesProvider = + Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + +type MatrixCSRMap2AtLeastOne4BoolWithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,bool>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), + (fun _ -> true), + (fun _ -> true), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + +type MatrixCOOMap2AtLeastOne4Float32WithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,float32>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO + ) + + static member InputMatricesProvider = + Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + +type MatrixCSRMap2AtLeastOne4Float32CSRWithoutTransferBenchmark() = + + inherit Map2BenchmarksWithoutDataTransfer,float32>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMathNET.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/MathNET.fs similarity index 88% rename from benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMathNET.fs rename to benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/MathNET.fs index a2d8a564..b0577154 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMathNET.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/MathNET.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks +namespace GraphBLAS.FSharp.Benchmarks.Matrix.Map2 open System.IO open GraphBLAS.FSharp.Objects @@ -7,12 +7,13 @@ open BenchmarkDotNet.Attributes open MathNet.Numerics.LinearAlgebra open MathNet.Numerics open Microsoft.FSharp.Core +open GraphBLAS.FSharp.Benchmarks [] [] [] -[)>] -type MathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'elem> and 'elem :> System.IFormattable and 'elem :> System.ValueType and 'elem: (new : +[)>] +type MathNET<'elem when 'elem: struct and 'elem :> System.IEquatable<'elem> and 'elem :> System.IFormattable and 'elem :> System.ValueType and 'elem: (new : unit -> 'elem)>(converter: string -> 'elem, converterBool) = do Control.UseNativeMKL() @@ -35,8 +36,8 @@ type MathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'e | Pattern -> converterBool | _ -> converter - let gbMatrix = reader.ReadMatrix converter - MathNETBenchmark<_>.COOMatrixToMathNETSparse gbMatrix + Matrix.COO (reader.ReadMatrix converter) + |> MathNET<_>.COOMatrixToMathNETSparse abstract member GlobalSetup : unit -> unit @@ -46,7 +47,7 @@ type MathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'e type BinOpMathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'elem> and 'elem :> System.IFormattable and 'elem :> System.ValueType and 'elem: (new : unit -> 'elem)>(funToBenchmark, converter: string -> 'elem, converterBool) = - inherit MathNETBenchmark<'elem>(converter, converterBool) + inherit MathNET<'elem>(converter, converterBool) let mutable firstMatrix = Unchecked.defaultof> let mutable secondMatrix = Unchecked.defaultof> diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs similarity index 78% rename from benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksMxm.fs rename to benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs index efbe86c9..133d1d6c 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/BenchmarksMxm.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs @@ -7,13 +7,14 @@ open Brahma.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Benchmarks.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Benchmarks +open GraphBLAS.FSharp.Backend [] [] [] -[)>] +[)>] type MxmBenchmarks<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, @@ -88,7 +89,7 @@ type MxmBenchmarks<'elem when 'elem : struct>( x | Some x -> x - member this.ReadMatrix (reader:MtxReader) = + member this.ReadMatrix (reader: MtxReader) = let converter = match reader.Field with | Pattern -> converterBool @@ -108,7 +109,7 @@ type MxmBenchmarks<'elem when 'elem : struct>( this.ResultMatrix.Dispose this.Processor member this.ReadMask(maskReader) = - maskHost <- this.ReadMatrix maskReader + maskHost <- Matrix.COO <| this.ReadMatrix maskReader member this.ReadMatrices() = let matrixReader, maskReader = this.InputMatrixReader @@ -129,12 +130,12 @@ type MxmBenchmarks<'elem when 'elem : struct>( abstract member GlobalSetup : unit -> unit + abstract member Benchmark : unit -> unit + abstract member IterationCleanup : unit -> unit abstract member GlobalCleanup : unit -> unit - abstract member Benchmark : unit -> unit - type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, @@ -153,6 +154,11 @@ type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( this.LoadMatricesToGPU () this.ConvertSecondMatrixToCSC() + [] + override this.Benchmark () = + this.Mxm() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + [] override this.IterationCleanup () = this.ClearResult() @@ -161,11 +167,6 @@ type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( override this.GlobalCleanup () = this.ClearInputMatrices() - [] - override this.Benchmark () = - this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, @@ -179,120 +180,93 @@ type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( buildMatrix) [] - override this.GlobalSetup () = - this.ReadMatrices () + override this.GlobalSetup() = + this.ReadMatrices() this.LoadMatricesToGPU () - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - [] - override this.IterationCleanup () = - this.ClearResult() - this.ConvertSecondMatrixToCSR() - [] - override this.Benchmark () = + override this.Benchmark() = this.ConvertSecondMatrixToCSC() this.Mxm() this.Processor.PostAndReply(Msg.MsgNotifyMe) -module Operations = - let add = <@ fun x y -> Some (x + y) @> - - let addWithFilter = <@ fun x y -> - let res = x + y - if abs res < 1e-8f then None else Some res - @> - - let mult = <@ fun x y -> Some (x * y) @> - let logicalOr = <@ fun x y -> - let mutable res = None - - match x, y with - | false, false -> res <- None - | _ -> res <- Some true - - res @> - - let logicalAnd = <@ fun x y -> - let mutable res = None - - match x, y with - | true, true -> res <- Some true - | _ -> res <- None + [] + override this.IterationCleanup() = + this.ClearResult() + this.ConvertSecondMatrixToCSR() - res @> + [] + override this.GlobalCleanup() = + this.ClearInputMatrices() -type MxmBenchmarks4Float32MultiplicationOnly() = +type Mxm4Float32MultiplicationOnlyBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.add Operations.mult), + Matrix.SpGeMM.masked (Operations.add ()) (Operations.mult ()), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" -type MxmBenchmarks4Float32WithTransposing() = +type Mxm4Float32WithTransposingBenchmark() = inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.add Operations.mult), + Matrix.SpGeMM.masked (Operations.add ()) (Operations.mult ()), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" -type MxmBenchmarks4BoolMultiplicationOnly() = +type Mxm4BoolMultiplicationOnlyBenchmark() = inherit MxmBenchmarksMultiplicationOnly( (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), (fun _ -> true), (fun _ -> true), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" -type MxmBenchmarks4BoolWithTransposing() = +type Mxm4BoolWithTransposingBenchmark() = inherit MxmBenchmarksWithTransposing( (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), (fun _ -> true), (fun _ -> true), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" -type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = +type Mxm4Float32MultiplicationOnlyWithZerosFilterBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), + (Matrix.SpGeMM.masked Operations.addWithFilter (Operations.mult ())), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" -type MxmBenchmarks4Float32WithTransposingWithZerosFilter() = +type Mxm4Float32WithTransposingWithZerosFilterBenchmark() = inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), + Matrix.SpGeMM.masked Operations.addWithFilter (Operations.mult ()), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/MatrixExtensions.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/MatrixExtensions.fs deleted file mode 100644 index ed84bcee..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/MatrixExtensions.fs +++ /dev/null @@ -1,91 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open GraphBLAS.FSharp.Objects -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects.ClMatrix - -module MatrixExtensions = - type Matrix<'a when 'a : struct> with - static member ToBackendCOO (context: ClContext) matrix = - match matrix with - | Matrix.COO m -> - let rows = - context.CreateClArray( - m.Rows, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let cols = - context.CreateClArray( - m.Columns, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let vals = - context.CreateClArray( - m.Values, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - { Context = context - RowCount = m.RowCount - ColumnCount = m.ColumnCount - Rows = rows - Columns = cols - Values = vals } - - | _ -> failwith "Unsupported matrix format: %A" - - static member ToBackendCSR (context: ClContext) matrix = - let rowIndices2rowPointers (rowIndices: int []) rowCount = - let nnzPerRow = Array.zeroCreate rowCount - let rowPointers = Array.zeroCreate rowCount - - Array.iter (fun rowIndex -> nnzPerRow.[rowIndex] <- nnzPerRow.[rowIndex] + 1) rowIndices - - for i in 1 .. rowCount - 1 do - rowPointers.[i] <- rowPointers.[i - 1] + nnzPerRow.[i - 1] - - rowPointers - - match matrix with - | Matrix.COO m -> - let rowPointers = - context.CreateClArray( - rowIndices2rowPointers m.Rows m.RowCount, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let cols = - context.CreateClArray( - m.Columns, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let vals = - context.CreateClArray( - m.Values, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - { Context = context - RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowPointers = rowPointers - Columns = cols - Values = vals } - - | _ -> failwith "Unsupported matrix format: %A" - diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs deleted file mode 100644 index 62dade8a..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/BenchmarksMxv.fs +++ /dev/null @@ -1,77 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend -open BenchmarkDotNet.Attributes -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Objects - -[)>] -type MxvBenchmarks() = - let rand = System.Random() - - let mutable matrix = Unchecked.defaultof> - let mutable vector = Unchecked.defaultof> - let semiring = Predefined.AddMult.float - - //TODO fix me - (*[] - member val OclContext = Unchecked.defaultof with get, set - member this.Context = - let (ClContext context) = this.OclContext - context - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - [] - member this.BuildMatrix() = - let inputMatrix = this.InputMatrixReader.ReadMatrixReal(float) - - matrix <- - graphblas { - return! Matrix.switch CSR inputMatrix - >>= Matrix.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.BuildVector() = - vector <- - graphblas { - return! - [ for i = 0 to matrix.ColumnCount - 1 do if rand.Next() % 2 = 0 then yield (i, 1.) ] - |> Vector.ofList matrix.ColumnCount - // >>= Vector.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.Mxv() = - Matrix.mxv semiring matrix vector - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.ClearBuffers() = - this.Context.Provider.CloseAllBuffers() - - [] - member this.ClearContext() = - let (ClContext context) = this.OclContext - context.Provider.Dispose() - - static member AvaliableContextsProvider = Utils.avaliableContexts - - static member InputMatricesProvider = - "Common.txt" - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - match Path.GetExtension matrixFilename with - | ".mtx" -> MtxReader(Utils.getFullPathToMatrix "Common" matrixFilename) - | _ -> failwith "Unsupported matrix format" - ) -*) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs index 97d75077..0ca9069a 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -1,33 +1,24 @@ namespace GraphBLAS.FSharp.Benchmarks -open Expecto +namespace GraphBLAS.FSharp.Benchmarks.Synthetic + open FsCheck open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns + open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Benchmarks open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Backend.Vector open GraphBLAS.FSharp.Backend.Objects.ClContext -type VectorConfig() = - inherit ManualConfig() - - do - base.AddColumn( - StatisticColumn.Min, - StatisticColumn.Max - ) - |> ignore - [] [] [] -[)>] +[)>] type VectorEWiseBenchmarks<'elem when 'elem : struct>( buildFunToBenchmark, generator: Gen * Vector<'elem>>) = @@ -45,7 +36,7 @@ type VectorEWiseBenchmarks<'elem when 'elem : struct>( [] member val OclContextInfo = Unchecked.defaultof with get, set - [] + [] member val Size = Unchecked.defaultof with get, set member this.OclContext: ClContext = (fst this.OclContextInfo).ClContext @@ -66,9 +57,15 @@ type VectorEWiseBenchmarks<'elem when 'elem : struct>( x | Some x -> x - member this.EWiseAddition() = + member this.Map2() = + try + this.ResultVector <- this.FunToBenchmark this.Processor HostInterop firstVector secondVector + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex + member this.ClearInputVectors()= firstVector.Dispose this.Processor secondVector.Dispose this.Processor @@ -83,15 +80,15 @@ type VectorEWiseBenchmarks<'elem when 'elem : struct>( firstVector <- (fst this.HostVectorPair).ToDevice this.OclContext secondVector <- (snd this.HostVectorPair).ToDevice this.OclContext - abstract member GlobalSetup : unit -> unit + abstract member GlobalSetup: unit -> unit abstract member IterationSetup: unit -> unit - abstract member Benchmark : unit -> unit + abstract member Benchmark: unit -> unit - abstract member IterationCleanup : unit -> unit + abstract member IterationCleanup: unit -> unit - abstract member GlobalCleanup : unit -> unit + abstract member GlobalCleanup: unit -> unit type VectorEWiseBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( @@ -107,16 +104,17 @@ type VectorEWiseBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( [] override this.IterationSetup() = - this.CreateVectors () - this.LoadVectorsToGPU () + this.CreateVectors() + this.LoadVectorsToGPU() + this.Processor.PostAndReply Msg.MsgNotifyMe [] - override this.Benchmark () = - this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) + override this.Benchmark() = + this.Map2() + this.Processor.PostAndReply Msg.MsgNotifyMe [] - override this.IterationCleanup () = + override this.IterationCleanup() = this.ClearResult() this.ClearInputVectors() @@ -141,8 +139,7 @@ type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( [] override this.Benchmark () = this.LoadVectorsToGPU() - this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Map2() this.ResultVector.ToHost this.Processor |> ignore this.Processor.PostAndReply Msg.MsgNotifyMe @@ -155,56 +152,52 @@ type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( override this.GlobalCleanup() = () /// Without data transfer -/// AtLeastOne -type VectorEWiseBenchmarks4FloatSparseWithoutDataTransfer() = +type VectorSparseMap2FloatWithoutTransferBenchmark() = inherit VectorEWiseBenchmarksWithoutDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) -type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = +type VectorSparseMap2Int32WithoutTransferBenchmark() = inherit VectorEWiseBenchmarksWithoutDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// General - -type VectorEWiseGeneralBenchmarks4FloatSparseWithoutDataTransfer() = +type VectorSparseMap2GeneralFloatWithoutTransferBenchmark() = inherit VectorEWiseBenchmarksWithoutDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) -type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = +type VectorSparseMap2GeneralInt32WithoutTransferBenchmark() = inherit VectorEWiseBenchmarksWithoutDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// With data transfer - -type VectorEWiseBenchmarks4FloatSparseWithDataTransfer() = +type VectorSparseMap2FloatWithTransferBenchmark() = inherit VectorEWiseBenchmarksWithDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) -type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = +type VectorSparseMap2Int32WithTransferBenchmark() = inherit VectorEWiseBenchmarksWithDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) -/// General with data transfer - -type VectorEWiseGeneralBenchmarks4FloatSparseWithDataTransfer() = +/// Map2 with data transfer +type VectorMap2GeneralFloatSparseWithTransferBenchmark() = inherit VectorEWiseBenchmarksWithDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) -type VectorEWiseGeneralBenchmarks4Int32SparseWithDataTransfer() = +type VectorMap2GeneralInt32SparseWithTransferBenchmark() = inherit VectorEWiseBenchmarksWithDataTransfer( (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs deleted file mode 100644 index 97d75077..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs +++ /dev/null @@ -1,211 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open Expecto -open FsCheck -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Objects.ClVectorExtensions -open GraphBLAS.FSharp.Backend.Vector -open GraphBLAS.FSharp.Backend.Objects.ClContext - -type VectorConfig() = - inherit ManualConfig() - - do - base.AddColumn( - StatisticColumn.Min, - StatisticColumn.Max - ) - |> ignore - -[] -[] -[] -[)>] -type VectorEWiseBenchmarks<'elem when 'elem : struct>( - buildFunToBenchmark, - generator: Gen * Vector<'elem>>) = - - let mutable funToBenchmark = None - - let mutable firstVector = Unchecked.defaultof> - - let mutable secondVector = Unchecked.defaultof> - - member val HostVectorPair = Unchecked.defaultof * Vector<'elem>> with get, set - - member val ResultVector = Unchecked.defaultof> with get,set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val Size = Unchecked.defaultof with get, set - - member this.OclContext: ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.EWiseAddition() = - this.ResultVector <- this.FunToBenchmark this.Processor HostInterop firstVector secondVector - - member this.ClearInputVectors()= - firstVector.Dispose this.Processor - secondVector.Dispose this.Processor - - member this.ClearResult() = - this.ResultVector.Dispose this.Processor - - member this.CreateVectors() = - this.HostVectorPair <- List.last (Gen.sample this.Size 1 generator) - - member this.LoadVectorsToGPU() = - firstVector <- (fst this.HostVectorPair).ToDevice this.OclContext - secondVector <- (snd this.HostVectorPair).ToDevice this.OclContext - - abstract member GlobalSetup : unit -> unit - - abstract member IterationSetup: unit -> unit - - abstract member Benchmark : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - -type VectorEWiseBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - generator) = - - inherit VectorEWiseBenchmarks<'elem>( - buildFunToBenchmark, - generator) - - [] - override this.GlobalSetup() = () - - [] - override this.IterationSetup() = - this.CreateVectors () - this.LoadVectorsToGPU () - - [] - override this.Benchmark () = - this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - - [] - override this.IterationCleanup () = - this.ClearResult() - this.ClearInputVectors() - - [] - override this.GlobalCleanup() = () - -type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - generator) = - - inherit VectorEWiseBenchmarks<'elem>( - buildFunToBenchmark, - generator) - - [] - override this.GlobalSetup() = () - - [] - override this.IterationSetup() = - this.CreateVectors() - - [] - override this.Benchmark () = - this.LoadVectorsToGPU() - this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe - this.ResultVector.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe - - [] - override this.IterationCleanup () = - this.ClearInputVectors() - this.ClearResult() - - [] - override this.GlobalCleanup() = () - -/// Without data transfer -/// AtLeastOne -type VectorEWiseBenchmarks4FloatSparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) - -/// General - -type VectorEWiseGeneralBenchmarks4FloatSparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) - -/// With data transfer - -type VectorEWiseBenchmarks4FloatSparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) - -/// General with data transfer - -type VectorEWiseGeneralBenchmarks4FloatSparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseGeneralBenchmarks4Int32SparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) From b25bc9722e6df32cc8fe72cb05870842d2fa956b Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Apr 2023 11:20:33 +0300 Subject: [PATCH 089/143] refactor: benchmarks --- .../Algorithms/BFS.fs | 14 +- .../GraphBLAS-sharp.Benchmarks/Columns.fs | 41 ++++ .../GraphBLAS-sharp.Benchmarks/Configs.fs | 77 ++++++ .../GraphBLAS-sharp.Benchmarks.fsproj | 14 +- .../GraphBLAS-sharp.Benchmarks/Helpers.fs | 224 +++++++----------- .../Matrix/Map2/Map2.fs | 26 +- .../Matrix/SpGeMM/Masked.fs | 22 +- .../GraphBLAS-sharp.Benchmarks/Program.fs | 2 +- .../GraphBLAS-sharp.Benchmarks/Vector/Map2.fs | 16 +- .../Quotes/Arithmetic.fs | 2 +- src/GraphBLAS-sharp/IO/MtxReader.fs | 13 +- src/GraphBLAS-sharp/Objects/Matrix.fs | 6 +- tests/GraphBLAS-sharp.Tests/Generators.fs | 32 --- tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 2 +- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 2 +- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 2 +- 16 files changed, 265 insertions(+), 230 deletions(-) create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs index 1b4c06c3..365db3df 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks +namespace GraphBLAS.FSharp.Benchmarks.Algorithms open System.IO open BenchmarkDotNet.Attributes @@ -15,8 +15,8 @@ open GraphBLAS.FSharp.Backend.Objects [] [] [] -[)>] -type BFSBenchmarks<'elem when 'elem : struct>( +[)>] +type BFS<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, binaryConverter, @@ -98,7 +98,7 @@ type BFSBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( boolConverter, vertex) = - inherit BFSBenchmarks<'elem>( + inherit BFS<'elem>( buildFunToBenchmark, converter, boolConverter, @@ -128,7 +128,7 @@ type BFSBenchmarksWithTransfer<'elem when 'elem : struct>( boolConverter, vertex) = - inherit BFSBenchmarks<'elem>( + inherit BFS<'elem>( buildFunToBenchmark, converter, boolConverter, @@ -163,7 +163,7 @@ type BFSIntWithoutTransferBenchmark() = 0) static member InputMatrixProvider = - BFSBenchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + BFS<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" type BFSIntWithTransferBenchmark() = @@ -174,5 +174,5 @@ type BFSIntWithTransferBenchmark() = 0) static member InputMatrixProvider = - BFSBenchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + BFS<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs new file mode 100644 index 00000000..2851fac4 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs @@ -0,0 +1,41 @@ +namespace GraphBLAS.FSharp.Benchmarks.Columns + +open BenchmarkDotNet.Columns +open BenchmarkDotNet.Reports +open BenchmarkDotNet.Running +open GraphBLAS.FSharp.IO + +type CommonColumn<'a>(benchmarkCaseConvert, columnName: string, getShape: 'a -> 'b) = + interface IColumn with + member this.AlwaysShow = true + member this.Category = ColumnCategory.Params + member this.ColumnName = columnName + + member this.GetValue(_: Summary, benchmarkCase: BenchmarkCase) = + benchmarkCaseConvert benchmarkCase + |> getShape + |> sprintf "%A" + + member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase, _: SummaryStyle) = + (this :> IColumn).GetValue(summary, benchmarkCase) + + member this.Id = sprintf $"%s{columnName}" + + member this.IsAvailable(_: Summary) = true + member this.IsDefault(_: Summary, _: BenchmarkCase) = false + member this.IsNumeric = true + member this.Legend = sprintf $"%s{columnName}" + member this.PriorityInCategory = 1 + member this.UnitType = UnitType.Size + +type MatrixColumn(name, getShape) = + inherit CommonColumn( + (fun benchmarkCase -> benchmarkCase.Parameters.["InputMatrixReader"] :?> MtxReader), + name, + getShape) + +type Matrix2Column(name, getShape) = + inherit CommonColumn( + (fun benchmarkCase -> benchmarkCase.Parameters.["InputMatrixReader"] :?> MtxReader * MtxReader), + name, + getShape) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs new file mode 100644 index 00000000..0d1c51d0 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs @@ -0,0 +1,77 @@ +module GraphBLAS.FSharp.Benchmarks.Configs + +open BenchmarkDotNet.Columns +open BenchmarkDotNet.Toolchains.InProcess.Emit +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Configs +open BenchmarkDotNet.Jobs +open GraphBLAS.FSharp.Benchmarks.Columns + +type Matrix2() = + inherit ManualConfig() + + do + base.AddColumn( + Matrix2Column("RowCount", (fun (matrix,_) -> matrix.ReadMatrixShape().RowCount)) :> IColumn, + Matrix2Column("ColumnCount", (fun (matrix,_) -> matrix.ReadMatrixShape().ColumnCount)) :> IColumn, + Matrix2Column( + "NNZ", + fun (matrix,_) -> + match matrix.Format with + | Coordinate -> matrix.ReadMatrixShape().Nnz + | Array -> 0 + ) + :> IColumn, + Matrix2Column( + "SqrNNZ", + fun (_,matrix) -> + match matrix.Format with + | Coordinate -> matrix.ReadMatrixShape().Nnz + | Array -> 0 + ) + :> IColumn, + StatisticColumn.Min, + StatisticColumn.Max + ) + |> ignore + +type Matrix() = + inherit ManualConfig() + + do + base.AddColumn( + MatrixColumn("RowCount", (fun matrix -> matrix.ReadMatrixShape().RowCount)) :> IColumn, + MatrixColumn("ColumnCount", (fun matrix -> matrix.ReadMatrixShape().ColumnCount)) :> IColumn, + MatrixColumn( + "NNZ", + fun matrix -> + match matrix.Format with + | Coordinate -> matrix.ReadMatrixShape().Nnz + | Array -> 0 + ) + :> IColumn, + StatisticColumn.Min, + StatisticColumn.Max + ) + |> ignore + + base.AddJob( + Job + .Dry + .WithToolchain(InProcessEmitToolchain.Instance) + .WithWarmupCount(3) + .WithIterationCount(10) + .WithInvocationCount(3) + ) + |> ignore + +type MinMaxMean() = + inherit ManualConfig() + + do + base.AddColumn( + StatisticColumn.Min, + StatisticColumn.Max, + StatisticColumn.Mean + ) + |> ignore diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index 689d84c0..e3a8d920 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -16,15 +16,15 @@ - - - - - + + - - + + + + + diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs index 734d9b15..4183e1d1 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs @@ -1,135 +1,19 @@ namespace rec GraphBLAS.FSharp.Benchmarks -open BenchmarkDotNet.Columns -open BenchmarkDotNet.Reports -open BenchmarkDotNet.Running +namespace GraphBLAS.FSharp.Benchmarks + open Brahma.FSharp open Brahma.FSharp.OpenCL.Translator +open Brahma.FSharp.OpenCL.Translator.QuotationTransformers +open GraphBLAS.FSharp.Backend.Objects open OpenCL.Net -open GraphBLAS.FSharp.IO open System.IO open System.Text.RegularExpressions -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Jobs open GraphBLAS.FSharp.Tests open FsCheck open Expecto open GraphBLAS.FSharp.Test -type CommonConfig() = - inherit ManualConfig() - - do - base.AddColumn( - MatrixShapeColumn("RowCount", (fun (mtxReader, _) -> mtxReader.ReadMatrixShape().RowCount)) :> IColumn, - MatrixShapeColumn("ColumnCount", (fun (mtxReader, _) -> mtxReader.ReadMatrixShape().ColumnCount)) :> IColumn, - MatrixShapeColumn("NNZ", (fun (mtxReader, _) -> mtxReader.ReadMatrixShape().Nnz)) :> IColumn, - MatrixShapeColumn("SqrNNZ", (fun (_, mtxReader) -> mtxReader.ReadMatrixShape().Nnz)) :> IColumn, - TEPSColumn(fun (parameters: obj) -> parameters :?> MtxReader * MtxReader |> fst) :> IColumn, - StatisticColumn.Min, - StatisticColumn.Max - ) - |> ignore - - base.AddJob( - Job - .Dry - .WithWarmupCount(3) - .WithIterationCount(10) - .WithInvocationCount(3) - ) - |> ignore - -type AlgorithmConfig() = - inherit ManualConfig() - - do - base.AddColumn( - MatrixShapeColumn("RowCount", (fun (mtxReader) -> mtxReader.ReadMatrixShape().RowCount)) :> IColumn, - MatrixShapeColumn("ColumnCount", (fun (mtxReader) -> mtxReader.ReadMatrixShape().ColumnCount)) :> IColumn, - MatrixShapeColumn("NNZ", (fun (mtxReader) -> mtxReader.ReadMatrixShape().Nnz)) :> IColumn, - TEPSColumn(fun (parameters: obj) -> parameters :?> MtxReader) :> IColumn, - StatisticColumn.Min, - StatisticColumn.Max - ) - |> ignore - - base.AddJob( - Job - .Dry - .WithWarmupCount(3) - .WithIterationCount(10) - .WithInvocationCount(3) - ) - |> ignore - -type MatrixShapeColumn<'shape>(columnName: string, getShape: 'shape -> int) = - interface IColumn with - member this.AlwaysShow: bool = true - member this.Category: ColumnCategory = ColumnCategory.Params - member this.ColumnName: string = columnName - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase) : string = - let inputMatrix = - benchmarkCase.Parameters.["InputMatrixReader"] :?> 'shape - - sprintf "%i" <| getShape inputMatrix - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase, style: SummaryStyle) : string = - (this :> IColumn).GetValue(summary, benchmarkCase) - - member this.Id: string = - sprintf "%s.%s" "MatrixShapeColumn" columnName - - member this.IsAvailable(summary: Summary) : bool = true - member this.IsDefault(summary: Summary, benchmarkCase: BenchmarkCase) : bool = false - member this.IsNumeric: bool = true - member this.Legend: string = sprintf "%s of input matrix" columnName - member this.PriorityInCategory: int = 1 - member this.UnitType: UnitType = UnitType.Size - -type TEPSColumn(getMtxReader: obj -> MtxReader) = - interface IColumn with - member this.AlwaysShow: bool = true - member this.Category: ColumnCategory = ColumnCategory.Statistics - member this.ColumnName: string = "TEPS" - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase) : string = - let inputMatrixReader = getMtxReader benchmarkCase.Parameters.["InputMatrixReader"] - - let matrixShape = inputMatrixReader.ReadMatrixShape() - - let (nrows, ncols) = - matrixShape.RowCount, matrixShape.ColumnCount - - let (vertices, edges) = - match inputMatrixReader.Format with - | Coordinate -> - if nrows = ncols then - (nrows, matrixShape.Nnz) - else - (ncols, nrows) - | _ -> failwith "Unsupported" - - if isNull summary.[benchmarkCase].ResultStatistics then - "NA" - else - let meanTime = - summary.[benchmarkCase].ResultStatistics.Mean - - sprintf "%f" <| float edges / (meanTime * 1e-6) - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase, style: SummaryStyle) : string = - (this :> IColumn).GetValue(summary, benchmarkCase) - - member this.Id: string = "TEPSColumn" - member this.IsAvailable(summary: Summary) : bool = true - member this.IsDefault(summary: Summary, benchmarkCase: BenchmarkCase) : bool = false - member this.IsNumeric: bool = true - member this.Legend: string = "Traversed edges per second" - member this.PriorityInCategory: int = 0 - member this.UnitType: UnitType = UnitType.Dimensionless - module Utils = type BenchmarkContext = { ClContext: Brahma.FSharp.ClContext @@ -218,7 +102,7 @@ module Utils = .GetDeviceInfo(device, DeviceInfo.Type, &e) .CastTo() - let clDeviceType = + let _ = match deviceType with | DeviceType.Cpu -> ClDeviceType.Cpu | DeviceType.Gpu -> ClDeviceType.Gpu @@ -248,9 +132,44 @@ module Utils = random.NextBytes buffer System.BitConverter.ToSingle(buffer, 0) + let normalFloatGenerator = + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + + let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x.Equals y + let nextInt (random: System.Random) = random.Next() +module Operations = + let inline add () = <@ fun x y -> Some(x + y) @> + + let addWithFilter = <@ fun x y -> + let res = x + y + if abs res < 1e-8f then None else Some res + @> + + let inline mult () = <@ fun x y -> Some <|x * y @> + + let logicalOr = <@ fun x y -> + let mutable res = None + + match x, y with + | false, false -> res <- None + | _ -> res <- Some true + + res @> + + let logicalAnd = <@ fun x y -> + let mutable res = None + + match x, y with + | true, true -> res <- Some true + | _ -> res <- None + + res @> + module VectorGenerator = let private pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) createVector = gen { @@ -268,23 +187,19 @@ module VectorGenerator = |> pairOfVectorsOfEqualSize Arb.generate let floatPair format = - let normalFloatGenerator = - (Arb.Default.NormalFloat() - |> Arb.toGen - |> Gen.map float) - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y let createVector array = Utils.createVectorFromArray format array (fIsEqual 0.0) - pairOfVectorsOfEqualSize normalFloatGenerator createVector + pairOfVectorsOfEqualSize Utils.normalFloatGenerator createVector + module MatrixGenerator = let private pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) createMatrix = gen { - let! nrows, ncols = Generators.dimension2DGenerator - let! matrixA = valuesGenerator |> Gen.array2DOfDim (nrows, ncols) - let! matrixB = valuesGenerator |> Gen.array2DOfDim (nrows, ncols) + let! rowsCount, columnsCount = Generators.dimension2DGenerator + let! matrixA = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) + let! matrixB = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) return (createMatrix matrixA, createMatrix matrixB) } @@ -293,12 +208,47 @@ module MatrixGenerator = |> pairOfMatricesOfEqualSizeGenerator Arb.generate let floatPairOfEqualSizes format = - let normalFloatGenerator = - (Arb.Default.NormalFloat() - |> Arb.toGen - |> Gen.map float) + fun array -> Utils.createMatrixFromArray2D format array (Utils.fIsEqual 0.0) + |> pairOfMatricesOfEqualSizeGenerator Utils.normalFloatGenerator - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y + let private pairOfMatricesWithMaskOfEqualSizeGenerator (valuesGenerator: Gen<'a>) format createMatrix = + gen { + let! rowsCount, columnsCount = Generators.dimension2DGenerator + let! matrixA = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) + let! matrixB = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) + let! mask = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) + + return (createMatrix format matrixA, + createMatrix format matrixB, + createMatrix COO mask) + } + + let intPairWithMaskOfEqualSizes format = + fun format array -> Utils.createMatrixFromArray2D format array ((=) 0) + |> pairOfMatricesWithMaskOfEqualSizeGenerator Arb.generate format + + let floatPairWithMaskOfEqualSizes format = + fun format array -> Utils.createMatrixFromArray2D format array (Utils.fIsEqual 0.0) + |> pairOfMatricesWithMaskOfEqualSizeGenerator Utils.normalFloatGenerator format + +module MatrixVectorGenerator = + let private pairOfMatricesAndVectorGenerator (valuesGenerator: Gen<'a>) createVector createMatrix = + gen { + let! rowsCount, columnsCount = Generators.dimension2DGenerator + let! matrixA = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) + let! vector = valuesGenerator |> Gen.arrayOfLength columnsCount + + return (createMatrix matrixA, createVector vector) + } + + let intPairOfCompatibleSizes matrixFormat vectorFormat = + let createVector array = Utils.createVectorFromArray vectorFormat array ((=) 0) + let createMatrix array = Utils.createMatrixFromArray2D matrixFormat array ((=) 0) + + pairOfMatricesAndVectorGenerator Arb.generate createVector createMatrix + + let floatPairOfCompatibleSizes matrixFormat vectorFormat = + let createVector array = Utils.createVectorFromArray vectorFormat array (Utils.floatIsEqual 0.0) + let createMatrix array = Utils.createMatrixFromArray2D matrixFormat array (Utils.floatIsEqual 0.0) - fun array -> Utils.createMatrixFromArray2D format array (fIsEqual 0.0) - |> pairOfMatricesOfEqualSizeGenerator normalFloatGenerator + pairOfMatricesAndVectorGenerator Utils.normalFloatGenerator createVector createMatrix diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs index da62a739..9a7bd385 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks +namespace GraphBLAS.FSharp.Benchmarks.Matrix.Map2 open System.IO open GraphBLAS.FSharp.Backend.Quotes @@ -16,7 +16,7 @@ open GraphBLAS.FSharp.Benchmarks [] [] [)>] -type Map2Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( +type Map2<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, converterBool, @@ -108,7 +108,7 @@ type Map2BenchmarksWithoutDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceM converterBool, buildMatrix) = - inherit Map2Benchmarks<'matrixT, 'elem>( + inherit Map2<'matrixT, 'elem>( buildFunToBenchmark, converter, converterBool, @@ -140,7 +140,7 @@ type Map2BenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemO buildMatrix, resultToHost) = - inherit Map2Benchmarks<'matrixT, 'elem>( + inherit Map2<'matrixT, 'elem>( buildFunToBenchmark, converter, converterBool, @@ -176,7 +176,7 @@ type MatrixCOOMap2Float32WithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" type MatrixCOOMap2Float32WithTransferBenchmark() = @@ -189,7 +189,7 @@ type MatrixCOOMap2Float32WithTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" type MatrixCOOMap2BoolWithoutTransferBenchmark() = @@ -202,7 +202,7 @@ type MatrixCOOMap2BoolWithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" + Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" type MatrixCSRMap2Float32WithoutTransferBenchmark() = @@ -215,7 +215,7 @@ type MatrixCSRMap2Float32WithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" + Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" type MatrixCSRMap2BoolWithoutTransferBenchmark() = @@ -228,7 +228,7 @@ type MatrixCSRMap2BoolWithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" // AtLeastOne @@ -242,7 +242,7 @@ type MatrixCOOMap2AtLeastOne4BoolWithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" type MatrixCSRMap2AtLeastOne4BoolWithoutTransferBenchmark() = @@ -254,7 +254,7 @@ type MatrixCSRMap2AtLeastOne4BoolWithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" type MatrixCOOMap2AtLeastOne4Float32WithoutTransferBenchmark() = @@ -266,7 +266,7 @@ type MatrixCOOMap2AtLeastOne4Float32WithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" type MatrixCSRMap2AtLeastOne4Float32CSRWithoutTransferBenchmark() = @@ -278,4 +278,4 @@ type MatrixCSRMap2AtLeastOne4Float32CSRWithoutTransferBenchmark() = ) static member InputMatricesProvider = - Map2Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs index 133d1d6c..68c763b0 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks +namespace GraphBLAS.FSharp.Benchmarks.Matrix.SpGeMM open System.IO open GraphBLAS.FSharp.IO @@ -14,8 +14,8 @@ open GraphBLAS.FSharp.Backend [] [] [] -[)>] -type MxmBenchmarks<'elem when 'elem : struct>( +[)>] +type Masked<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, converterBool, @@ -142,7 +142,7 @@ type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( converterBool, buildMatrix) = - inherit MxmBenchmarks<'elem>( + inherit Masked<'elem>( buildFunToBenchmark, converter, converterBool, @@ -173,7 +173,7 @@ type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( converterBool, buildMatrix) = - inherit MxmBenchmarks<'elem>( + inherit Masked<'elem>( buildFunToBenchmark, converter, converterBool, @@ -210,7 +210,7 @@ type Mxm4Float32MultiplicationOnlyBenchmark() = ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" type Mxm4Float32WithTransposingBenchmark() = @@ -222,7 +222,7 @@ type Mxm4Float32WithTransposingBenchmark() = ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" type Mxm4BoolMultiplicationOnlyBenchmark() = @@ -234,7 +234,7 @@ type Mxm4BoolMultiplicationOnlyBenchmark() = ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" type Mxm4BoolWithTransposingBenchmark() = @@ -246,7 +246,7 @@ type Mxm4BoolWithTransposingBenchmark() = ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" type Mxm4Float32MultiplicationOnlyWithZerosFilterBenchmark() = @@ -258,7 +258,7 @@ type Mxm4Float32MultiplicationOnlyWithZerosFilterBenchmark() = ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" type Mxm4Float32WithTransposingWithZerosFilterBenchmark() = @@ -270,4 +270,4 @@ type Mxm4Float32WithTransposingWithZerosFilterBenchmark() = ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs index 20749b67..1da659bc 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs @@ -4,7 +4,7 @@ open BenchmarkDotNet.Running [] let main argv = let benchmarks = - BenchmarkSwitcher [| typeof |] + BenchmarkSwitcher [| typeof |] benchmarks.Run argv |> ignore 0 diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs index 0ca9069a..4241d8da 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks +namespace GraphBLAS.FSharp.Benchmarks.Vector namespace GraphBLAS.FSharp.Benchmarks.Synthetic @@ -18,8 +18,8 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext [] [] [] -[)>] -type VectorEWiseBenchmarks<'elem when 'elem : struct>( +[)>] +type Map2<'elem when 'elem : struct>( buildFunToBenchmark, generator: Gen * Vector<'elem>>) = @@ -33,7 +33,7 @@ type VectorEWiseBenchmarks<'elem when 'elem : struct>( member val ResultVector = Unchecked.defaultof> with get,set - [] + [] member val OclContextInfo = Unchecked.defaultof with get, set [] @@ -44,10 +44,10 @@ type VectorEWiseBenchmarks<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + p.Error.Add(fun e -> failwithf $"%A{e}") p - static member AvaliableContexts = Utils.avaliableContexts + static member AvailableContexts = Utils.avaliableContexts member this.FunToBenchmark = match funToBenchmark with @@ -95,7 +95,7 @@ type VectorEWiseBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( buildFunToBenchmark, generator) = - inherit VectorEWiseBenchmarks<'elem>( + inherit Map2<'elem>( buildFunToBenchmark, generator) @@ -125,7 +125,7 @@ type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( buildFunToBenchmark, generator) = - inherit VectorEWiseBenchmarks<'elem>( + inherit Map2<'elem>( buildFunToBenchmark, generator) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 5e0ba6c4..737f196e 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -56,7 +56,7 @@ module ArithmeticOperations = if res = zero then None else Some res @> - let boolSum = + let boolSumOption = <@ fun (x: bool option) (y: bool option) -> let mutable res = false diff --git a/src/GraphBLAS-sharp/IO/MtxReader.fs b/src/GraphBLAS-sharp/IO/MtxReader.fs index 6059b8bc..db4d4d5a 100644 --- a/src/GraphBLAS-sharp/IO/MtxReader.fs +++ b/src/GraphBLAS-sharp/IO/MtxReader.fs @@ -42,7 +42,7 @@ type MtxReader(pathToFile: string) = ColumnCount = ncols Nnz = nnz |} - member this.ReadMatrix(converter: string -> 'a) : Matrix<'a> = + member this.ReadMatrix(converter: string -> 'a) : Matrix.COO<'a> = if object <> MtxMatrix then failwith "Object is not matrix" @@ -119,12 +119,11 @@ type MtxReader(pathToFile: string) = values.[i] <- value) sortedData - Matrix.COO - { Rows = rows - Columns = cols - Values = values - RowCount = n - ColumnCount = m } + { Matrix.COO.Rows = rows + Matrix.COO.Columns = cols + Matrix.COO.Values = values + Matrix.COO.RowCount = n + Matrix.COO.ColumnCount = m } match format with | Coordinate -> matrixFromCoordinateFormat () diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index e0724e8e..c1ed4c33 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -73,7 +73,7 @@ module Matrix = Values = values } static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = - let rows, cols, vals = + let rows, cols, values = array |> Seq.cast<'a> |> Seq.mapi (fun idx v -> (idx / Array2D.length2 array, idx % Array2D.length2 array, v)) @@ -81,7 +81,7 @@ module Matrix = |> Array.ofSeq |> Array.unzip3 - COO.FromTuples(Array2D.length1 array, Array2D.length2 array, rows, cols, vals) + COO.FromTuples(Array2D.length1 array, Array2D.length2 array, rows, cols, values) member this.ToDevice(context: ClContext) = { Context = context @@ -91,7 +91,7 @@ module Matrix = Columns = context.CreateClArray this.Columns Values = context.CreateClArray this.Values } - member this.toCSR = + member this.ToCSR = let rowPointers = let nnzPerRow = Array.zeroCreate this.RowCount let rowPointers = Array.zeroCreate this.RowCount diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 738224d5..0e8eda2f 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -6,31 +6,6 @@ open Expecto.Logging open Expecto.Logging.Message open FSharp.Quotations.Evaluator -[] -module Extensions = - type ClosedBinaryOp<'a> with - member this.Invoke = - let (ClosedBinaryOp f) = this - QuotationEvaluator.Evaluate f - -module CustomDatatypes = - // мб заменить рекорд на структуру (не помогает) - [] - type WrappedInt = - { InnerValue: int } - static member (+)(x: WrappedInt, y: WrappedInt) = - { InnerValue = x.InnerValue + y.InnerValue } - - static member (*)(x: WrappedInt, y: WrappedInt) = - { InnerValue = x.InnerValue * y.InnerValue } - - let addMultSemiringOnWrappedInt: Semiring = - { PlusMonoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = { InnerValue = 0 } } - - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - module Generators = let logger = Log.create "Generators" @@ -311,13 +286,6 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen - static member WrappedInt() = - pairOfMatrixAndVectorOfCompatibleSizeGenerator - |> genericSparseGenerator - CustomDatatypes.addMultSemiringOnWrappedInt.PlusMonoid.Identity - Arb.generate - |> Arb.fromGen - type PairOfSparseVectorAndMatrixAndMaskOfCompatibleSize() = static let pairOfVectorAndMatrixOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = gen { diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index 9c1fdf6e..3d179e21 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -114,7 +114,7 @@ let testFixturesMap2Add case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumOption Matrix.map2 creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumOption Matrix.map2 if Utils.isFloat64Available context.ClDevice then diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index 0ff08e3f..cfb16b53 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -107,7 +107,7 @@ let addTestFixtures case = createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumOption Vector.map2 createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumOption Vector.map2 - createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 + createTest case (=) false (||) ArithmeticOperations.boolSumOption Vector.map2 createTest case (=) 0uy (+) ArithmeticOperations.byteSumOption Vector.map2 ] let addTests = diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index db42fd9d..252c45ba 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -104,7 +104,7 @@ let testFixturesSpMV (testContext: TestContext) = let q = testContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMulOption + createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSumOption ArithmeticOperations.boolMulOption createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption if Utils.isFloat64Available context.ClDevice then From 1d45950da21e198c3f3e48929c335146c6f27dae Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 23 Apr 2023 10:22:35 +0300 Subject: [PATCH 090/143] refactor: README --- README.md | 23 +- .../Algorithms/{BFS.fs => Benchmark.fs} | 152 ++++---- .../GraphBLAS-sharp.Benchmarks.fsproj | 3 +- .../GraphBLAS-sharp.Benchmarks/Helpers.fs | 42 +- .../Matrix/Map2/Map2.fs | 360 +++++++++--------- .../Matrix/SpGeMM/Expand.fs | 148 +++++++ .../Matrix/SpGeMM/Masked.fs | 2 +- .../GraphBLAS-sharp.Benchmarks/Program.fs | 2 +- .../GraphBLAS-sharp.Benchmarks/Vector/Map2.fs | 173 +++++---- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 89 ++--- .../Common/Sort/Radix.fs | 18 +- .../Matrix/CSR/Matrix.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 4 +- .../Matrix/SpGeMM/Expand.fs | 14 +- .../Vector/Dense/Vector.fs | 2 +- .../Common/ClArray/ChunkBySize.fs | 36 +- tests/GraphBLAS-sharp.Tests/Generators.fs | 66 +++- 17 files changed, 648 insertions(+), 490 deletions(-) rename benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/{BFS.fs => Benchmark.fs} (54%) create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs diff --git a/README.md b/README.md index 87c72287..c58f7839 100644 --- a/README.md +++ b/README.md @@ -25,27 +25,32 @@ GraphBLAS# is a GPGPU-based [GraphBLAS](https://graphblas.org/)-like API impleme ### Operations - **Matrix-Matrix** - - [x] COO-COO `map2` - [x] CSR-CSR `map2` + - [x] CSR-CSR `map2AtLeastOne` + - [x] COO-COO `map2` + - [x] COO-COO `map2AtLeastOne` - [x] CSR-CSR multiplication - **Vector-Matrix** - [x] Dense-CSR multiplication - - [ ] COO-CSR multiplication + - [ ] Sparse-CSR multiplication - **Vector-Vector** - - [x] Dense-Dense element-wise - - [x] Sparse-Sparse element-wise + - [x] Dense-Dense `map2` + - [x] Dense-Dense `map2AtLeastOne` + - [x] Sparse-Sparse `map2` + - [x] Sparse-Sparse `map2AtLeastOne` - [ ] ... - **Matrix** + - [x] `copy` - [x] `map` - [x] COO transpose - [x] CSR transpose - - [ ] `iter` + - [x] CSC transpose - [ ] ... - **Vector** - - [x] `map` - - [ ] `iter` - - [ ] `filter` - - [ ] `contains` + - [x] `zeroCreate` + - [x] `ofList` + - [x] `copy` + - [x] `reduce` - [ ] ... ### Graph Analysis Algorithms diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/Benchmark.fs similarity index 54% rename from benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs rename to benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/Benchmark.fs index 365db3df..4711b9cc 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/Benchmark.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks.Algorithms +namespace GraphBLAS.FSharp.Benchmarks.Algorithms.BFS open System.IO open BenchmarkDotNet.Attributes @@ -16,7 +16,7 @@ open GraphBLAS.FSharp.Backend.Objects [] [] [)>] -type BFS<'elem when 'elem : struct>( +type Benchmarks<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, binaryConverter, @@ -43,7 +43,7 @@ type BFS<'elem when 'elem : struct>( p.Error.Add(fun e -> failwithf "%A" e) p - static member AvailableContexts = Utils.avaliableContexts + static member AvailableContexts = Utils.availableContexts static member InputMatrixProviderBuilder pathToConfig = let datasetFolder = "BFS" @@ -92,87 +92,89 @@ type BFS<'elem when 'elem : struct>( abstract member Benchmark : unit -> unit -type BFSBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - boolConverter, - vertex) = - - inherit BFS<'elem>( - buildFunToBenchmark, - converter, - boolConverter, - vertex) - - [] - override this.GlobalSetup() = - this.ReadMatrix() - this.LoadMatrixToGPU() - - [] - override this.IterationCleanup() = - this.ClearResult() - - [] - override this.GlobalCleanup() = - this.ClearInputMatrix() - - [] - override this.Benchmark() = - this.BFS() - this.Processor.PostAndReply Msg.MsgNotifyMe - -type BFSBenchmarksWithTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - boolConverter, - vertex) = - - inherit BFS<'elem>( +module WithoutTransfer = + type Benchmark<'elem when 'elem : struct>( buildFunToBenchmark, - converter, + converter: string -> 'elem, boolConverter, - vertex) - - [] - override this.GlobalSetup() = - this.ReadMatrix() + vertex) = - [] - override this.GlobalCleanup() = - this.ClearResult() + inherit Benchmarks<'elem>( + buildFunToBenchmark, + converter, + boolConverter, + vertex) - [] - override this.IterationCleanup() = - this.ClearInputMatrix() - this.ClearResult() + [] + override this.GlobalSetup() = + this.ReadMatrix() + this.LoadMatrixToGPU() - [] - override this.Benchmark() = - this.LoadMatrixToGPU() - this.BFS() - this.ResultLevels.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe + [] + override this.IterationCleanup() = + this.ClearResult() -type BFSIntWithoutTransferBenchmark() = + [] + override this.GlobalCleanup() = + this.ClearInputMatrix() - inherit BFSBenchmarksWithoutDataTransfer( - (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), - int32, - (fun _ -> Utils.nextInt (System.Random())), - 0) + [] + override this.Benchmark() = + this.BFS() + this.Processor.PostAndReply Msg.MsgNotifyMe - static member InputMatrixProvider = - BFS<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + type Int() = -type BFSIntWithTransferBenchmark() = + inherit Benchmark( + (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) - inherit BFSBenchmarksWithTransfer( - (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), - int32, - (fun _ -> Utils.nextInt (System.Random())), - 0) + static member InputMatrixProvider = + Benchmark<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" - static member InputMatrixProvider = - BFS<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" +module WithTransfer = + type Benchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + boolConverter, + vertex) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + converter, + boolConverter, + vertex) + + [] + override this.GlobalSetup() = + this.ReadMatrix() + + [] + override this.GlobalCleanup() = + this.ClearResult() + + [] + override this.IterationCleanup() = + this.ClearInputMatrix() + this.ClearResult() + + [] + override this.Benchmark() = + this.LoadMatrixToGPU() + this.BFS() + this.ResultLevels.ToHost this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + + type Int() = + + inherit Benchmark( + (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) + + static member InputMatrixProvider = + Benchmark<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index e3a8d920..1a5d1710 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -21,10 +21,11 @@ + - + diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs index 4183e1d1..0d292f3c 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs @@ -38,7 +38,7 @@ module Utils = datasetsFolder matrixFilename |] - let avaliableContexts = + let availableContexts = let pathToConfig = Path.Combine [| __SOURCE_DIRECTORY__ "Configs" @@ -97,18 +97,6 @@ module Utils = .ToString() |> Platform.Custom - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - let _ = - match deviceType with - | DeviceType.Cpu -> ClDeviceType.Cpu - | DeviceType.Gpu -> ClDeviceType.Gpu - | DeviceType.Default -> ClDeviceType.Default - | _ -> failwith "Unsupported" - let device = ClDevice.GetFirstAppropriateDevice(clPlatform) @@ -142,34 +130,6 @@ module Utils = let nextInt (random: System.Random) = random.Next() -module Operations = - let inline add () = <@ fun x y -> Some(x + y) @> - - let addWithFilter = <@ fun x y -> - let res = x + y - if abs res < 1e-8f then None else Some res - @> - - let inline mult () = <@ fun x y -> Some <|x * y @> - - let logicalOr = <@ fun x y -> - let mutable res = None - - match x, y with - | false, false -> res <- None - | _ -> res <- Some true - - res @> - - let logicalAnd = <@ fun x y -> - let mutable res = None - - match x, y with - | true, true -> res <- Some true - | _ -> res <- None - - res @> - module VectorGenerator = let private pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) createVector = gen { diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs index 9a7bd385..b2fb0bc6 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs @@ -16,7 +16,7 @@ open GraphBLAS.FSharp.Benchmarks [] [] [)>] -type Map2<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( +type Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, converterBool, @@ -44,7 +44,7 @@ type Map2<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( p.Error.Add(fun e -> failwithf "%A" e) p - static member AvailableContexts = Utils.avaliableContexts + static member AvailableContexts = Utils.availableContexts static member InputMatricesProviderBuilder pathToConfig = let datasetFolder = "EWiseAdd" @@ -102,180 +102,184 @@ type Map2<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( abstract member GlobalCleanup: unit -> unit -type Map2BenchmarksWithoutDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - inherit Map2<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrices () - this.LoadMatricesToGPU () - this.Processor.PostAndReply(Msg.MsgNotifyMe) - - [] - override this.Benchmark () = - this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - - [] - override this.IterationCleanup () = - this.ClearResult() - - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - -type Map2BenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix, - resultToHost) = - - inherit Map2<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrices() - - [] - override this.GlobalCleanup() = () - - [] - override this.IterationCleanup() = - this.ClearInputMatrices() - this.ClearResult() - - [] - override this.Benchmark() = - this.LoadMatricesToGPU() - this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe - resultToHost this.ResultMatrix this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe - -type MatrixCOOMap2Float32WithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,float32>( - (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.COO - ) - - static member InputMatricesProvider = - Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type MatrixCOOMap2Float32WithTransferBenchmark() = - - inherit Map2BenchmarksWithDataTransfer,float32>( - (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.COO, - (fun matrix -> matrix.ToHost) - ) - - static member InputMatricesProvider = - Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - - -type MatrixCOOMap2BoolWithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,bool>( - (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), - (fun _ -> true), - (fun _ -> true), - Matrix.COO - ) - - static member InputMatricesProvider = - Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" - - -type MatrixCSRMap2Float32WithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,float32>( - (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - (fun matrix -> Matrix.CSR matrix.ToCSR) - ) - - static member InputMatricesProvider = - Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" - - -type MatrixCSRMap2BoolWithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,bool>( - (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), - (fun _ -> true), - (fun _ -> true), - (fun matrix -> Matrix.CSR matrix.ToCSR) - ) - - static member InputMatricesProvider = - Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -// AtLeastOne - -type MatrixCOOMap2AtLeastOne4BoolWithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,bool>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), - (fun _ -> true), - (fun _ -> true), - Matrix.COO - ) - - static member InputMatricesProvider = - Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type MatrixCSRMap2AtLeastOne4BoolWithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,bool>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), - (fun _ -> true), - (fun _ -> true), - (fun matrix -> Matrix.CSR matrix.ToCSR) - ) - - static member InputMatricesProvider = - Map2<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type MatrixCOOMap2AtLeastOne4Float32WithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,float32>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.COO - ) - - static member InputMatricesProvider = - Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type MatrixCSRMap2AtLeastOne4Float32CSRWithoutTransferBenchmark() = - - inherit Map2BenchmarksWithoutDataTransfer,float32>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - (fun matrix -> Matrix.CSR matrix.ToCSR) - ) +module WithoutTransfer = + type Benchmark<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit Benchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices () + this.LoadMatricesToGPU () + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.Benchmark () = + this.EWiseAddition() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + module COO = + type Float32() = + + inherit Benchmark,float32>( + (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + + type Bool() = + + inherit Benchmark,bool>( + (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), + (fun _ -> true), + (fun _ -> true), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" + + module CSR = + type Float32() = + + inherit Benchmark,float32>( + (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" + + type Bool() = + + inherit Benchmark,bool>( + (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), + (fun _ -> true), + (fun _ -> true), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + + module AtLeastOne = + module COO = + type Bool() = + + inherit Benchmark,bool>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), + (fun _ -> true), + (fun _ -> true), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" + + type Float32() = + + inherit Benchmark,float32>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + + module CSR = + type Bool() = + + inherit Benchmark,bool>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), + (fun _ -> true), + (fun _ -> true), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + + type Float32() = + + inherit Benchmark,float32>( + (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + +module WithTransfer = + type Benchmark<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix, + resultToHost) = + + inherit Benchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices() + + [] + override this.GlobalCleanup() = () + + [] + override this.IterationCleanup() = + this.ClearInputMatrices() + this.ClearResult() + + [] + override this.Benchmark() = + this.LoadMatricesToGPU() + this.EWiseAddition() + this.Processor.PostAndReply Msg.MsgNotifyMe + resultToHost this.ResultMatrix this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + + module COO = + type Float32() = + + inherit Benchmark,float32>( + (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO, + (fun matrix -> matrix.ToHost) + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - static member InputMatricesProvider = - Map2<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs new file mode 100644 index 00000000..a99730b9 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -0,0 +1,148 @@ +module GraphBLAS.FSharp.Benchmarks.Matrix.SpGeMM.Expand + +open System.IO +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Attributes +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Benchmarks +open GraphBLAS.FSharp.Backend + +[] +[] +[] +[)>] +type Benchmarks<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + let mutable funToBenchmark = None + + let mutable firstMatrix = Unchecked.defaultof> + let mutable secondMatrix = Unchecked.defaultof> + + let mutable firstMatrixHost = Unchecked.defaultof<_> + let mutable secondMatrixHost = Unchecked.defaultof<_> + + member val ResultMatrix = Unchecked.defaultof> with get, set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvailableContexts = Utils.availableContexts + + static member InputMatrixProviderBuilder pathToConfig = + let datasetFolder = "Mxm" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> + MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + , MtxReader(Utils.getFullPathToMatrix datasetFolder (matrixFilename)) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.ReadMatrix (reader: MtxReader) = + let converter = + match reader.Field with + | Pattern -> converterBool + | _ -> converter + + reader.ReadMatrix converter + + member this.Mxm() = + this.ResultMatrix <- this.FunToBenchmark this.Processor DeviceOnly firstMatrix secondMatrix + + member this.ClearInputMatrices() = + firstMatrix.Dispose this.Processor + secondMatrix.Dispose this.Processor + + member this.ClearResult() = + this.ResultMatrix.Dispose this.Processor + + member this.ReadMatrices() = + firstMatrixHost <- this.ReadMatrix this.InputMatrixReader + secondMatrixHost <- this.ReadMatrix this.InputMatrixReader + + member this.LoadMatricesToGPU () = + firstMatrix <- buildMatrix this.OclContext firstMatrixHost + secondMatrix <- buildMatrix this.OclContext secondMatrixHost + + abstract member GlobalSetup : unit -> unit + + abstract member Benchmark : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + +type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices() + this.LoadMatricesToGPU() + + [] + override this.Benchmark() = + this.Mxm() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + +// type Mxm4Float32WithTransposingWithZerosFilterBenchmark() = +// +// inherit MxmBenchmarksWithTransposing( +// (fun context wgSize -> Matrix.SpGeMM.expand context wgSize (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul)), +// float32, +// (fun _ -> Utils.nextSingle (System.Random())), +// (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) +// ) +// +// static member InputMatrixProvider = +// Benchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs index 68c763b0..8e909388 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs @@ -49,7 +49,7 @@ type Masked<'elem when 'elem : struct>( p.Error.Add(fun e -> failwithf "%A" e) p - static member AvaliableContexts = Utils.avaliableContexts + static member AvaliableContexts = Utils.availableContexts static member InputMatrixProviderBuilder pathToConfig = let datasetFolder = "Mxm" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs index 1da659bc..ea487610 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs @@ -4,7 +4,7 @@ open BenchmarkDotNet.Running [] let main argv = let benchmarks = - BenchmarkSwitcher [| typeof |] + BenchmarkSwitcher [| typeof |] benchmarks.Run argv |> ignore 0 diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs index 4241d8da..c39c207f 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -1,6 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks.Vector - -namespace GraphBLAS.FSharp.Benchmarks.Synthetic +module GraphBLAS.FSharp.Benchmarks.Vector.Map2 open FsCheck open BenchmarkDotNet.Attributes @@ -19,7 +17,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext [] [] [)>] -type Map2<'elem when 'elem : struct>( +type Benchmarks<'elem when 'elem : struct>( buildFunToBenchmark, generator: Gen * Vector<'elem>>) = @@ -47,7 +45,7 @@ type Map2<'elem when 'elem : struct>( p.Error.Add(fun e -> failwithf $"%A{e}") p - static member AvailableContexts = Utils.avaliableContexts + static member AvailableContexts = Utils.availableContexts member this.FunToBenchmark = match funToBenchmark with @@ -90,115 +88,114 @@ type Map2<'elem when 'elem : struct>( abstract member GlobalCleanup: unit -> unit +module WithoutTransfer = + type Benchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + generator) = -type VectorEWiseBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - generator) = - - inherit Map2<'elem>( - buildFunToBenchmark, - generator) + inherit Benchmarks<'elem>( + buildFunToBenchmark, + generator) - [] - override this.GlobalSetup() = () + [] + override this.GlobalSetup() = () - [] - override this.IterationSetup() = - this.CreateVectors() - this.LoadVectorsToGPU() - this.Processor.PostAndReply Msg.MsgNotifyMe + [] + override this.IterationSetup() = + this.CreateVectors() + this.LoadVectorsToGPU() + this.Processor.PostAndReply Msg.MsgNotifyMe - [] - override this.Benchmark() = - this.Map2() - this.Processor.PostAndReply Msg.MsgNotifyMe + [] + override this.Benchmark() = + this.Map2() + this.Processor.PostAndReply Msg.MsgNotifyMe - [] - override this.IterationCleanup() = - this.ClearResult() - this.ClearInputVectors() + [] + override this.IterationCleanup() = + this.ClearResult() + this.ClearInputVectors() - [] - override this.GlobalCleanup() = () + [] + override this.GlobalCleanup() = () -type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - generator) = + type Float() = - inherit Map2<'elem>( - buildFunToBenchmark, - generator) + inherit Benchmark( + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) - [] - override this.GlobalSetup() = () + type Int32() = - [] - override this.IterationSetup() = - this.CreateVectors() + inherit Benchmark( + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) - [] - override this.Benchmark () = - this.LoadVectorsToGPU() - this.Map2() - this.ResultVector.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe + module AtLeastOne = + type Float() = - [] - override this.IterationCleanup () = - this.ClearInputVectors() - this.ClearResult() + inherit Benchmark( + (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.floatSumAtLeastOne), + VectorGenerator.floatPair Sparse) - [] - override this.GlobalCleanup() = () + type Int32() = -/// Without data transfer -type VectorSparseMap2FloatWithoutTransferBenchmark() = + inherit Benchmark( + (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.intSumAtLeastOne), + VectorGenerator.intPair Sparse) - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) +module WithTransfer = + type Benchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + generator) = -type VectorSparseMap2Int32WithoutTransferBenchmark() = + inherit Benchmarks<'elem>( + buildFunToBenchmark, + generator) - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) + [] + override this.GlobalSetup() = () -/// General -type VectorSparseMap2GeneralFloatWithoutTransferBenchmark() = + [] + override this.IterationSetup() = + this.CreateVectors() - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) + [] + override this.Benchmark () = + this.LoadVectorsToGPU() + this.Map2() + this.ResultVector.ToHost this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe -type VectorSparseMap2GeneralInt32WithoutTransferBenchmark() = + [] + override this.IterationCleanup () = + this.ClearInputVectors() + this.ClearResult() - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) + [] + override this.GlobalCleanup() = () -/// With data transfer -type VectorSparseMap2FloatWithTransferBenchmark() = + type Float() = - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) + inherit Benchmark( + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) -type VectorSparseMap2Int32WithTransferBenchmark() = + type Int32() = - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) + inherit Benchmark( + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) -/// Map2 with data transfer -type VectorMap2GeneralFloatSparseWithTransferBenchmark() = + module AtLeastOne = + type Float() = - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) + inherit Benchmark( + (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.floatSumAtLeastOne), + VectorGenerator.floatPair Sparse) -type VectorMap2GeneralInt32SparseWithTransferBenchmark() = + type Int32() = - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) + inherit Benchmark( + (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.intSumAtLeastOne), + VectorGenerator.intPair Sparse) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 54b59062..9d743653 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -267,7 +267,7 @@ module ClArray = result - let map2Inplace<'a, 'b, 'c> (clContext: ClContext) workGroupSize (map: Expr<'a -> 'b -> 'c>) = + let map2InPlace<'a, 'b, 'c> (clContext: ClContext) workGroupSize (map: Expr<'a -> 'b -> 'c>) = let kernel = <@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> @@ -296,7 +296,7 @@ module ClArray = let map2<'a, 'b, 'c> (clContext: ClContext) workGroupSize map = let map2 = - map2Inplace<'a, 'b, 'c> clContext workGroupSize map + map2InPlace<'a, 'b, 'c> clContext workGroupSize map fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> @@ -472,43 +472,39 @@ module ClArray = result - let getChunk (clContext: ClContext) workGroupSize = + let sub (clContext: ClContext) workGroupSize = let kernel = - <@ fun (ndRange: Range1D) startIndex endIndex (sourceArray: ClArray<'a>) (targetChunk: ClArray<'a>) -> + <@ fun (ndRange: Range1D) startIndex count (sourceArray: ClArray<'a>) (targetChunk: ClArray<'a>) -> let gid = ndRange.GlobalID0 - let sourcePosition = gid + startIndex - if sourcePosition < endIndex then + if gid < count then + let sourcePosition = gid + startIndex targetChunk.[gid] <- sourceArray.[sourcePosition] @> let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) startIndex endIndex -> - if startIndex < 0 then - failwith "startIndex is less than zero" - - if startIndex >= endIndex then - failwith "startIndex is greater than or equal to the endIndex" + fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) startIndex count -> + if count <= 0 then + failwith "Count must be greater than zero" - if endIndex > sourceArray.Length then - failwith "endIndex is larger than the size of the array" + if startIndex < 0 then + failwith "startIndex must be greater then zero" - let resultLength = endIndex - startIndex + if startIndex + count > sourceArray.Length then + failwith "startIndex and count sum is larger than the size of the array" let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, count) let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) + Range1D.CreateValid(count, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange startIndex endIndex sourceArray result) - ) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange startIndex count sourceArray result)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -524,25 +520,24 @@ module ClArray = /// let lazyChunkBySize (clContext: ClContext) workGroupSize = - let getChunk = getChunk clContext workGroupSize + let sub = sub clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> if chunkSize <= 0 then - failwith "The size of the piece cannot be less than 1" + failwith "The size of the chunk cannot be less than 1" - let chunkCount = (sourceArray.Length - 1) / chunkSize + let chunkCount = (sourceArray.Length - 1) / chunkSize + 1 - let getChunk = - getChunk processor allocationMode sourceArray + let sub = sub processor allocationMode sourceArray seq { - for i in 0 .. chunkCount do + for i in 0 .. chunkCount - 1 do let startIndex = i * chunkSize - let endIndex = - min (startIndex + chunkSize) sourceArray.Length + let count = + min chunkSize (sourceArray.Length - startIndex) - yield lazy (getChunk startIndex endIndex) + yield lazy (sub startIndex count) } /// @@ -575,24 +570,21 @@ module ClArray = let kernel = clContext.Compile assign fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> - // check count - if count < 0 then - failwith "Count must be greater than zero" - - // check sourceIndex - if sourceIndex < 0 - && sourceIndex + count >= sourceArray.Length then - failwith "The source index does not match" - - // check targetPosition - if targetIndex < 0 - && targetIndex + count >= targetArray.Length then - failwith "The target index does not match" - if count = 0 then + // nothing to do () - // nothing to do else + if count < 0 then + failwith "Count must be greater than zero" + + if sourceIndex < 0 + && sourceIndex + count >= sourceArray.Length then + failwith "The source index does not match" + + if targetIndex < 0 + && targetIndex + count >= targetArray.Length then + failwith "The target index does not match" + let ndRange = Range1D.CreateValid(targetArray.Length, workGroupSize) @@ -646,15 +638,12 @@ module ClArray = if count = 0 then () else + if count < 0 then + failwith "Count must be greater than zero" + if firstPosition + count > targetArray.Length then failwith "The array should fit completely" - if firstPosition < 0 then - failwith "The starting position cannot be less than zero" - - if count < 0 then - failwith "The count cannot be less than zero" - let ndRange = Range1D.CreateValid(count, workGroupSize) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index 6bc24183..5e4a88b4 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -7,8 +7,6 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -type Indices = ClArray - module Radix = // the number of bits considered per iteration let defaultBitCount = 4 @@ -36,7 +34,7 @@ module Radix = let bitCount = mask + 1 let kernel = - <@ fun (ndRange: Range1D) length (indices: Indices) (workGroupCount: ClCell) (shift: ClCell) (globalOffsets: Indices) (localOffsets: Indices) -> + <@ fun (ndRange: Range1D) length (indices: ClArray) (workGroupCount: ClCell) (shift: ClCell) (globalOffsets: ClArray) (localOffsets: ClArray) -> let gid = ndRange.GlobalID0 let lid = ndRange.LocalID0 @@ -77,7 +75,7 @@ module Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (indices: Indices) (clWorkGroupCount: ClCell) (shift: ClCell) -> + fun (processor: MailboxProcessor<_>) (indices: ClArray) (clWorkGroupCount: ClCell) (shift: ClCell) -> let ndRange = Range1D.CreateValid(indices.Length, workGroupSize) @@ -113,7 +111,7 @@ module Radix = let scatter (clContext: ClContext) workGroupSize mask = let kernel = - <@ fun (ndRange: Range1D) length (keys: Indices) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: Indices) (localOffsets: Indices) (result: ClArray) -> + <@ fun (ndRange: Range1D) length (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: ClArray) (localOffsets: ClArray) (result: ClArray) -> let gid = ndRange.GlobalID0 let wgId = gid / workGroupSize @@ -134,7 +132,7 @@ module Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: Indices) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: Indices) (localOffsets: Indices) (result: ClArray) -> + fun (processor: MailboxProcessor<_>) (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (result: ClArray) -> let ndRange = Range1D.CreateValid(keys.Length, workGroupSize) @@ -161,7 +159,7 @@ module Radix = let scatter = scatter clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) (keys: Indices) -> + fun (processor: MailboxProcessor<_>) (keys: ClArray) -> if keys.Length <= 1 then copy processor DeviceOnly keys // TODO(allocation mode) else @@ -203,7 +201,7 @@ module Radix = let scatterByKey (clContext: ClContext) workGroupSize mask = let kernel = - <@ fun (ndRange: Range1D) length (keys: Indices) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: Indices) (localOffsets: Indices) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: ClArray) (localOffsets: ClArray) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> let gid = ndRange.GlobalID0 let wgId = gid / workGroupSize @@ -225,7 +223,7 @@ module Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: Indices) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: Indices) (localOffsets: Indices) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (keys: ClArray) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> let ndRange = Range1D.CreateValid(keys.Length, workGroupSize) @@ -265,7 +263,7 @@ module Radix = let scatterByKey = scatterByKey clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) allocationMode (keys: Indices) (values: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a>) -> if values.Length <> keys.Length then failwith "Mismatch of key lengths and value. Lengths must be the same" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 1e95a3c0..e6857a20 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -109,9 +109,9 @@ module Matrix = let byRowsLazy (clContext: ClContext) workGroupSize = - let getChunkValues = ClArray.getChunk clContext workGroupSize + let getChunkValues = ClArray.sub clContext workGroupSize - let getChunkIndices = ClArray.getChunk clContext workGroupSize + let getChunkIndices = ClArray.sub clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 69fa630b..eb60f655 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -6,7 +6,7 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix -open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Vector module Matrix = let copy (clContext: ClContext) workGroupSize = @@ -16,7 +16,7 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize let vectorCopy = - Vector.Sparse.Vector.copy clContext workGroupSize + Sparse.Vector.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 214e8a49..0256ffd1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -14,10 +14,6 @@ open GraphBLAS.FSharp.Backend.Vector.Sparse open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ClMatrix -type Indices = ClArray - -type Values<'a> = ClArray<'a> - module Expand = let getSegmentPointers (clContext: ClContext) workGroupSize = @@ -69,7 +65,7 @@ module Expand = let rightMatrixGather = Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) length (segmentsPointers: Indices) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: MailboxProcessor<_>) length (segmentsPointers: ClArray) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> if length = 0 then None else @@ -140,7 +136,7 @@ module Expand = let scatter = Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: Indices) -> + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) -> let positions = getBitmap processor DeviceOnly firstValues secondValues @@ -172,7 +168,7 @@ module Expand = let sortKeys = Radix.standardRunKeysOnly clContext workGroupSize - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) -> + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: ClArray) -> // sort by columns let sortedValues = sortByKeyValues processor DeviceOnly columns values @@ -195,7 +191,7 @@ module Expand = let idScatter = Scatter.initFirsOccurrence Map.id clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) -> + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: ClArray) -> let bitmap = getUniqueBitmap processor DeviceOnly columns @@ -231,7 +227,7 @@ module Expand = let reduce = reduce clContext workGroupSize opAdd // left matrix last --- for curring - fun (processor: MailboxProcessor<_>) allocationMode (rightMatrix: ClMatrix.CSR<'b>) (leftMatrixRowsLengths: Indices) (leftMatrixRow: ClVector.Sparse<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (rightMatrix: ClMatrix.CSR<'b>) (leftMatrixRowsLengths: ClArray) (leftMatrixRow: ClVector.Sparse<'a>) -> // TODO(sort in range) // required right matrix lengths let length, segmentPointers = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index 813f52f6..c99c7e3b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -16,7 +16,7 @@ module Vector = = let map2InPlace = - ClArray.map2Inplace clContext workGroupSize opAdd + ClArray.map2InPlace clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs index 4501fa23..ae282f9a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs @@ -14,42 +14,40 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } -let makeTestGetChunk<'a when 'a: equality> testFun (array: 'a [], startPosition: int, endPosition: int) = +let makeTestGetChunk<'a when 'a: equality> testFun (array: 'a [], startPosition, count) = if array.Length > 0 then let clArray = context.CreateClArray array let (clActual: ClArray<'a>) = - testFun processor HostInterop clArray startPosition endPosition + testFun processor HostInterop clArray startPosition count clArray.Free processor let actual = clActual.ToHostAndFree processor "Results must be the same" - |> Expect.sequenceEqual actual array.[startPosition..endPosition - 1] + |> Expect.sequenceEqual actual (Array.sub array startPosition count) -let creatTestGetChunk<'a when 'a: equality> = - ClArray.getChunk context Utils.defaultWorkGroupSize +let creatTestSub<'a when 'a: equality> = + ClArray.sub context Utils.defaultWorkGroupSize |> makeTestGetChunk<'a> |> testPropertyWithConfig config $"test on %A{typeof<'a>}" -let getChunkTests = - [ creatTestGetChunk +let subTests = + [ creatTestSub if Utils.isFloat64Available context.ClDevice then - creatTestGetChunk + creatTestSub - creatTestGetChunk - creatTestGetChunk - creatTestGetChunk ] + creatTestSub + creatTestSub + creatTestSub ] |> testList "getChunk" -let makeTestChunkBySize<'a when 'a: equality> isEqual testFun (array: 'a [], chunkSize: uint) = - - let chunkSize = int chunkSize +let makeTestChunkBySize<'a when 'a: equality> isEqual testFun (array: 'a [], chunkSize: int) = if chunkSize > 0 && array.Length > 0 then @@ -69,10 +67,14 @@ let makeTestChunkBySize<'a when 'a: equality> isEqual testFun (array: 'a [], chu "Results must be the same" |> Utils.compareChunksArrays isEqual actual expected +let chunkBySizeConfig = + { config with + arbitrary = [ typeof ] } + let creatTestChunkBySize<'a when 'a: equality> isEqual = ClArray.chunkBySize context Utils.defaultWorkGroupSize |> makeTestChunkBySize<'a> isEqual - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + |> testPropertyWithConfig chunkBySizeConfig $"test on %A{typeof<'a>}" let chunkBySizeTests = [ creatTestChunkBySize (=) @@ -107,6 +109,6 @@ let lazyChunkBySizeTests = let allTests = testList "chunk" - [ getChunkTests + [ subTests chunkBySizeTests lazyChunkBySizeTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 0e8eda2f..089602f4 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -923,17 +923,73 @@ module Generators = pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen - type ArrayAndChunkPositions() = + type Sub() = static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = gen { - let! length = Gen.sized <| fun size -> Gen.choose (1, size) + let! length = Gen.sized <| fun size -> Gen.choose (2, size + 2) + + let! array = Gen.arrayOfLength length valuesGenerator + + let! startPosition = Gen.choose (0, length - 2) + let! count = Gen.choose (1, length - startPosition - 1) + + return (array, startPosition, count) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + type ChunkBySize() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! length = Gen.sized <| fun size -> Gen.choose (2, size + 2) let! array = Gen.arrayOfLength length valuesGenerator - let! endPosition = Gen.choose (1, length - 1) - let! startPosition = Gen.choose (0, endPosition - 1) + let! chunkSize = Gen.choose (1, length) - return (array, startPosition, endPosition) + return (array, chunkSize) } static member IntType() = From 2a5617bced21a116ab76fc37bb9056136231652a Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 23 Apr 2023 11:36:22 +0300 Subject: [PATCH 091/143] refactor: operations early binding --- .../Algorithms/{Benchmark.fs => BFS.fs} | 4 +- .../GraphBLAS-sharp.Benchmarks.fsproj | 13 ++- .../Matrix/Map2/Map2.fs | 18 ++-- .../Matrix/SpGeMM/Expand.fs | 84 +++++++++---------- .../Matrix/SpGeMM/Masked.fs | 13 +-- .../GraphBLAS-sharp.Benchmarks/Vector/Map2.fs | 16 ++-- src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs | 10 +-- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 40 +++++---- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 1 - .../Common/PrefixSum.fs | 28 +++---- .../Common/Sort/Radix.fs | 4 +- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 38 ++++----- src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs | 6 +- .../Matrix/COO/Map2.fs | 6 +- .../Matrix/COO/Map2AtLeastOne.fs | 6 +- .../Matrix/COO/Matrix.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs | 14 ++-- .../Matrix/CSR/Map2.fs | 14 ++-- .../Matrix/CSR/Map2AtLeastOne.fs | 10 +-- .../Matrix/CSR/Matrix.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 22 ++--- .../Matrix/SpGeMM/Expand.fs | 17 ++-- .../Matrix/SpGeMM/Masked.fs | 28 +++---- .../Vector/Dense/Vector.fs | 36 ++++---- src/GraphBLAS-sharp.Backend/Vector/SpMV.fs | 6 +- .../Vector/Sparse/Common.fs | 2 +- .../Vector/Sparse/Map2.fs | 12 +-- .../Vector/Sparse/Map2AtLeastOne.fs | 6 +- .../Vector/Sparse/Vector.fs | 6 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 32 +++---- tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs | 2 +- .../Common/ClArray/Choose.fs | 4 +- .../Common/ClArray/Exists.fs | 15 +--- .../Common/ClArray/Map.fs | 3 +- .../Common/ClArray/Map2.fs | 2 +- .../Common/Reduce/Reduce.fs | 2 +- .../Common/Reduce/ReduceByKey.fs | 14 ++-- .../Common/Reduce/Sum.fs | 2 +- .../Common/Scan/ByKey.fs | 2 +- .../Common/Scan/PrefixSum.fs | 2 +- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 2 +- tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 2 +- .../Matrix/SpGeMM/Expand.fs | 2 +- .../Vector/AssignByMask.fs | 2 +- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 2 +- tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs | 27 ++---- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 2 +- 48 files changed, 279 insertions(+), 312 deletions(-) rename benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/{Benchmark.fs => BFS.fs} (95%) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/Benchmark.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs similarity index 95% rename from benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/Benchmark.fs rename to benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs index 4711b9cc..035b9b2f 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/Benchmark.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -126,7 +126,7 @@ module WithoutTransfer = type Int() = inherit Benchmark( - (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), int32, (fun _ -> Utils.nextInt (System.Random())), 0) @@ -170,7 +170,7 @@ module WithTransfer = type Int() = inherit Benchmark( - (fun context -> singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), int32, (fun _ -> Utils.nextInt (System.Random())), 0) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index 1a5d1710..8c455f09 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -19,13 +19,12 @@ - - - - - - - + + + + + + diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs index b2fb0bc6..2e2582f1 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs @@ -138,7 +138,7 @@ module WithoutTransfer = type Float32() = inherit Benchmark,float32>( - (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + (Matrix.map2 ArithmeticOperations.float32SumOption), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.COO @@ -150,7 +150,7 @@ module WithoutTransfer = type Bool() = inherit Benchmark,bool>( - (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), + (Matrix.map2 ArithmeticOperations.boolSumOption), (fun _ -> true), (fun _ -> true), Matrix.COO @@ -163,7 +163,7 @@ module WithoutTransfer = type Float32() = inherit Benchmark,float32>( - (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + (Matrix.map2 ArithmeticOperations.float32SumOption), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun matrix -> Matrix.CSR matrix.ToCSR) @@ -175,7 +175,7 @@ module WithoutTransfer = type Bool() = inherit Benchmark,bool>( - (fun context -> Matrix.map2 context ArithmeticOperations.boolSumOption), + (Matrix.map2 ArithmeticOperations.boolSumOption), (fun _ -> true), (fun _ -> true), (fun matrix -> Matrix.CSR matrix.ToCSR) @@ -189,7 +189,7 @@ module WithoutTransfer = type Bool() = inherit Benchmark,bool>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), + (Matrix.map2AtLeastOne ArithmeticOperations.boolSumAtLeastOne), (fun _ -> true), (fun _ -> true), Matrix.COO @@ -201,7 +201,7 @@ module WithoutTransfer = type Float32() = inherit Benchmark,float32>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), + (Matrix.map2AtLeastOne ArithmeticOperations.float32SumAtLeastOne), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.COO @@ -214,7 +214,7 @@ module WithoutTransfer = type Bool() = inherit Benchmark,bool>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne), + (Matrix.map2AtLeastOne ArithmeticOperations.boolSumAtLeastOne), (fun _ -> true), (fun _ -> true), (fun matrix -> Matrix.CSR matrix.ToCSR) @@ -226,7 +226,7 @@ module WithoutTransfer = type Float32() = inherit Benchmark,float32>( - (fun context -> Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne), + (Matrix.map2AtLeastOne ArithmeticOperations.float32SumAtLeastOne), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun matrix -> Matrix.CSR matrix.ToCSR) @@ -273,7 +273,7 @@ module WithTransfer = type Float32() = inherit Benchmark,float32>( - (fun context -> Matrix.map2 context ArithmeticOperations.float32SumOption), + (Matrix.map2 ArithmeticOperations.float32SumOption), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.COO, diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs index a99730b9..3daf2ec4 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -104,45 +104,45 @@ type Benchmarks<'elem when 'elem : struct>( abstract member GlobalCleanup : unit -> unit -type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - inherit Benchmarks<'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrices() - this.LoadMatricesToGPU() - - [] - override this.Benchmark() = - this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - - [] - override this.IterationCleanup () = - this.ClearResult() - - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - -// type Mxm4Float32WithTransposingWithZerosFilterBenchmark() = -// -// inherit MxmBenchmarksWithTransposing( -// (fun context wgSize -> Matrix.SpGeMM.expand context wgSize (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul)), -// float32, -// (fun _ -> Utils.nextSingle (System.Random())), -// (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) -// ) -// -// static member InputMatrixProvider = -// Benchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" +module WithoutTransfer = + type Benchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices() + this.LoadMatricesToGPU() + + [] + override this.Benchmark() = + this.Mxm() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + type Float32() = + + inherit Benchmark( + Matrix.SpGeMM.expand (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) + ) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs index 8e909388..2a164021 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs @@ -1,6 +1,7 @@ namespace GraphBLAS.FSharp.Benchmarks.Matrix.SpGeMM open System.IO +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.IO open BenchmarkDotNet.Attributes open Brahma.FSharp @@ -203,7 +204,7 @@ type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( type Mxm4Float32MultiplicationOnlyBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - Matrix.SpGeMM.masked (Operations.add ()) (Operations.mult ()), + Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) @@ -215,7 +216,7 @@ type Mxm4Float32MultiplicationOnlyBenchmark() = type Mxm4Float32WithTransposingBenchmark() = inherit MxmBenchmarksWithTransposing( - Matrix.SpGeMM.masked (Operations.add ()) (Operations.mult ()), + Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) @@ -227,7 +228,7 @@ type Mxm4Float32WithTransposingBenchmark() = type Mxm4BoolMultiplicationOnlyBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked (fst ArithmeticOperations.boolAdd) (fst ArithmeticOperations.boolMul)), (fun _ -> true), (fun _ -> true), (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) @@ -239,7 +240,7 @@ type Mxm4BoolMultiplicationOnlyBenchmark() = type Mxm4BoolWithTransposingBenchmark() = inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked (fst ArithmeticOperations.boolAdd) (fst ArithmeticOperations.boolMul)), (fun _ -> true), (fun _ -> true), (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) @@ -251,7 +252,7 @@ type Mxm4BoolWithTransposingBenchmark() = type Mxm4Float32MultiplicationOnlyWithZerosFilterBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.addWithFilter (Operations.mult ())), + (Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul)), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) @@ -263,7 +264,7 @@ type Mxm4Float32MultiplicationOnlyWithZerosFilterBenchmark() = type Mxm4Float32WithTransposingWithZerosFilterBenchmark() = inherit MxmBenchmarksWithTransposing( - Matrix.SpGeMM.masked Operations.addWithFilter (Operations.mult ()), + Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs index c39c207f..523f5185 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -122,26 +122,26 @@ module WithoutTransfer = type Float() = inherit Benchmark( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + (Vector.map2 ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type Int32() = inherit Benchmark( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + (Vector.map2 ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) module AtLeastOne = type Float() = inherit Benchmark( - (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.floatSumAtLeastOne), + (Vector.map2AtLeastOne ArithmeticOperations.floatSumAtLeastOne), VectorGenerator.floatPair Sparse) type Int32() = inherit Benchmark( - (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.intSumAtLeastOne), + (Vector.map2AtLeastOne ArithmeticOperations.intSumAtLeastOne), VectorGenerator.intPair Sparse) module WithTransfer = @@ -178,24 +178,24 @@ module WithTransfer = type Float() = inherit Benchmark( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), + (Vector.map2 ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type Int32() = inherit Benchmark( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), + (Vector.map2 ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) module AtLeastOne = type Float() = inherit Benchmark( - (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.floatSumAtLeastOne), + (Vector.map2AtLeastOne ArithmeticOperations.floatSumAtLeastOne), VectorGenerator.floatPair Sparse) type Int32() = inherit Benchmark( - (fun context -> Vector.map2AtLeastOne context ArithmeticOperations.intSumAtLeastOne), + (Vector.map2AtLeastOne ArithmeticOperations.intSumAtLeastOne), VectorGenerator.intPair Sparse) diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs index 2a38c25c..9896a557 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs @@ -14,14 +14,14 @@ open GraphBLAS.FSharp.Backend.Objects.ClCell module BFS = let singleSource - (clContext: ClContext) (add: Expr int option -> int option>) (mul: Expr<'a option -> int option -> int option>) + (clContext: ClContext) workGroupSize = let spMVTo = - SpMV.runTo clContext add mul workGroupSize + SpMV.runTo add mul clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -29,13 +29,13 @@ module BFS = let ofList = Vector.ofList clContext workGroupSize let maskComplementedTo = - Vector.map2InPlace clContext Mask.complementedOp workGroupSize + Vector.map2InPlace Mask.complementedOp clContext workGroupSize let fillSubVectorTo = - Vector.assignByMaskInPlace clContext (Convert.assignToOption Mask.assign) workGroupSize + Vector.assignByMaskInPlace (Convert.assignToOption Mask.assign) clContext workGroupSize let containsNonZero = - ClArray.exists clContext workGroupSize Predicates.isSome + ClArray.exists Predicates.isSome clContext workGroupSize fun (queue: MailboxProcessor) (matrix: ClMatrix.CSR<'a>) (source: int) -> let vertexCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 9d743653..9763db01 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -10,7 +10,7 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Quotes module ClArray = - let init (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = + let init (initializer: Expr 'a>) (clContext: ClContext) workGroupSize = let init = <@ fun (range: Range1D) (outputBuffer: ClArray<'a>) (length: int) -> @@ -190,7 +190,7 @@ module ClArray = getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSumExclude = - PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize + PrefixSum.runExcludeInPlace <@ (+) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> @@ -210,7 +210,7 @@ module ClArray = outputArray - let exists (clContext: ClContext) workGroupSize (predicate: Expr<'a -> bool>) = + let exists (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize = let exists = <@ fun (ndRange: Range1D) length (vector: ClArray<'a>) (result: ClCell) -> @@ -239,7 +239,7 @@ module ClArray = result - let map<'a, 'b> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b>) = + let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = let map = <@ fun (ndRange: Range1D) lenght (inputArray: ClArray<'a>) (result: ClArray<'b>) -> @@ -267,7 +267,7 @@ module ClArray = result - let map2InPlace<'a, 'b, 'c> (clContext: ClContext) workGroupSize (map: Expr<'a -> 'b -> 'c>) = + let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> @@ -294,9 +294,9 @@ module ClArray = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let map2<'a, 'b, 'c> (clContext: ClContext) workGroupSize map = + let map2<'a, 'b, 'c> map (clContext: ClContext) workGroupSize = let map2 = - map2InPlace<'a, 'b, 'c> clContext workGroupSize map + map2InPlace<'a, 'b, 'c> map clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> @@ -310,7 +310,7 @@ module ClArray = let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = let map = - map2 clContext workGroupSize <@ fun x y -> x ||| y @> + map2 <@ fun x y -> x ||| y @> clContext workGroupSize let firstGetBitmap = getUniqueBitmap clContext workGroupSize @@ -335,7 +335,7 @@ module ClArray = let getUniqueBitmap2LastOccurrence clContext = getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext - let assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) = + let assignOption (op: Expr<'a -> 'b option>) (clContext: ClContext) workGroupSize = let assign = <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) resultLength -> @@ -371,16 +371,15 @@ module ClArray = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = + let choose<'a, 'b> (predicate: Expr<'a -> 'b option>) (clContext: ClContext) workGroupSize = let getBitmap = - map<'a, int> clContext workGroupSize - <| Map.chooseBitmap predicate + map<'a, int> (Map.chooseBitmap predicate) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let assignValues = - assignOption clContext workGroupSize predicate + assignOption predicate clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> @@ -398,7 +397,7 @@ module ClArray = result - let assignOption2 (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c option>) = + let assignOption2 (op: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = let assign = <@ fun (ndRange: Range1D) length (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) resultLength -> @@ -445,16 +444,15 @@ module ClArray = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let choose2 (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let choose2 (predicate: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = let getBitmap = - map2<'a, 'b, int> clContext workGroupSize - <| Map.choose2Bitmap predicate + map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let assignValues = - assignOption2 clContext workGroupSize predicate + assignOption2 predicate clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> @@ -664,7 +662,7 @@ module ClArray = Gather.runInit Map.inc clContext workGroupSize let map = - map2 clContext workGroupSize <@ fun first second -> (first, second) @> + map2 <@ fun first second -> (first, second) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) -> if values.Length > 1 then diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index c4f1fa19..791c88de 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -29,7 +29,6 @@ module internal Gather = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - /// /// Creates a new array obtained from positions replaced with values from the given array at these positions (indices). /// diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index 3e030589..09cdfb5d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -144,7 +144,7 @@ module PrefixSum = && localID < workGroupSize - 1 then resultBuffer.[i] <- resultLocalBuffer.[localID + 1] @> - let private runInplace (mirror: bool) scan (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = + let private runInPlace (opAdd: Expr<'a -> 'a -> 'a>) (mirror: bool) scan (clContext: ClContext) workGroupSize = let scan = scan opAdd clContext workGroupSize @@ -200,13 +200,13 @@ module PrefixSum = totalSum - let runExcludeInplace plus = runInplace false scanExclusive plus + let runExcludeInPlace plus = runInPlace plus false scanExclusive - let runIncludeInplace plus = runInplace false scanInclusive plus + let runIncludeInPlace plus = runInPlace plus false scanInclusive - let runBackwardsExcludeInplace plus = runInplace true scanExclusive plus + let runBackwardsExcludeInPlace plus = runInPlace plus true scanExclusive - let runBackwardsIncludeInplace plus = runInplace true scanInclusive plus + let runBackwardsIncludeInPlace plus = runInPlace plus true scanInclusive /// /// Exclude inplace prefix sum. @@ -222,13 +222,14 @@ module PrefixSum = /// > val sum = [| 4 |] /// /// + ///ClContext. ///Should be a power of 2 and greater than 1. ///Associative binary operation. ///Zero element for binary operation. - let standardExcludeInplace (clContext: ClContext) workGroupSize = + let standardExcludeInPlace (clContext: ClContext) workGroupSize = let scan = - runExcludeInplace <@ (+) @> clContext workGroupSize + runExcludeInPlace <@ (+) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> @@ -248,20 +249,21 @@ module PrefixSum = /// > val sum = [| 4 |] /// /// + ///ClContext. ///Should be a power of 2 and greater than 1. ///Associative binary operation. ///Zero element for binary operation. - let standardIncludeInplace (clContext: ClContext) workGroupSize = + let standardIncludeInPlace (clContext: ClContext) workGroupSize = let scan = - runIncludeInplace <@ (+) @> clContext workGroupSize + runIncludeInPlace <@ (+) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> scan processor inputArray 0 module ByKey = - let private sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = + let private sequentialSegments opWrite opAdd zero (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) lenght uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> @@ -313,8 +315,7 @@ module PrefixSum = /// > val result = [| 0; 0; 1; 2; 0; 1 |] /// /// - let sequentialExclude clContext = - sequentialSegments (Map.fst ()) clContext + let sequentialExclude op = sequentialSegments (Map.fst ()) op /// /// Include scan by key. @@ -327,5 +328,4 @@ module PrefixSum = /// > val result = [| 1; 1; 2; 3; 1; 2 |] /// /// - let sequentialInclude clContext = - sequentialSegments (Map.snd ()) clContext + let sequentialInclude op = sequentialSegments (Map.snd ()) op diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index 5e4a88b4..29f9e26a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -155,7 +155,7 @@ module Radix = let count = count clContext workGroupSize mask let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let scatter = scatter clContext workGroupSize mask @@ -258,7 +258,7 @@ module Radix = let count = count clContext workGroupSize mask let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let scatterByKey = scatterByKey clContext workGroupSize mask diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index d243d14e..fe7feeb2 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -55,7 +55,7 @@ module Reduce = result - let private scanSum (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) zero = + let private scanSum (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) (workGroupSize: int) zero = let subSum = SubSum.sequentialSum opAdd @@ -92,7 +92,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let private scanToCellSum (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) zero = + let private scanToCellSum (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize zero = let subSum = SubSum.sequentialSum opAdd @@ -139,12 +139,12 @@ module Reduce = /// Work group size. /// Summation operation. /// Neutral element for summation. - let sum (clContext: ClContext) workGroupSize op zero = + let sum op zero (clContext: ClContext) workGroupSize = - let scan = scanSum clContext workGroupSize op zero + let scan = scanSum op clContext workGroupSize zero let scanToCell = - scanToCellSum clContext workGroupSize op zero + scanToCellSum op clContext workGroupSize zero let run = runGeneral clContext workGroupSize scan scanToCell @@ -152,9 +152,9 @@ module Reduce = fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array let private scanReduce<'a when 'a: struct> + (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) = let scan = @@ -193,9 +193,9 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let private scanToCellReduce<'a when 'a: struct> + (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) = let scan = @@ -242,12 +242,12 @@ module Reduce = /// ClContext. /// Work group size. /// Reduction operation. - let reduce (clContext: ClContext) workGroupSize op = + let reduce op (clContext: ClContext) workGroupSize = - let scan = scanReduce clContext workGroupSize op + let scan = scanReduce op clContext workGroupSize let scanToCell = - scanToCellReduce clContext workGroupSize op + scanToCellReduce op clContext workGroupSize let run = runGeneral clContext workGroupSize scan scanToCell @@ -267,7 +267,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let sequential (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> @@ -326,7 +326,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let segmentSequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let segmentSequential (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> @@ -393,7 +393,7 @@ module Reduce = /// Reduces an array of values that does not exceed the size of the workgroup. /// The length of the result must be calculated in advance. /// - let oneWorkGroupSegments (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let oneWorkGroupSegments (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> @@ -482,7 +482,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = + let segmentSequential<'a> (reduceOp: Expr<'a -> 'a -> 'a option>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (resultPositions: ClArray) -> @@ -528,7 +528,7 @@ module Reduce = Scatter.lastOccurrence clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> @@ -599,7 +599,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let sequential (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> @@ -678,7 +678,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let segmentSequential<'a> (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> @@ -754,7 +754,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = + let segmentSequential<'a> (reduceOp: Expr<'a -> 'a -> 'a option>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) (resultPositions: ClArray) -> @@ -803,7 +803,7 @@ module Reduce = Scatter.lastOccurrence clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs index cc7c2f72..7700b476 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext module internal Map = - let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = + let preparePositions<'a, 'b> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option>) = <@ fun (ndRange: Range1D) rowCount columnCount valuesLength (values: ClArray<'a>) (rows: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -84,13 +84,13 @@ module internal Map = resultBitmap, resultValues, resultRows, resultColumns let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) + (clContext: ClContext) workGroupSize = let map = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'b> clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs index ee0f1b4f..9aeb400c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs @@ -12,7 +12,7 @@ open GraphBLAS.FSharp.Backend.Quotes module internal Map2 = - let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + let preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = <@ fun (ndRange: Range1D) rowCount columnCount leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -95,13 +95,13 @@ module internal Map2 = ///. ///Should be a power of 2 and greater than 1. let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2 = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'c> clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2AtLeastOne.fs index 0c776f10..5768b8fd 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2AtLeastOne.fs @@ -11,8 +11,8 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext module internal Map2AtLeastOne = let preparePositionsAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = @@ -264,15 +264,15 @@ module internal Map2AtLeastOne = ///. ///Should be a power of 2 and greater than 1. let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let merge = merge clContext workGroupSize let preparePositions = - preparePositionsAtLeastOne clContext opAdd workGroupSize + preparePositionsAtLeastOne opAdd clContext workGroupSize let setPositions = Common.setPositions<'c> clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index 0ac34ba4..928a9d7a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -23,7 +23,7 @@ module Matrix = workGroupSize = - Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize let getTuples (clContext: ClContext) workGroupSize = @@ -65,7 +65,7 @@ module Matrix = let create = ClArray.create clContext workGroupSize let scan = - PrefixSum.runBackwardsIncludeInplace <@ min @> clContext workGroupSize + PrefixSum.runBackwardsIncludeInPlace <@ min @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (rowIndices: ClArray) rowCount -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 018c027b..49336bf9 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext module internal Map = - let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize op = + let preparePositions<'a, 'b> op (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option>) = <@ fun (ndRange: Range1D) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -82,13 +82,13 @@ module internal Map = 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>) + (clContext: ClContext) workGroupSize = let map = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'b> clContext workGroupSize @@ -114,16 +114,16 @@ module internal Map = Values = resultValues } let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) + (clContext: ClContext) workGroupSize = - let mapToCOO = runToCOO clContext opAdd workGroupSize + let mapToCOO = runToCOO opAdd clContext workGroupSize - let toCSRInplace = + let toCSRInPlace = Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> mapToCOO queue allocationMode matrix - |> toCSRInplace queue allocationMode + |> toCSRInPlace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index 0d363dac..869d121b 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Matrix.COO module internal Map2 = - let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + let preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = <@ fun (ndRange: Range1D) rowCount columnCount (leftValues: ClArray<'a>) (leftRowPointers: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRowPointers: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -95,13 +95,13 @@ module internal Map2 = ///. ///Should be a power of 2 and greater than 1. let runToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2 = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'c> clContext workGroupSize @@ -136,16 +136,16 @@ module internal Map2 = 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>) + (clContext: ClContext) workGroupSize = - let map2ToCOO = runToCOO clContext opAdd workGroupSize + let map2ToCOO = runToCOO opAdd clContext workGroupSize - let toCSRInplace = + 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 + |> toCSRInPlace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs index 1f379b0b..dd24e1b5 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2AtLeastOne.fs @@ -13,8 +13,8 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module internal Map2AtLeastOne = let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = @@ -283,15 +283,15 @@ module internal Map2AtLeastOne = allRows, allColumns, leftMergedValues, rightMergedValues, isEndOfRow, isLeft 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>) + (clContext: ClContext) workGroupSize = let merge = merge clContext workGroupSize let preparePositions = - preparePositions clContext opAdd workGroupSize + preparePositions opAdd clContext workGroupSize let setPositions = Matrix.Common.setPositions<'c> clContext workGroupSize @@ -332,12 +332,12 @@ module internal Map2AtLeastOne = 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>) + (clContext: ClContext) workGroupSize = - let elementwiseToCOO = runToCOO clContext opAdd workGroupSize + let elementwiseToCOO = runToCOO opAdd clContext workGroupSize let toCSRInPlace = Matrix.toCSRInPlace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index e6857a20..7730eaa2 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -67,7 +67,7 @@ module Matrix = workGroupSize = - Map2AtLeastOne.runToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2AtLeastOne.runToCOO (Convert.atLeastOneToOption opAdd) clContext workGroupSize let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) @@ -75,7 +75,7 @@ module Matrix = workGroupSize = - Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize let transposeInPlace (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index ea26fd7f..edf5efef 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -17,7 +17,7 @@ module Common = Scatter.lastOccurrence clContext workGroupSize let sum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> @@ -60,7 +60,7 @@ module Common = ClArray.zeroCreate clContext workGroupSize let scan = - PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize + PrefixSum.runIncludeInPlace <@ max @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index eb60f655..f3b39641 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -257,12 +257,12 @@ module Matrix = |> ClMatrix.LIL | ClMatrix.LIL _ -> copy processor allocationMode matrix - let map (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) workGroupSize = + let map (opAdd: Expr<'a option -> 'b option>) (clContext: ClContext) workGroupSize = let mapCOO = - COO.Matrix.map clContext opAdd workGroupSize + COO.Matrix.map opAdd clContext workGroupSize let mapCSR = - CSR.Matrix.map clContext opAdd workGroupSize + CSR.Matrix.map opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix -> match matrix with @@ -273,12 +273,12 @@ module Matrix = |> ClMatrix.CSC | _ -> failwith "Not yet implemented" - let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = + let map2 (opAdd: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = let map2COO = - COO.Matrix.map2 clContext opAdd workGroupSize + COO.Matrix.map2 opAdd clContext workGroupSize let map2CSR = - CSR.Matrix.map2 clContext opAdd workGroupSize + CSR.Matrix.map2 opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with @@ -294,7 +294,7 @@ module Matrix = |> ClMatrix.CSC | _ -> failwith "Matrix formats are not matching" - let map2AtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = + let map2AtLeastOne (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = let COOElementwise = COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize @@ -315,7 +315,7 @@ module Matrix = |> ClMatrix.CSC | _ -> failwith "Matrix formats are not matching" - let map2AtLeastOneToCOO (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = + let map2AtLeastOneToCOO (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = let COOElementwise = COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize @@ -415,7 +415,7 @@ module Matrix = = let runCSRnCSC = - SpGeMM.Masked.run clContext workGroupSize opAdd opMul + SpGeMM.Masked.run opAdd opMul clContext workGroupSize fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> match matrix1, matrix2, mask with @@ -423,10 +423,10 @@ module Matrix = | _ -> failwith "Matrix formats are not matching" let expand - (clContext: ClContext) - workGroupSize (opAdd: Expr<'c -> 'c -> 'c option>) (opMul: Expr<'a -> 'b -> 'c option>) + (clContext: ClContext) + workGroupSize = let run = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 0256ffd1..7041ac33 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -20,7 +20,7 @@ module Expand = let gather = Gather.run clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrixRowsLengths: ClArray) -> @@ -49,14 +49,14 @@ module Expand = ClArray.zeroCreate clContext workGroupSize let maxPrefixSum = - PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize + PrefixSum.runIncludeInPlace <@ max @> clContext workGroupSize let create = ClArray.create clContext workGroupSize let gather = Gather.run clContext workGroupSize let segmentPrefixSum = - PrefixSum.ByKey.sequentialInclude clContext workGroupSize <@ (+) @> 0 + PrefixSum.ByKey.sequentialInclude <@ (+) @> 0 clContext workGroupSize let removeDuplicates = ClArray.removeDuplications clContext workGroupSize @@ -124,14 +124,13 @@ module Expand = let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = let getBitmap = - ClArray.map2<'a, 'b, int> clContext workGroupSize - <| Map.choose2Bitmap predicate + ClArray.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let assignValues = - ClArray.assignOption2 clContext workGroupSize predicate + ClArray.assignOption2 predicate clContext workGroupSize let scatter = Scatter.lastOccurrence clContext workGroupSize @@ -180,13 +179,13 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = let reduce = - Reduce.ByKey.Option.segmentSequential clContext workGroupSize opAdd + Reduce.ByKey.Option.segmentSequential opAdd clContext workGroupSize let getUniqueBitmap = ClArray.getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let idScatter = Scatter.initFirsOccurrence Map.id clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs index c1b0d2a9..700018c3 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs @@ -10,10 +10,10 @@ open GraphBLAS.FSharp.Backend.Objects.ClCell module internal Masked = let private calculate - (context: ClContext) - workGroupSize (opAdd: Expr<'c -> 'c -> 'c option>) (opMul: Expr<'a -> 'b -> 'c option>) + (context: ClContext) + workGroupSize = let run = @@ -142,14 +142,14 @@ module internal Masked = values, bitmap let run - (context: ClContext) - workGroupSize (opAdd: Expr<'c -> 'c -> 'c option>) (opMul: Expr<'a -> 'b -> 'c option>) + (context: ClContext) + workGroupSize = let calculate = - calculate context workGroupSize opAdd opMul + calculate opAdd opMul context workGroupSize let scatter = Scatter.lastOccurrence context workGroupSize @@ -157,8 +157,8 @@ module internal Masked = let scatterData = Scatter.lastOccurrence context workGroupSize - let scanInplace = - PrefixSum.standardExcludeInplace context workGroupSize + let scanInPlace = + PrefixSum.standardExcludeInPlace context workGroupSize fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> @@ -166,15 +166,15 @@ module internal Masked = calculate queue matrixLeft matrixRight mask let resultNNZ = - (scanInplace queue positions).ToHostAndFree(queue) + (scanInPlace queue positions).ToHostAndFree(queue) let resultRows = context.CreateClArray resultNNZ - let resultCols = context.CreateClArray resultNNZ - let resultVals = context.CreateClArray<'c> resultNNZ + let resultColumns = context.CreateClArray resultNNZ + let resultValues = context.CreateClArray<'c> resultNNZ scatter queue positions mask.Rows resultRows - scatter queue positions mask.Columns resultCols - scatterData queue positions values resultVals + scatter queue positions mask.Columns resultColumns + scatterData queue positions values resultValues queue.Post(Msg.CreateFreeMsg<_>(values)) queue.Post(Msg.CreateFreeMsg<_>(positions)) @@ -183,5 +183,5 @@ module internal Masked = RowCount = matrixLeft.RowCount ColumnCount = matrixRight.ColumnCount Rows = resultRows - Columns = resultCols - Values = resultVals } + Columns = resultColumns + Values = resultValues } diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index c99c7e3b..756de4bb 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -10,13 +10,13 @@ open GraphBLAS.FSharp.Backend.Objects.ClCell module Vector = let map2InPlace<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2InPlace = - ClArray.map2InPlace clContext workGroupSize opAdd + ClArray.map2InPlace opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> @@ -24,25 +24,25 @@ module Vector = let map2<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2 = - ClArray.map2 clContext workGroupSize opAdd + ClArray.map2 opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> map2 processor allocationMode leftVector rightVector - let map2AtLeastOne clContext op workGroupSize = - map2 clContext (Convert.atLeastOneToOption op) workGroupSize + let map2AtLeastOne op clContext workGroupSize = + map2 (Convert.atLeastOneToOption op) clContext workGroupSize let assignByMaskInPlace<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) + (clContext: ClContext) workGroupSize = @@ -71,13 +71,13 @@ module Vector = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let assignByMask<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) + (clContext: ClContext) workGroupSize = let assignByMask = - assignByMaskInPlace clContext maskOp workGroupSize + assignByMaskInPlace maskOp clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> let resultVector = @@ -96,18 +96,16 @@ module Vector = Scatter.lastOccurrence clContext workGroupSize let getBitmap = - ClArray.map clContext workGroupSize - <| Map.option 1 0 + ClArray.map (Map.option 1 0) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let allIndices = - ClArray.init clContext workGroupSize Map.id + ClArray.init Map.id clContext workGroupSize let allValues = - ClArray.map clContext workGroupSize - <| Map.optionToValueOrZero Unchecked.defaultof<'a> + ClArray.map (Map.optionToValueOrZero Unchecked.defaultof<'a>) clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (vector: ClArray<'a option>) -> @@ -145,16 +143,16 @@ module Vector = Values = resultValues Size = vector.Length } - let reduce<'a when 'a: struct> (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) = + let reduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let choose = - ClArray.choose clContext workGroupSize Map.id + ClArray.choose Map.id clContext workGroupSize let reduce = - Reduce.reduce clContext workGroupSize opAdd + Reduce.reduce opAdd clContext workGroupSize let containsNonZero = - ClArray.exists clContext workGroupSize Predicates.isSome + ClArray.exists Predicates.isSome clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs b/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs index 4de83189..46895b0c 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs @@ -8,9 +8,9 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext module SpMV = let runTo - (clContext: ClContext) (add: Expr<'c option -> 'c option -> 'c option>) (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = @@ -144,12 +144,12 @@ module SpMV = queue.Post(Msg.CreateFreeMsg intermediateArray) let run - (clContext: ClContext) (add: Expr<'c option -> 'c option -> 'c option>) (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = - let runTo = runTo clContext add mul workGroupSize + let runTo = runTo add mul clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs index d44c5a4b..93b809c1 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs @@ -10,7 +10,7 @@ module internal Common = let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = let sum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let valuesScatter = Scatter.lastOccurrence clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs index 851b28c1..adf88833 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs @@ -9,7 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Quotes module internal Map2 = - let private preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + let private preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = <@ fun (ndRange: Range1D) length leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> @@ -72,10 +72,10 @@ module internal Map2 = resultBitmap, resultValues, resultIndices - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> op (clContext: ClContext) workGroupSize = let prepare = - preparePositions<'a, 'b, 'c> clContext workGroupSize op + preparePositions<'a, 'b, 'c> op clContext workGroupSize let setPositions = Common.setPositions clContext workGroupSize @@ -104,8 +104,8 @@ module internal Map2 = Size = max leftVector.Size rightVector.Size } let private preparePositionsAssignByMask<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) op + (clContext: ClContext) workGroupSize = @@ -175,10 +175,10 @@ module internal Map2 = ///. ///. ///Should be a power of 2 and greater than 1. - let assignByMask<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = + let assignByMask<'a, 'b when 'a: struct and 'b: struct> op (clContext: ClContext) workGroupSize = let prepare = - preparePositionsAssignByMask clContext op workGroupSize + preparePositionsAssignByMask op clContext workGroupSize let setPositions = Common.setPositions clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2AtLeastOne.fs index 8c346b87..171ab203 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2AtLeastOne.fs @@ -170,8 +170,8 @@ module internal Map2AtLeastOne = allIndices, firstResultValues, secondResultValues, isLeftBitmap let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) op + (clContext: ClContext) workGroupSize = @@ -225,12 +225,12 @@ module internal Map2AtLeastOne = ///. ///. ///Should be a power of 2 and greater than 1. - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> op (clContext: ClContext) workGroupSize = let merge = merge clContext workGroupSize let prepare = - preparePositions<'a, 'b, 'c> clContext op workGroupSize + preparePositions<'a, 'b, 'c> op clContext workGroupSize let setPositions = Common.setPositions clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index 75cb4d7e..8d0be005 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -22,8 +22,8 @@ module Vector = let map2 = Map2.run - let map2AtLeastOne (clContext: ClContext) opAdd workGroupSize allocationMode = - Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize allocationMode + let map2AtLeastOne opAdd (clContext: ClContext) workGroupSize = + Map2AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize let assignByMask = Map2.assignByMask @@ -62,7 +62,7 @@ module Vector = resultVector - let reduce<'a when 'a: struct> (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) = + let reduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let reduce = Reduce.reduce clContext workGroupSize opAdd diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 97a1ca08..9dd9fc6b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -119,12 +119,12 @@ module Vector = ClVector.Dense <| toDense processor allocationMode vector - let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = + let map2 (opAdd: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = let map2Dense = - Dense.Vector.map2 clContext opAdd workGroupSize + Dense.Vector.map2 opAdd clContext workGroupSize let map2Sparse = - Sparse.Vector.map2 clContext opAdd workGroupSize + Sparse.Vector.map2 opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with @@ -136,12 +136,12 @@ module Vector = <| map2Sparse processor allocationMode left right | _ -> failwith "Vector formats are not matching." - let map2AtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = + let map2AtLeastOne (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = let map2Sparse = - Sparse.Vector.map2AtLeastOne clContext opAdd workGroupSize + Sparse.Vector.map2AtLeastOne opAdd clContext workGroupSize let map2Dense = - Dense.Vector.map2AtLeastOne clContext opAdd workGroupSize + Dense.Vector.map2AtLeastOne opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with @@ -153,13 +153,13 @@ module Vector = <| map2Dense processor allocationMode left right | _ -> failwith "Vector formats are not matching." - let private assignByMaskGeneral<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = + let private assignByMaskGeneral<'a, 'b when 'a: struct and 'b: struct> op (clContext: ClContext) workGroupSize = let sparseFillVector = - Sparse.Vector.assignByMask clContext op workGroupSize + Sparse.Vector.assignByMask op clContext workGroupSize let denseFillVector = - Dense.Vector.assignByMask clContext op workGroupSize + Dense.Vector.assignByMask op clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: ClCell<'a>) -> match vector, mask with @@ -171,18 +171,18 @@ module Vector = <| denseFillVector processor allocationMode vector mask value | _ -> failwith "Vector formats are not matching." - let assignByMask<'a, 'b when 'a: struct and 'b: struct> clContext op workGroupSize = - assignByMaskGeneral<'a, 'b> clContext (Convert.assignToOption op) workGroupSize + let assignByMask<'a, 'b when 'a: struct and 'b: struct> op clContext workGroupSize = + assignByMaskGeneral<'a, 'b> (Convert.assignToOption op) clContext workGroupSize - let assignByMaskComplemented<'a, 'b when 'a: struct and 'b: struct> clContext op workGroupSize = - assignByMaskGeneral<'a, 'b> clContext (Convert.assignComplementedToOption op) workGroupSize + let assignByMaskComplemented<'a, 'b when 'a: struct and 'b: struct> op clContext workGroupSize = + assignByMaskGeneral<'a, 'b> (Convert.assignComplementedToOption op) clContext workGroupSize - let reduce (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) = + let reduce (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let sparseReduce = - Sparse.Vector.reduce clContext workGroupSize opAdd + Sparse.Vector.reduce opAdd clContext workGroupSize let denseReduce = - Dense.Vector.reduce clContext workGroupSize opAdd + Dense.Vector.reduce opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index 4c7f76d6..a85d8424 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs @@ -23,9 +23,9 @@ let testFixtures (testContext: TestContext) = let bfs = Algorithms.BFS.singleSource - context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption + context workGroupSize testPropertyWithConfig config testName diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index 7c1cfdea..7fa142dd 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -41,7 +41,7 @@ let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = let context = testContext.ClContext let choose = - ClArray.choose context workGroupSize mapFunQ + ClArray.choose mapFunQ context workGroupSize makeTest<'a, 'b> testContext choose mapFun isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>} -> %A{typeof<'b>}" @@ -83,7 +83,7 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = let testFun = - testFun context Utils.defaultWorkGroupSize opMapQ + testFun opMapQ context Utils.defaultWorkGroupSize makeTest2 isEqual opMap testFun |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs index dbbb3415..ff061074 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs @@ -8,6 +8,7 @@ open Context open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ClCell let logger = Log.create "ClArray.containsNonZero.Tests" @@ -28,17 +29,7 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (a let result = match vector.ToDevice context with - | ClVector.Dense clArray -> - let resultCell = exists q clArray - let result = Array.zeroCreate 1 - - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - - q.Post(Msg.CreateFreeMsg<_>(resultCell)) - - res.[0] - + | ClVector.Dense clArray -> (exists q clArray: ClCell<_>).ToHostAndFree q | _ -> failwith "Unsupported vector format" $"The results should be the same, vector : {vector}" @@ -46,7 +37,7 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (a let createTest<'a when 'a: struct and 'a: equality> isEqual zero = let exists = - ClArray.exists context wgSize Predicates.isSome + ClArray.exists Predicates.isSome context wgSize [ correctnessGenericTest<'a> (isEqual zero) exists |> testPropertyWithConfig config "FSCheck data" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs index be501e41..a49ea492 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs @@ -44,8 +44,7 @@ let createTest<'a when 'a: equality> (testContext: TestContext) (zero: 'a) isEqu let context = testContext.ClContext let map = - ClArray.map context wgSize - <| Map.optionToValueOrZero zero + ClArray.map (Map.optionToValueOrZero zero) context wgSize makeTest testContext map zero isEqual |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs index c1ab2af8..ae4342b8 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs @@ -42,7 +42,7 @@ let createTest<'a when 'a: equality> (testContext: TestContext) isEqual hostMapF let context = testContext.ClContext - let map = ClArray.map2 context wgSize mapFunQ + let map = ClArray.map2 mapFunQ context wgSize makeTest<'a> testContext map hostMapFun isEqual |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs index d6d47640..3500e639 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs @@ -52,7 +52,7 @@ let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zer |> Expect.equal actualSum expectedSum let testFixtures plus plusQ zero name = - let reduce = Reduce.reduce context wgSize plusQ + let reduce = Reduce.reduce plusQ context wgSize makeTest reduce plus zero |> testPropertyWithConfig config $"Correctness on %s{name}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 75e0b9dd..772eafb5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -63,7 +63,7 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey.sequential reduceOpQ context Utils.defaultWorkGroupSize makeTest isEqual reduce reduceOp |> testPropertyWithConfig config $"test on {typeof<'a>}" @@ -97,7 +97,7 @@ let sequentialTest = let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey.oneWorkGroupSegments reduceOpQ context Utils.defaultWorkGroupSize makeTest isEqual reduce reduceOp |> testPropertyWithConfig @@ -166,7 +166,7 @@ let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize makeTestSequentialSegments isEqual reduce reduceOp |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" @@ -252,7 +252,7 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey2D.sequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey2D.sequential reduceOpQ context Utils.defaultWorkGroupSize makeTest2D isEqual reduce reduceOp |> testPropertyWithConfig @@ -331,7 +331,7 @@ let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey2D.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey2D.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize makeTestSequentialSegments2D isEqual reduce reduceOp |> testPropertyWithConfig @@ -430,7 +430,7 @@ let testOption<'a> isEqual reduceOp testFun (array: (int * 'a) []) = |> checkResultOption isEqual keys values reduceOp let createTestOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = - Reduce.ByKey.Option.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey.Option.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize |> testOption<'a> isEqual reduceOp |> testPropertyWithConfig { config with @@ -518,7 +518,7 @@ let test2DOption<'a> isEqual reduceOp reduce (array: (int * int * 'a) []) = |> checkResult2DOption isEqual firstKeys secondKeys values reduceOp let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = - Reduce.ByKey2D.Option.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey2D.Option.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize |> test2DOption<'a> isEqual reduceOp |> testPropertyWithConfig { config with diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs index e094d572..977b085e 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs @@ -51,7 +51,7 @@ let makeTest plus zero sum (array: 'a []) = |> Expect.equal actualSum expectedSum let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = - Reduce.sum context wgSize plusQ zero + Reduce.sum plusQ zero context wgSize |> makeTest plus zero |> testPropertyWithConfig config (sprintf "Correctness on %s" name) diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs index 1cb81709..a89b5f36 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs @@ -53,7 +53,7 @@ let createTest (zero: 'a) opAddQ opAdd isEqual deviceScan hostScan = let hostScan = hostScan zero opAdd let deviceScan = - deviceScan context Utils.defaultWorkGroupSize opAddQ zero + deviceScan opAddQ zero context Utils.defaultWorkGroupSize makeTestSequentialSegments isEqual hostScan deviceScan |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs index 734b96f9..fbf12398 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs @@ -61,7 +61,7 @@ let makeTest plus zero isEqual scan (array: 'a []) = |> Tests.Utils.compareArrays isEqual actual expected let testFixtures plus plusQ zero isEqual name = - PrefixSum.runIncludeInplace plusQ context wgSize + PrefixSum.runIncludeInPlace plusQ context wgSize |> makeTest plus zero isEqual |> testPropertyWithConfig config $"Correctness on %s{name}" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index cb5b7e51..508f7d75 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -98,7 +98,7 @@ let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let unaryOp = binOp constant let unaryOpQ = opQ zero constant - let map = Matrix.map context unaryOpQ wgSize + let map = Matrix.map unaryOpQ context wgSize let toCOO = Matrix.toCOO context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index 3d179e21..da0fd3c3 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -101,7 +101,7 @@ let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = let context = case.TestContext.ClContext let q = case.TestContext.Queue - let map2 = map2 context addQ wgSize + let map2 = map2 addQ context wgSize let toCOO = Matrix.toCOO context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 69cda013..e187d118 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -218,7 +218,7 @@ let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftAr | _ -> failwith "Matrix format are not matching" let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = - testFun context Utils.defaultWorkGroupSize opAddQ opMulQ + testFun opAddQ opMulQ context Utils.defaultWorkGroupSize |> makeGeneralTest<'a> zero isEqual opMul opAdd |> testPropertyWithConfig { config with diff --git a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs index c4193eb3..50dab7c2 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs @@ -96,7 +96,7 @@ let createTest case (isZero: 'a -> bool) isComplemented fill = let context = case.TestContext.ClContext let getCorrectnessTestName = getCorrectnessTestName case - let fill = fill context Mask.assign wgSize + let fill = fill Mask.assign context wgSize let toCoo = Vector.toDense context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index cfb16b53..fee9103a 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -90,7 +90,7 @@ let correctnessGenericTest let createTest case isEqual (zero: 'a) plus plusQ map2 = let context = case.TestContext.ClContext - let map2 = map2 context plusQ wgSize + let map2 = map2 plusQ context wgSize let intToDense = Vector.toDense context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs index cfbca46b..42f29688 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs @@ -7,7 +7,7 @@ open GraphBLAS.FSharp.Tests open Brahma.FSharp open FSharp.Quotations open TestCases -open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Vector let logger = Log.create "Vector.reduce.Tests" @@ -22,15 +22,7 @@ let checkResult zero op (actual: 'a) (vector: 'a []) = "Results should be the same" |> Expect.equal actual expected -let correctnessGenericTest - isEqual - zero - op - opQ - (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) - case - (array: 'a []) - = +let correctnessGenericTest isEqual zero op reduce case (array: 'a []) = let vector = Utils.createVectorFromArray case.Format array (isEqual zero) @@ -41,27 +33,18 @@ let correctnessGenericTest let clVector = vector.ToDevice context - let resultCell = reduce opQ q clVector - - let result = Array.zeroCreate 1 - let result = - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - - q.Post(Msg.CreateFreeMsg<_>(resultCell)) - - res.[0] + (reduce q clVector: ClCell<_>).ToHostAndFree q checkResult zero op result array let createTest<'a when 'a: equality and 'a: struct> case isEqual (zero: 'a) plus plusQ name = let context = case.TestContext.ClContext - let reduce = Vector.reduce context wgSize + let reduce = Vector.reduce plusQ context wgSize case - |> correctnessGenericTest isEqual zero plus plusQ reduce + |> correctnessGenericTest isEqual zero plus reduce |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}, %s{name} %A{case.Format}" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 252c45ba..e19ade53 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -92,7 +92,7 @@ let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = let getCorrectnessTestName datatype = $"Correctness on %s{datatype}, %A{testContext.ClContext}" - let spMV = SpMV.run context addQ mulQ wgSize + let spMV = SpMV.run addQ mulQ context wgSize testContext |> correctnessGenericTest zero add mul spMV isEqual q From d9dd757d09e21e1be423f6371ade428e609ed174 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 23 Apr 2023 16:04:33 +0300 Subject: [PATCH 092/143] wip: SpGeMM benchmark --- .../Algorithms/BFS.fs | 142 +++++++++--------- .../Configs/Context.txt | 4 + .../Configs/SpGeMM.txt | 1 + .../GraphBLAS-sharp.Benchmarks.fsproj | 1 + .../GraphBLAS-sharp.Benchmarks/Helpers.fs | 13 +- .../Matrix/SpGeMM/Expand.fs | 5 +- .../GraphBLAS-sharp.Benchmarks/Program.fs | 3 +- .../Matrix/CSR/Matrix.fs | 2 +- .../Vector/Sparse/Vector.fs | 2 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- 10 files changed, 91 insertions(+), 84 deletions(-) create mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/Configs/SpGeMM.txt diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs index 035b9b2f..7115a90c 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -92,89 +92,87 @@ type Benchmarks<'elem when 'elem : struct>( abstract member Benchmark : unit -> unit -module WithoutTransfer = - type Benchmark<'elem when 'elem : struct>( +type WithoutTransferBenchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + boolConverter, + vertex) = + + inherit Benchmarks<'elem>( buildFunToBenchmark, - converter: string -> 'elem, + converter, boolConverter, - vertex) = + vertex) - inherit Benchmarks<'elem>( - buildFunToBenchmark, - converter, - boolConverter, - vertex) + [] + override this.GlobalSetup() = + this.ReadMatrix() + this.LoadMatrixToGPU() - [] - override this.GlobalSetup() = - this.ReadMatrix() - this.LoadMatrixToGPU() + [] + override this.IterationCleanup() = + this.ClearResult() - [] - override this.IterationCleanup() = - this.ClearResult() + [] + override this.GlobalCleanup() = + this.ClearInputMatrix() - [] - override this.GlobalCleanup() = - this.ClearInputMatrix() + [] + override this.Benchmark() = + this.BFS() + this.Processor.PostAndReply Msg.MsgNotifyMe - [] - override this.Benchmark() = - this.BFS() - this.Processor.PostAndReply Msg.MsgNotifyMe +type BFSWithoutTransferBenchmarkInt32() = - type Int() = + inherit WithoutTransferBenchmark( + (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) - inherit Benchmark( - (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), - int32, - (fun _ -> Utils.nextInt (System.Random())), - 0) + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" - static member InputMatrixProvider = - Benchmark<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" +type WithTransferBenchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + boolConverter, + vertex) = -module WithTransfer = - type Benchmark<'elem when 'elem : struct>( + inherit Benchmarks<'elem>( buildFunToBenchmark, - converter: string -> 'elem, + converter, boolConverter, - vertex) = - - inherit Benchmarks<'elem>( - buildFunToBenchmark, - converter, - boolConverter, - vertex) - - [] - override this.GlobalSetup() = - this.ReadMatrix() - - [] - override this.GlobalCleanup() = - this.ClearResult() - - [] - override this.IterationCleanup() = - this.ClearInputMatrix() - this.ClearResult() - - [] - override this.Benchmark() = - this.LoadMatrixToGPU() - this.BFS() - this.ResultLevels.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe - - type Int() = - - inherit Benchmark( - (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), - int32, - (fun _ -> Utils.nextInt (System.Random())), - 0) - - static member InputMatrixProvider = - Benchmark<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + vertex) + + [] + override this.GlobalSetup() = + this.ReadMatrix() + + [] + override this.GlobalCleanup() = + this.ClearResult() + + [] + override this.IterationCleanup() = + this.ClearInputMatrix() + this.ClearResult() + + [] + override this.Benchmark() = + this.LoadMatrixToGPU() + this.BFS() + this.ResultLevels.ToHost this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + +type BFSWithTransferBenchmarkInt32() = + + inherit WithTransferBenchmark( + (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt index 04f1c08e..af722237 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt @@ -1,3 +1,7 @@ + +Gpu +32 + NVIDIA* Gpu 32 diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/SpGeMM.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/SpGeMM.txt new file mode 100644 index 00000000..9a294a4a --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/SpGeMM.txt @@ -0,0 +1 @@ +hollywood-2009.mtx diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index 8c455f09..6e8486b0 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -26,6 +26,7 @@ + \ No newline at end of file diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs index 0d292f3c..8702d511 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs @@ -108,13 +108,16 @@ module Utils = let queue = context.QueueProvider.CreateQueue() { ClContext = context; Queue = queue }) + let result = + seq { + for wgSize in workGroupSizes do + for context in contexts do + yield (context, wgSize) + } - seq { - for wgSize in workGroupSizes do - for context in contexts do - yield (context, wgSize) - } + printfn "result length: %A" <| Seq.length result + result let nextSingle (random: System.Random) = let buffer = Array.zeroCreate 4 random.NextBytes buffer diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs index 3daf2ec4..3f1751af 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -49,7 +49,7 @@ type Benchmarks<'elem when 'elem : struct>( static member AvailableContexts = Utils.availableContexts static member InputMatrixProviderBuilder pathToConfig = - let datasetFolder = "Mxm" + let datasetFolder = "" pathToConfig |> Utils.getMatricesFilenames |> Seq.map @@ -59,7 +59,6 @@ type Benchmarks<'elem when 'elem : struct>( match Path.GetExtension matrixFilename with | ".mtx" -> MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) - , MtxReader(Utils.getFullPathToMatrix datasetFolder (matrixFilename)) | _ -> failwith "Unsupported matrix format") member this.FunToBenchmark = @@ -145,4 +144,4 @@ module WithoutTransfer = ) static member InputMatrixProvider = - Benchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Benchmarks<_>.InputMatrixProviderBuilder "SpGeMM.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs index ea487610..d22c1e5a 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs @@ -4,7 +4,8 @@ open BenchmarkDotNet.Running [] let main argv = let benchmarks = - BenchmarkSwitcher [| typeof |] + BenchmarkSwitcher [| typeof + typeof |] benchmarks.Run argv |> ignore 0 diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 7730eaa2..64a18e49 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -167,7 +167,7 @@ module Matrix = let pairwise = ClArray.pairwise clContext workGroupSize let subtract = - ClArray.map clContext workGroupSize <@ fun (fst, snd) -> snd - fst @> + ClArray.map <@ fun (fst, snd) -> snd - fst @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'b>) -> let pointerPairs = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index 8d0be005..add0e2a7 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -65,6 +65,6 @@ module Vector = let reduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let reduce = - Reduce.reduce clContext workGroupSize opAdd + Reduce.reduce opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 9dd9fc6b..9c94992b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -39,7 +39,7 @@ module Vector = ClArray.zeroCreate clContext workGroupSize let map = - ClArray.map clContext workGroupSize <@ Some @> + ClArray.map <@ Some @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode format size (elements: (int * 'a) list) -> match format with From f5c6fe611feedc429efe9a97a98c80bcd2830700 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 23 Apr 2023 17:36:37 +0300 Subject: [PATCH 093/143] fix: count in CSR.byRows --- .../GraphBLAS-sharp.Benchmarks/Configs/Context.txt | 4 ---- benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs | 3 +-- src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs | 10 ++++++---- src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs | 10 ++++++++-- src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 4 ++-- 5 files changed, 17 insertions(+), 14 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt index af722237..04f1c08e 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt @@ -1,7 +1,3 @@ - -Gpu -32 - NVIDIA* Gpu 32 diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs index d22c1e5a..5a3ccf37 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs @@ -4,8 +4,7 @@ open BenchmarkDotNet.Running [] let main argv = let benchmarks = - BenchmarkSwitcher [| typeof - typeof |] + BenchmarkSwitcher [| typeof |] benchmarks.Run argv |> ignore 0 diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 64a18e49..835596f1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -132,12 +132,14 @@ module Matrix = |> Seq.map (fun (first, second) -> lazy - (if second - first > 0 then - let values = getChunkValues first second - let columns = getChunkIndices first second + (let count = second - first + + if count > 0 then + let values = getChunkValues first count + let columns = getChunkIndices first count Some <| creatSparseVector values columns - else + else None)) let byRows (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 7041ac33..5f33fb90 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -301,7 +301,13 @@ module Expand = runRow processor allocationMode rightMatrix rightMatrixRowsLengths split processor allocationMode leftMatrix - |> Seq.map (fun lazyRow -> Option.bind runRow lazyRow.Value) + |> Seq.map (fun lazyRow -> + Option.bind (fun row -> + let result = runRow row + row.Dispose processor + + result + ) lazyRow.Value) |> Seq.toArray |> fun rows -> rightMatrixRowsLengths.Free processor @@ -309,7 +315,7 @@ module Expand = // compute nnz let nnz = rows - |> Array.fold + |> Seq.fold (fun count -> function | Some row -> count + row.Size diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index e2a1d76a..3ddb7cea 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -92,8 +92,8 @@ module ClMatrix = interface IDeviceMemObject with member this.Dispose q = this.Rows - |> Array.choose id - |> Array.iter (fun vector -> vector.Dispose q) + |> Seq.choose id + |> Seq.iter (fun vector -> vector.Dispose q) type Tuple<'elem when 'elem: struct> = { Context: ClContext From ad9b5283a71b9503ab1fbb0d160f81a66b57e528 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 24 Apr 2023 19:28:05 +0300 Subject: [PATCH 094/143] add: CSR.byRows tests --- src/GraphBLAS-sharp/Objects/Matrix.fs | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs | 55 +++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs | 8 ++- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- 5 files changed, 66 insertions(+), 3 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index c1ed4c33..c99e5b6a 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -24,7 +24,7 @@ module Matrix = |> List.mapi (fun i x -> (x, i)) |> List.filter (fun pair -> not <| isZero (fst pair))) |> List.fold - (fun (rowPtrs, valueInx) row -> ((rowPtrs.Head + row.Length) :: rowPtrs), valueInx @ row) + (fun (rowPointers, valueInx) row -> ((rowPointers.Head + row.Length) :: rowPointers), valueInx @ row) ([ 0 ], []) { Values = diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 9ea04ea9..b507283f 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -53,6 +53,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs b/tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs new file mode 100644 index 00000000..2b5cf78b --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs @@ -0,0 +1,55 @@ +module GraphBLAS.FSharp.Tests.Matrix.ByRows + +open Expecto +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Objects.ClVectorExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = Utils.defaultConfig + +let makeTest<'a when 'a : struct> isEqual zero testFun (array: 'a [,]) = + + let matrix = Matrix.CSR.FromArray2D(array, isEqual zero) + + if matrix.NNZ > 0 then + + let clMatrix = matrix.ToDevice context + + let rows = testFun processor HostInterop clMatrix + + "Rows count must be the same" + |> Expect.equal (Seq.length rows) (Array2D.length1 array) + + rows + |> Seq.iteri (fun index -> function + | Some (actualRow: ClVector.Sparse<_>) -> + let expectedRow = Vector.Sparse.FromArray(array.[index, *], (isEqual zero)) + let actualHost = actualRow.ToHost processor + + Utils.compareSparseVectors isEqual actualHost expectedRow + | None -> + "Expected row must be None" + |> Expect.isFalse (Array.exists ((<<) not <| isEqual zero) array.[index, *])) + +let createTest isEqual (zero: 'a) = + CSR.Matrix.byRows context Utils.defaultWorkGroupSize + |> makeTest<'a> isEqual zero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTest Utils.floatIsEqual 0.0 + + createTest Utils.float32IsEqual 0.0f + createTest (=) false ] + |> testList "CSR byRows" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs index c9c171db..c27bf511 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs @@ -45,6 +45,12 @@ let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = let expected = Utils.createMatrixFromArray2D formatTo array isZero + "Row count should be the same" + |> Expect.equal actual.RowCount (Array2D.length1 array) + + "Column count should be the same" + |> Expect.equal actual.ColumnCount (Array2D.length2 array) + "Matrices should be equal" |> Expect.equal actual expected @@ -56,7 +62,7 @@ let createTest<'a when 'a: struct and 'a: equality> convertFun formatTo (isZero: |> List.map (fun formatFrom -> makeTest context q formatFrom formatTo convertFun isZero - |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>} from %A{formatFrom}") + |> testPropertyWithConfig config $"test on %A{typeof<'a>} from %A{formatFrom}") let testFixtures formatTo = match formatTo with diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index b47ee325..0421f533 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -16,7 +16,8 @@ let matrixTests = Matrix.SpGeMM.Expand.generalTests Matrix.SpGeMM.Masked.tests Matrix.Transpose.tests - Matrix.RowsLengths.tests ] + Matrix.RowsLengths.tests + Matrix.ByRows.tests ] |> testSequenced let commonTests = From acaa0c1c68a07fe217d9367d80ea21b2b6b703ae Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 24 Apr 2023 20:18:09 +0300 Subject: [PATCH 095/143] fix: host COO -> CSR --- src/GraphBLAS-sharp/Objects/Matrix.fs | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index c99e5b6a..468c1a5e 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -93,15 +93,12 @@ module Matrix = member this.ToCSR = let rowPointers = - let nnzPerRow = Array.zeroCreate this.RowCount - let rowPointers = Array.zeroCreate this.RowCount + let pointers = Array.zeroCreate this.RowCount - Array.iter (fun rowIndex -> nnzPerRow.[rowIndex] <- nnzPerRow.[rowIndex] + 1) this.Rows + Array.countBy id this.Rows + |> Array.iter (fun (index, count) -> pointers.[index] <- count) - for i in 1 .. this.RowCount - 1 do - rowPointers.[i] <- rowPointers.[i - 1] + nnzPerRow.[i - 1] - - rowPointers + Array.scan (+) 0 pointers { RowCount = this.RowCount ColumnCount = this.ColumnCount @@ -128,7 +125,7 @@ module Matrix = |> List.mapi (fun i x -> (x, i)) |> List.filter (fun pair -> not <| isZero (fst pair))) |> List.fold - (fun (colPtrs, valueInx) col -> ((colPtrs.Head + col.Length) :: colPtrs), valueInx @ col) + (fun (colPointers, valueInx) col -> ((colPointers.Head + col.Length) :: colPointers), valueInx @ col) ([ 0 ], []) { Values = From a4497543c2bc474f9d2920568b37c0f801910fa0 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 25 Apr 2023 11:44:50 +0300 Subject: [PATCH 096/143] add: host tests --- .../GraphBLAS-sharp.Benchmarks/Configs.fs | 6 +- .../Matrix/CSR/Matrix.fs | 2 +- .../Matrix/SpGeMM/Expand.fs | 16 +- src/GraphBLAS-sharp/IO/MtxReader.fs | 10 +- src/GraphBLAS-sharp/Objects/Matrix.fs | 6 +- .../{ => Backend}/Algorithms/BFS.fs | 0 .../{ => Backend}/Common/ClArray/Blit.fs | 0 .../{ => Backend}/Common/ClArray/Choose.fs | 0 .../Common/ClArray/ChunkBySize.fs | 0 .../{ => Backend}/Common/ClArray/Concat.fs | 0 .../{ => Backend}/Common/ClArray/Copy.fs | 0 .../{ => Backend}/Common/ClArray/Exists.fs | 0 .../{ => Backend}/Common/ClArray/Fill.fs | 0 .../{ => Backend}/Common/ClArray/Map.fs | 0 .../{ => Backend}/Common/ClArray/Map2.fs | 0 .../{ => Backend}/Common/ClArray/Pairwise.fs | 0 .../Common/ClArray/RemoveDuplicates.fs | 0 .../{ => Backend}/Common/ClArray/Replicate.fs | 0 .../{ => Backend}/Common/Gather.fs | 0 .../{ => Backend}/Common/Reduce/Reduce.fs | 0 .../Common/Reduce/ReduceByKey.fs | 0 .../{ => Backend}/Common/Reduce/Sum.fs | 0 .../{ => Backend}/Common/Scan/ByKey.fs | 0 .../{ => Backend}/Common/Scan/PrefixSum.fs | 0 .../{ => Backend}/Common/Scatter.fs | 0 .../{ => Backend}/Common/Sort/Bitonic.fs | 0 .../{ => Backend}/Common/Sort/Radix.fs | 0 .../{ => Backend}/Matrix/ByRows.fs | 27 +-- .../{ => Backend}/Matrix/Convert.fs | 0 .../{ => Backend}/Matrix/Map.fs | 0 .../{ => Backend}/Matrix/Map2.fs | 0 .../{ => Backend}/Matrix/RowsLengths.fs | 0 .../{ => Backend}/Matrix/SpGeMM/Expand.fs | 0 .../{ => Backend}/Matrix/SpGeMM/Masked.fs | 0 .../{ => Backend}/Matrix/Transpose.fs | 0 .../QuickGraph/Algorithms/BFS.fs | 0 .../Algorithms/ConnectedComponents.fs | 0 .../{ => Backend}/QuickGraph/CreateGraph.fs | 0 .../{ => Backend}/Vector/AssignByMask.fs | 0 .../{ => Backend}/Vector/Convert.fs | 0 .../{ => Backend}/Vector/Copy.fs | 0 .../{ => Backend}/Vector/Map2.fs | 0 .../{ => Backend}/Vector/OfList.fs | 0 .../{ => Backend}/Vector/Reduce.fs | 0 .../{ => Backend}/Vector/SpMV.fs | 0 .../{ => Backend}/Vector/ZeroCreate.fs | 0 .../GraphBLAS-sharp.Tests.fsproj | 86 ++++----- tests/GraphBLAS-sharp.Tests/Helpers.fs | 16 ++ .../Host/IO/Dataset/testMatrix.mtx | 5 + .../Host/IO/MtxReader.fs | 45 +++++ .../Host/Matrix/Convert.fs | 25 +++ .../Host/Matrix/FromaArray2D.fs | 169 ++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 22 ++- 53 files changed, 361 insertions(+), 74 deletions(-) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Algorithms/BFS.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Blit.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Choose.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/ChunkBySize.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Concat.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Copy.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Exists.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Fill.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Map.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Map2.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Pairwise.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/RemoveDuplicates.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/ClArray/Replicate.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Gather.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Reduce/Reduce.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Reduce/ReduceByKey.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Reduce/Sum.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Scan/ByKey.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Scan/PrefixSum.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Scatter.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Sort/Bitonic.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Common/Sort/Radix.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/ByRows.fs (59%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/Convert.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/Map.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/Map2.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/RowsLengths.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/SpGeMM/Expand.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/SpGeMM/Masked.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Matrix/Transpose.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/QuickGraph/Algorithms/BFS.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/QuickGraph/Algorithms/ConnectedComponents.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/QuickGraph/CreateGraph.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/AssignByMask.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/Convert.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/Copy.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/Map2.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/OfList.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/Reduce.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/SpMV.fs (100%) rename tests/GraphBLAS-sharp.Tests/{ => Backend}/Vector/ZeroCreate.fs (100%) create mode 100644 tests/GraphBLAS-sharp.Tests/Host/IO/Dataset/testMatrix.mtx create mode 100644 tests/GraphBLAS-sharp.Tests/Host/IO/MtxReader.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Host/Matrix/Convert.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs index 0d1c51d0..8f22f19f 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs @@ -18,7 +18,7 @@ type Matrix2() = "NNZ", fun (matrix,_) -> match matrix.Format with - | Coordinate -> matrix.ReadMatrixShape().Nnz + | Coordinate -> matrix.ReadMatrixShape().NNZ | Array -> 0 ) :> IColumn, @@ -26,7 +26,7 @@ type Matrix2() = "SqrNNZ", fun (_,matrix) -> match matrix.Format with - | Coordinate -> matrix.ReadMatrixShape().Nnz + | Coordinate -> matrix.ReadMatrixShape().NNZ | Array -> 0 ) :> IColumn, @@ -46,7 +46,7 @@ type Matrix() = "NNZ", fun matrix -> match matrix.Format with - | Coordinate -> matrix.ReadMatrixShape().Nnz + | Coordinate -> matrix.ReadMatrixShape().NNZ | Array -> 0 ) :> IColumn, diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 835596f1..40095927 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -139,7 +139,7 @@ module Matrix = let columns = getChunkIndices first count Some <| creatSparseVector values columns - else + else None)) let byRows (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 5f33fb90..704c0a98 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -301,13 +301,15 @@ module Expand = runRow processor allocationMode rightMatrix rightMatrixRowsLengths split processor allocationMode leftMatrix - |> Seq.map (fun lazyRow -> - Option.bind (fun row -> - let result = runRow row - row.Dispose processor - - result - ) lazyRow.Value) + |> Seq.map + (fun lazyRow -> + Option.bind + (fun row -> + let result = runRow row + row.Dispose processor + + result) + lazyRow.Value) |> Seq.toArray |> fun rows -> rightMatrixRowsLengths.Free processor diff --git a/src/GraphBLAS-sharp/IO/MtxReader.fs b/src/GraphBLAS-sharp/IO/MtxReader.fs index db4d4d5a..f25ce8c0 100644 --- a/src/GraphBLAS-sharp/IO/MtxReader.fs +++ b/src/GraphBLAS-sharp/IO/MtxReader.fs @@ -34,13 +34,13 @@ type MtxReader(pathToFile: string) = streamReader.ReadLine().Split(' ') |> Array.map int - let nrows = size.[0] - let ncols = size.[1] + let rowsCount = size.[0] + let columnsCount = size.[1] let nnz = size.[2] - {| RowCount = nrows - ColumnCount = ncols - Nnz = nnz |} + {| RowCount = rowsCount + ColumnCount = columnsCount + NNZ = nnz |} member this.ReadMatrix(converter: string -> 'a) : Matrix.COO<'a> = if object <> MtxMatrix then diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index 468c1a5e..558f965b 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -24,7 +24,8 @@ module Matrix = |> List.mapi (fun i x -> (x, i)) |> List.filter (fun pair -> not <| isZero (fst pair))) |> List.fold - (fun (rowPointers, valueInx) row -> ((rowPointers.Head + row.Length) :: rowPointers), valueInx @ row) + (fun (rowPointers, valueInx) row -> + ((rowPointers.Head + row.Length) :: rowPointers), valueInx @ row) ([ 0 ], []) { Values = @@ -125,7 +126,8 @@ module Matrix = |> List.mapi (fun i x -> (x, i)) |> List.filter (fun pair -> not <| isZero (fst pair))) |> List.fold - (fun (colPointers, valueInx) col -> ((colPointers.Head + col.Length) :: colPointers), valueInx @ col) + (fun (colPointers, valueInx) col -> + ((colPointers.Head + col.Length) :: colPointers), valueInx @ col) ([ 0 ], []) { Values = diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Blit.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Blit.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/ChunkBySize.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Concat.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Fill.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Pairwise.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Pairwise.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Pairwise.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Gather.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Scatter.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs similarity index 59% rename from tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs index 2b5cf78b..98270784 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/ByRows.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs @@ -15,9 +15,10 @@ let processor = Context.defaultContext.Queue let config = Utils.defaultConfig -let makeTest<'a when 'a : struct> isEqual zero testFun (array: 'a [,]) = +let makeTest<'a when 'a: struct> isEqual zero testFun (array: 'a [,]) = - let matrix = Matrix.CSR.FromArray2D(array, isEqual zero) + let matrix = + Matrix.CSR.FromArray2D(array, isEqual zero) if matrix.NNZ > 0 then @@ -29,15 +30,19 @@ let makeTest<'a when 'a : struct> isEqual zero testFun (array: 'a [,]) = |> Expect.equal (Seq.length rows) (Array2D.length1 array) rows - |> Seq.iteri (fun index -> function - | Some (actualRow: ClVector.Sparse<_>) -> - let expectedRow = Vector.Sparse.FromArray(array.[index, *], (isEqual zero)) - let actualHost = actualRow.ToHost processor + |> Seq.iteri + (fun index -> + function + | Some (actualRow: ClVector.Sparse<_>) -> + let expectedRow = + Vector.Sparse.FromArray(array.[index, *], (isEqual zero)) - Utils.compareSparseVectors isEqual actualHost expectedRow - | None -> - "Expected row must be None" - |> Expect.isFalse (Array.exists ((<<) not <| isEqual zero) array.[index, *])) + let actualHost = actualRow.ToHost processor + + Utils.compareSparseVectors isEqual actualHost expectedRow + | None -> + "Expected row must be None" + |> Expect.isFalse (Array.exists ((<<) not <| isEqual zero) array.[index, *])) let createTest isEqual (zero: 'a) = CSR.Matrix.byRows context Utils.defaultWorkGroupSize @@ -48,7 +53,7 @@ let tests = [ createTest (=) 0 if Utils.isFloat64Available context.ClDevice then - createTest Utils.floatIsEqual 0.0 + createTest Utils.floatIsEqual 0.0 createTest Utils.float32IsEqual 0.0f createTest (=) false ] diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/Map.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/RowsLengths.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/BFS.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs rename to tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/BFS.fs diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/ConnectedComponents.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs rename to tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/ConnectedComponents.fs diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/CreateGraph.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs rename to tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/CreateGraph.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/Convert.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/Copy.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/Map2.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/OfList.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index b507283f..a3558eac 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -13,47 +13,51 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 5325be0c..f12bada0 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -146,6 +146,22 @@ module Utils = <| actual.Rows <| expected.Rows + let compareCSRMatrix isEqual (actual: Matrix.CSR<'a>) (expected: Matrix.CSR<'a>) = + "Column count must be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount + + "Rows count must be the same" + |> Expect.equal actual.RowCount expected.RowCount + + "Values must be the same" + |> compareArrays isEqual actual.Values expected.Values + + "Column indices must be the same" + |> compareArrays (=) actual.ColumnIndices expected.ColumnIndices + + "Row pointers" + |> compareArrays (=) actual.RowPointers expected.RowPointers + let listOfUnionCases<'a> = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) diff --git a/tests/GraphBLAS-sharp.Tests/Host/IO/Dataset/testMatrix.mtx b/tests/GraphBLAS-sharp.Tests/Host/IO/Dataset/testMatrix.mtx new file mode 100644 index 00000000..2af703b9 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/IO/Dataset/testMatrix.mtx @@ -0,0 +1,5 @@ +%%MatrixMarket matrix coordinate integer general +2 3 3 +1 2 3 +2 2 2 +2 3 1 diff --git a/tests/GraphBLAS-sharp.Tests/Host/IO/MtxReader.fs b/tests/GraphBLAS-sharp.Tests/Host/IO/MtxReader.fs new file mode 100644 index 00000000..54b91ed6 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/IO/MtxReader.fs @@ -0,0 +1,45 @@ +module GraphBLAS.FSharp.Tests.Host.IO.MtxReader + +open System.IO +open Expecto +open GraphBLAS.FSharp.IO + +let matrixName = "testMatrix.mtx" + +let path = + Path.Combine [| __SOURCE_DIRECTORY__ + "Dataset" + matrixName |] + +let test = + test "mtxReader test" { + let matrixReader = MtxReader(path) + + let shape = matrixReader.ReadMatrixShape() + + "Rows count must be the same" + |> Expect.equal shape.RowCount 2 + + "Columns count must be the same" + |> Expect.equal shape.ColumnCount 3 + + "NNZ count must be the same" + |> Expect.equal shape.NNZ 3 + + let matrix = matrixReader.ReadMatrix(int) + + "Matrix row count must be the same" + |> Expect.equal matrix.RowCount 2 + + "Matrix column count must be the same" + |> Expect.equal matrix.ColumnCount 3 + + "Matrix values must be the same" + |> Expect.sequenceEqual matrix.Values [| 3; 2; 1 |] + + "Matrix columns must be the same" + |> Expect.sequenceEqual matrix.Columns [| 1; 1; 2 |] + + "Matrix rows must be the same" + |> Expect.sequenceEqual matrix.Rows [| 0; 1; 1 |] + } diff --git a/tests/GraphBLAS-sharp.Tests/Host/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Host/Matrix/Convert.fs new file mode 100644 index 00000000..358286a2 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/Matrix/Convert.fs @@ -0,0 +1,25 @@ +module GraphBLAS.FSharp.Tests.Host.Matrix.Convert + +open Expecto +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Tests + +let makeTest isEqual zero (array: 'a [,]) = + let cooMatrix = + Matrix.COO.FromArray2D(array, isEqual zero) + + let actual = cooMatrix.ToCSR + + let expected = + Matrix.CSR.FromArray2D(array, isEqual zero) + + Utils.compareCSRMatrix isEqual actual expected + +let createTest<'a when 'a: struct> isEqual (zero: 'a) = + makeTest isEqual zero + |> testPropertyWithConfig Utils.defaultConfig $"%A{typeof<'a>}" + +let tests = + [ createTest (=) 0 + createTest (=) false ] + |> testList "Convert" diff --git a/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs new file mode 100644 index 00000000..7d2a3bdd --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs @@ -0,0 +1,169 @@ +module GraphBLAS.FSharp.Tests.Host.Matrix.FromArray2D + +open Expecto +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Tests + +let config = Utils.defaultConfig + +let checkPointers isEqual zero array slice counter pointers (matrixValues: 'a []) (matrixIndices: int []) = + for i in 0 .. counter - 1 do + let expectedIndices, expectedValues = + slice array i + |> Array.mapi (fun index value -> (index, value)) + |> Array.filter (fun (_, value) -> ((<<) not <| isEqual zero) value) + |> Array.unzip + + let startRowPosition = Array.item i pointers + let endRowPosition = pointers.[i + 1] - 1 + + let actualValues = + matrixValues.[startRowPosition..endRowPosition] + + let actualIndices = + matrixIndices.[startRowPosition..endRowPosition] + + "Values must be the same" + |> Utils.compareArrays isEqual actualValues expectedValues + + "Indices must be the same" + |> Utils.compareArrays (=) actualIndices expectedIndices + +let makeTest isEqual zero createMatrix (array: 'a [,]) = + let matrix: Matrix<_> = createMatrix (isEqual zero) array + + let arrayRowCount = Array2D.length1 array + let arrayColumnCount = Array2D.length2 array + + "Row count must be the same" + |> Expect.equal matrix.RowCount arrayRowCount + + "Column count must be the same" + |> Expect.equal matrix.ColumnCount arrayColumnCount + + let nonZeroValues = + array + |> Seq.cast<'a> + |> Seq.filter ((<<) not <| isEqual zero) + |> Seq.toArray + + let checkPointers = checkPointers isEqual zero array + + match matrix with + | Matrix.CSR matrix -> + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values nonZeroValues + + "Row count invariant" + |> Expect.isTrue (matrix.RowPointers.Length = matrix.RowCount + 1) + + checkPointers + (fun (array: 'a [,]) i -> array.[i, *]) + arrayRowCount + matrix.RowPointers + matrix.Values + matrix.ColumnIndices + | Matrix.COO matrix -> + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values nonZeroValues + + let expectedColumns, expectedRows, expectedValues = + array + |> Seq.cast<'a> + |> Seq.mapi + (fun index value -> + let columnIndex = index % arrayColumnCount + let rowIndex = index / arrayColumnCount + + (columnIndex, rowIndex, value)) + |> Seq.filter (fun (_, _, value) -> ((<<) not <| isEqual zero) value) + |> Seq.toArray + |> Array.unzip3 + + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values expectedValues + + "Column indices must be the same" + |> Utils.compareArrays (=) matrix.Columns expectedColumns + + "Rows indices must be the same" + |> Utils.compareArrays (=) matrix.Rows expectedRows + | Matrix.CSC matrix -> + let expectedValues = + seq { + for i in 0 .. arrayColumnCount - 1 do + yield! array.[*, i] + } + |> Seq.filter ((<<) not <| isEqual zero) + |> Seq.toArray + + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values expectedValues + + "Row count invariant" + |> Expect.isTrue (matrix.ColumnPointers.Length = matrix.ColumnCount + 1) + + checkPointers + (fun array i -> array.[*, i]) + arrayColumnCount + matrix.ColumnPointers + matrix.Values + matrix.RowIndices + | Matrix.LIL matrix -> + "Rows count must be the same" + |> Expect.equal matrix.Rows.Length (Array2D.length1 array) + + matrix.Rows + |> Seq.iteri + (fun index -> + function + | Some actualRow -> + let expectedIndices, expectedValues = + array.[index, *] + |> Array.mapi (fun index value -> (index, value)) + |> Array.filter (fun (_, value) -> ((<<) not <| isEqual zero) value) + |> Array.unzip + + "Values must be the same" + |> Utils.compareArrays isEqual actualRow.Values expectedValues + + "Indices must be the same" + |> Utils.compareArrays (=) actualRow.Indices expectedIndices + | None -> + "No non zero items in row" + |> Expect.isFalse (Array.exists ((<<) not <| isEqual zero) array.[index, *])) + +let createTest name isEqual zero convert = + makeTest isEqual zero convert + |> testPropertyWithConfig config name + +let tests = + [ createTest + "CSR" + (=) + 0 + (fun isZero array -> + Matrix.CSR + <| Matrix.CSR.FromArray2D(array, isZero)) + createTest + "COO" + (=) + 0 + (fun isZero array -> + Matrix.COO + <| Matrix.COO.FromArray2D(array, isZero)) + createTest + "CSC" + (=) + 0 + (fun isZero array -> + Matrix.CSC + <| Matrix.CSC.FromArray2D(array, isZero)) + createTest + "LIL" + (=) + 0 + (fun isZero array -> + Matrix.LIL + <| Matrix.LIL.FromArray2D(array, isZero)) ] + |> testList "FromArray2D" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 0421f533..295430c8 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,6 +2,14 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests +let hostTests = + testList + "Host" + [ Host.Matrix.FromArray2D.tests + Host.Matrix.Convert.tests + Host.IO.MtxReader.test ] + |> testSequenced + let matrixTests = testList "Matrix tests" @@ -89,15 +97,21 @@ let algorithmsTests = testList "Algorithms tests" [ Algorithms.BFS.tests ] |> testSequenced -[] -let allTests = +let deviceTests = testList - "All tests" + "Device" [ matrixTests commonTests vectorTests algorithmsTests ] |> testSequenced +[] +let allTests = + testList "All tests" [ deviceTests; hostTests ] + |> testSequenced + [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = + Host.IO.MtxReader.test + |> runTestsWithCLIArgs [] argv From 29728030b6177bce5ecd8ab6261b35ff9cf7f952 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 25 Apr 2023 11:57:35 +0300 Subject: [PATCH 097/143] refactor: paths --- .../GraphBLAS-sharp.Tests.fsproj | 90 +++++++++---------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index a3558eac..ae6b7678 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -13,51 +13,51 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From efa50f4e09dec6e23e58be47ee9f7627df4cd243 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 25 Apr 2023 23:20:58 +0300 Subject: [PATCH 098/143] refactor: clean --- .../GraphBLAS-sharp.Benchmarks/Columns.fs | 2 +- .../GraphBLAS-sharp.Benchmarks/Helpers.fs | 74 ++----------------- 2 files changed, 6 insertions(+), 70 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs index 2851fac4..0b2173ae 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs @@ -5,7 +5,7 @@ open BenchmarkDotNet.Reports open BenchmarkDotNet.Running open GraphBLAS.FSharp.IO -type CommonColumn<'a>(benchmarkCaseConvert, columnName: string, getShape: 'a -> 'b) = +type CommonColumn<'a>(benchmarkCaseConvert, columnName: string, getShape: 'a -> _) = interface IColumn with member this.AlwaysShow = true member this.Category = ColumnCategory.Params diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs index 8702d511..6ce43002 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs @@ -108,16 +108,12 @@ module Utils = let queue = context.QueueProvider.CreateQueue() { ClContext = context; Queue = queue }) - let result = - seq { - for wgSize in workGroupSizes do - for context in contexts do - yield (context, wgSize) - } - - printfn "result length: %A" <| Seq.length result + seq { + for wgSize in workGroupSizes do + for context in contexts do + yield (context, wgSize) + } - result let nextSingle (random: System.Random) = let buffer = Array.zeroCreate 4 random.NextBytes buffer @@ -155,63 +151,3 @@ module VectorGenerator = let createVector array = Utils.createVectorFromArray format array (fIsEqual 0.0) pairOfVectorsOfEqualSize Utils.normalFloatGenerator createVector - - -module MatrixGenerator = - let private pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) createMatrix = - gen { - let! rowsCount, columnsCount = Generators.dimension2DGenerator - let! matrixA = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) - let! matrixB = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) - return (createMatrix matrixA, createMatrix matrixB) - } - - let intPairOfEqualSizes format = - fun array -> Utils.createMatrixFromArray2D format array ((=) 0) - |> pairOfMatricesOfEqualSizeGenerator Arb.generate - - let floatPairOfEqualSizes format = - fun array -> Utils.createMatrixFromArray2D format array (Utils.fIsEqual 0.0) - |> pairOfMatricesOfEqualSizeGenerator Utils.normalFloatGenerator - - let private pairOfMatricesWithMaskOfEqualSizeGenerator (valuesGenerator: Gen<'a>) format createMatrix = - gen { - let! rowsCount, columnsCount = Generators.dimension2DGenerator - let! matrixA = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) - let! matrixB = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) - let! mask = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) - - return (createMatrix format matrixA, - createMatrix format matrixB, - createMatrix COO mask) - } - - let intPairWithMaskOfEqualSizes format = - fun format array -> Utils.createMatrixFromArray2D format array ((=) 0) - |> pairOfMatricesWithMaskOfEqualSizeGenerator Arb.generate format - - let floatPairWithMaskOfEqualSizes format = - fun format array -> Utils.createMatrixFromArray2D format array (Utils.fIsEqual 0.0) - |> pairOfMatricesWithMaskOfEqualSizeGenerator Utils.normalFloatGenerator format - -module MatrixVectorGenerator = - let private pairOfMatricesAndVectorGenerator (valuesGenerator: Gen<'a>) createVector createMatrix = - gen { - let! rowsCount, columnsCount = Generators.dimension2DGenerator - let! matrixA = valuesGenerator |> Gen.array2DOfDim (rowsCount, columnsCount) - let! vector = valuesGenerator |> Gen.arrayOfLength columnsCount - - return (createMatrix matrixA, createVector vector) - } - - let intPairOfCompatibleSizes matrixFormat vectorFormat = - let createVector array = Utils.createVectorFromArray vectorFormat array ((=) 0) - let createMatrix array = Utils.createMatrixFromArray2D matrixFormat array ((=) 0) - - pairOfMatricesAndVectorGenerator Arb.generate createVector createMatrix - - let floatPairOfCompatibleSizes matrixFormat vectorFormat = - let createVector array = Utils.createVectorFromArray vectorFormat array (Utils.floatIsEqual 0.0) - let createMatrix array = Utils.createMatrixFromArray2D matrixFormat array (Utils.floatIsEqual 0.0) - - pairOfMatricesAndVectorGenerator Utils.normalFloatGenerator createVector createMatrix From 2b4a5b79ce423aa65e4d30627e5046ee8dac0bcd Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 26 Apr 2023 13:34:47 +0300 Subject: [PATCH 099/143] add: Vector.Merge --- src/GraphBLAS-sharp.Backend/Common/Merge.fs | 168 ++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Common/Merge.fs | 83 ++++++++ .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Program.fs | 182 +++++++++--------- 5 files changed, 344 insertions(+), 91 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Common/Merge.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Merge.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Merge.fs b/src/GraphBLAS-sharp.Backend/Common/Merge.fs new file mode 100644 index 00000000..39013559 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Merge.fs @@ -0,0 +1,168 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClContext + +module Merge = + module Vector = + let run<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = + + let merge = + <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allIndicesBuffer: ClArray) (firstResultValues: ClArray<'a>) (secondResultValues: ClArray<'b>) (isLeftBitMap: ClArray) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + + if lid < 2 then + // (n - 1) * wgSize - 1 for lid = 0 + // n * wgSize - 1 for lid = 1 + // where n in 1 .. wgGroupCount + let x = lid * (workGroupSize - 1) + gid - 1 + + let diagonalNumber = min (sumOfSides - 1) x + + let mutable leftEdge = max 0 (diagonalNumber + 1 - secondSide) + let mutable rightEdge = min (firstSide - 1) 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 lid = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge + + barrierLocal () + + let beginIdx = beginIdxLocal + let endIdx = endIdxLocal + let firstLocalLength = endIdx - beginIdx + let mutable x = workGroupSize - firstLocalLength + + if endIdx = firstSide then + x <- secondSide - gid + lid + 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 lid < firstLocalLength then + localIndices.[lid] <- firstIndicesBuffer.[beginIdx + lid] + + if lid < secondLocalLength then + localIndices.[firstLocalLength + lid] <- secondIndicesBuffer.[gid - beginIdx] + + barrierLocal () + + if gid < sumOfSides then + let mutable leftEdge = lid + 1 - secondLocalLength + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstLocalLength - 1 + + rightEdge <- min rightEdge lid + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] + + let secondIndex = + localIndices.[firstLocalLength + lid - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + let boundaryX = rightEdge + let boundaryY = lid - 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.[gid] <- sndIdx + secondResultValues.[gid] <- secondValuesBuffer.[gid - lid - beginIdx + boundaryY] + isLeftBitMap.[gid] <- 0 + else + allIndicesBuffer.[gid] <- fstIdx + firstResultValues.[gid] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitMap.[gid] <- 1 @> + + let kernel = clContext.Compile merge + + fun (processor: MailboxProcessor<_>) (firstVector: ClVector.Sparse<'a>) (secondVector: ClVector.Sparse<'b>) -> + + let firstSide = firstVector.Indices.Length + + let secondSide = secondVector.Indices.Length + + let sumOfSides = firstSide + secondSide + + let allIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let firstValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) + + let secondValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) + + let isLeftBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let ndRange = + Range1D.CreateValid(sumOfSides, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + firstVector.Indices + firstVector.Values + secondVector.Indices + secondVector.Values + allIndices + firstValues + secondValues + isLeftBitmap) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allIndices, firstValues, secondValues, isLeftBitmap + diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 74797513..02e48d8f 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,6 +35,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs new file mode 100644 index 00000000..c9c90366 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs @@ -0,0 +1,83 @@ +module GraphBLAS.FSharp.Tests.Common.Merge + +open GraphBLAS.FSharp.Backend.Vector +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp +open Expecto + +let processor = Context.defaultContext.Queue + +let context = Context.defaultContext.ClContext + +type Result<'a>= None | Left of 'a | Right of 'a + +let config = { Utils.defaultConfig with endSize = 100000 } + +let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = + let firstVector = Vector.Sparse.FromArray(firstArray, isEqual zero) + + let secondVector = Vector.Sparse.FromArray(secondArray, isEqual zero) + + if firstVector.NNZ > 0 && secondVector.NNZ > 0 then + + // actual run + let clFirstVector = firstVector.ToDevice context + + let clSecondVector = secondVector.ToDevice context + + let (allIndices: ClArray), (firstValues: ClArray<'a>), (secondValues: ClArray<'a>), (isLeftBitmap: ClArray) = + testFun processor clFirstVector clSecondVector + + clFirstVector.Dispose processor + clSecondVector.Dispose processor + + let actualIndices = allIndices.ToHostAndFree processor + let actualFirstValues = firstValues.ToHostAndFree processor + let actualSecondValues = secondValues.ToHostAndFree processor + let actualIsLeftBitmap = isLeftBitmap.ToHostAndFree processor + + let actualValues = + (actualFirstValues, actualSecondValues, actualIsLeftBitmap) + |||> Array.map3 (fun leftValue rightValue isLeft -> if isLeft = 1 then leftValue else rightValue) + + // expected run + let firstValuesAndIndices = + Array.map2 (fun value index -> (value, index)) firstVector.Values firstVector.Indices + + let secondValuesAndIndices = + Array.map2 (fun value index -> (value, index)) secondVector.Values secondVector.Indices + + // preserve order of values then use stable sort + let allValuesAndIndices = + Array.concat [ firstValuesAndIndices; secondValuesAndIndices ] + + // stable sort + let expectedValues, expectedIndices = + Seq.sortBy snd allValuesAndIndices + |> Seq.toArray + |> Array.unzip + + "Values should be the same" + |> Utils.compareArrays isEqual actualValues expectedValues + + "Indices should be the same" + |> Utils.compareArrays (=) actualIndices expectedIndices + +let createTest<'a when 'a : struct> isEqual (zero: 'a) = + Merge.Vector.run context Utils.defaultWorkGroupSize + |> makeTest isEqual zero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTest (=) 0.0 + + createTest Utils.float32IsEqual 0.0f + createTest (=) false ] + |> testList "Merge" + diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 650caaea..e5c14ef8 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -32,6 +32,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 7ae1811f..d3e9b84e 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,96 +2,96 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Map.notTests - Matrix.Map.addTests - Matrix.Map.mulTests - Matrix.Transpose.tests - Matrix.SpGeMM.Masked.tests - Matrix.SpGeMM.Expand.generalTests ] - |> testSequenced - -let commonTests = - let scanTests = - testList - "Scan" - [ Common.Scan.ByKey.sequentialSegmentsTests - Common.Scan.PrefixSum.tests ] - - let reduceTests = - testList - "Reduce" - [ Common.Reduce.ByKey.allTests - Common.Reduce.Reduce.tests - Common.Reduce.Sum.tests ] - - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.allTests ] - - let sortTests = - testList - "Sort" - [ Common.Sort.Bitonic.tests - Common.Sort.Radix.testByKeys - Common.Sort.Radix.testKeysOnly ] - - testList - "Common tests" - [ Common.Scatter.allTests - Common.Gather.allTests - clArrayTests - sortTests - reduceTests - scanTests ] - |> testSequenced - -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced - -[] -let allTests = - testList - "All tests" - [ matrixTests - vectorTests - commonTests - algorithmsTests ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Map.notTests +// Matrix.Map.addTests +// Matrix.Map.mulTests +// Matrix.Transpose.tests +// Matrix.SpGeMM.Masked.tests +// Matrix.SpGeMM.Expand.generalTests ] +// |> testSequenced +// +// let commonTests = +// let scanTests = +// testList +// "Scan" +// [ Common.Scan.ByKey.sequentialSegmentsTests +// Common.Scan.PrefixSum.tests ] +// +// let reduceTests = +// testList +// "Reduce" +// [ Common.Reduce.ByKey.allTests +// Common.Reduce.Reduce.tests +// Common.Reduce.Sum.tests ] +// +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.allTests ] +// +// let sortTests = +// testList +// "Sort" +// [ Common.Sort.Bitonic.tests +// Common.Sort.Radix.testByKeys +// Common.Sort.Radix.testKeysOnly ] +// +// testList +// "Common tests" +// [ Common.Scatter.allTests +// Common.Gather.allTests +// clArrayTests +// sortTests +// reduceTests +// scanTests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced +// +// [] +// let allTests = +// testList +// "All tests" +// [ matrixTests +// vectorTests +// commonTests +// algorithmsTests ] +// |> testSequenced [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = Common.Merge.tests |> testSequenced |> runTestsWithCLIArgs [] argv From 848a11b75379a23f9ae34211e80bdd90116a0e74 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 26 Apr 2023 23:21:28 +0300 Subject: [PATCH 100/143] refactor: Vector.Merge --- src/GraphBLAS-sharp.Backend/Common/Merge.fs | 168 ----------- .../GraphBLAS-sharp.Backend.fsproj | 3 +- .../Vector/SparseVector/Map2.fs | 90 ++++++ .../Vector/SparseVector/Map2AtLeastOne.fs | 260 ------------------ .../Vector/SparseVector/Merge.fs | 170 ++++++++++++ .../Vector/SparseVector/SparseVector.fs | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 6 +- .../{Common => Vector}/Merge.fs | 7 +- 8 files changed, 266 insertions(+), 440 deletions(-) delete mode 100644 src/GraphBLAS-sharp.Backend/Common/Merge.fs delete mode 100644 src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs create mode 100644 src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs rename tests/GraphBLAS-sharp.Tests/{Common => Vector}/Merge.fs (94%) diff --git a/src/GraphBLAS-sharp.Backend/Common/Merge.fs b/src/GraphBLAS-sharp.Backend/Common/Merge.fs deleted file mode 100644 index 39013559..00000000 --- a/src/GraphBLAS-sharp.Backend/Common/Merge.fs +++ /dev/null @@ -1,168 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.Common - -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ClContext - -module Merge = - module Vector = - let run<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = - - let merge = - <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allIndicesBuffer: ClArray) (firstResultValues: ClArray<'a>) (secondResultValues: ClArray<'b>) (isLeftBitMap: ClArray) -> - - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - - if lid < 2 then - // (n - 1) * wgSize - 1 for lid = 0 - // n * wgSize - 1 for lid = 1 - // where n in 1 .. wgGroupCount - let x = lid * (workGroupSize - 1) + gid - 1 - - let diagonalNumber = min (sumOfSides - 1) x - - let mutable leftEdge = max 0 (diagonalNumber + 1 - secondSide) - let mutable rightEdge = min (firstSide - 1) 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 lid = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge - - barrierLocal () - - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength - - if endIdx = firstSide then - x <- secondSide - gid + lid + 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 lid < firstLocalLength then - localIndices.[lid] <- firstIndicesBuffer.[beginIdx + lid] - - if lid < secondLocalLength then - localIndices.[firstLocalLength + lid] <- secondIndicesBuffer.[gid - beginIdx] - - barrierLocal () - - if gid < sumOfSides then - let mutable leftEdge = lid + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstLocalLength - 1 - - rightEdge <- min rightEdge lid - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - - let secondIndex = - localIndices.[firstLocalLength + lid - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = lid - 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.[gid] <- sndIdx - secondResultValues.[gid] <- secondValuesBuffer.[gid - lid - beginIdx + boundaryY] - isLeftBitMap.[gid] <- 0 - else - allIndicesBuffer.[gid] <- fstIdx - firstResultValues.[gid] <- firstValuesBuffer.[beginIdx + boundaryX] - isLeftBitMap.[gid] <- 1 @> - - let kernel = clContext.Compile merge - - fun (processor: MailboxProcessor<_>) (firstVector: ClVector.Sparse<'a>) (secondVector: ClVector.Sparse<'b>) -> - - let firstSide = firstVector.Indices.Length - - let secondSide = secondVector.Indices.Length - - let sumOfSides = firstSide + secondSide - - let allIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let firstValues = - clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) - - let secondValues = - clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) - - let isLeftBitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let ndRange = - Range1D.CreateValid(sumOfSides, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - firstVector.Indices - firstVector.Values - secondVector.Indices - secondVector.Values - allIndices - firstValues - secondValues - isLeftBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - allIndices, firstValues, secondValues, isLeftBitmap - diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 02e48d8f..a553abb0 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,7 +35,6 @@ - @@ -49,8 +48,8 @@ + - diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs index 851b28c1..b948b626 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs @@ -206,3 +206,93 @@ module internal Map2 = Values = resultValues Indices = resultIndices Size = rightVector.Size } + + module AtLeastOne = + let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + op + workGroupSize + = + + let preparePositions opAdd = + <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < length - 1 + && allIndices.[gid] = allIndices.[gid + 1] then + let result = + (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) + + (%PreparePositions.both) gid result positions allValues + elif (gid < length + && gid > 0 + && allIndices.[gid - 1] <> allIndices.[gid]) + || gid = 0 then + let leftResult = (%opAdd) (Some leftValues.[gid]) None + let rightResult = (%opAdd) None (Some rightValues.[gid]) + + (%PreparePositions.leftRight) gid leftResult rightResult isLeft allValues positions @> + + let kernel = clContext.Compile <| preparePositions op + + fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + + let length = allIndices.Length + + let allValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) + + let positions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allValues, positions + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = + + let merge = Merge.run clContext workGroupSize + + let prepare = + preparePositions<'a, 'b, 'c> clContext op workGroupSize + + let setPositions = + Common.setPositions clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> + + let allIndices, leftValues, rightValues, isLeft = merge processor leftVector rightVector + + let allValues, positions = + prepare processor allIndices leftValues rightValues isLeft + + processor.Post(Msg.CreateFreeMsg<_>(leftValues)) + processor.Post(Msg.CreateFreeMsg<_>(rightValues)) + processor.Post(Msg.CreateFreeMsg<_>(isLeft)) + + let resultValues, resultIndices = + setPositions processor allocationMode allValues allIndices positions + + processor.Post(Msg.CreateFreeMsg<_>(allIndices)) + processor.Post(Msg.CreateFreeMsg<_>(allValues)) + processor.Post(Msg.CreateFreeMsg<_>(positions)) + + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = max leftVector.Size rightVector.Size } diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs deleted file mode 100644 index 8c346b87..00000000 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2AtLeastOne.fs +++ /dev/null @@ -1,260 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.Vector.Sparse - -open Brahma.FSharp -open Microsoft.FSharp.Control -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ClVector -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Backend.Quotes - -module internal Map2AtLeastOne = - let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = - - let merge = - <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allIndicesBuffer: ClArray) (firstResultValues: ClArray<'a>) (secondResultValues: ClArray<'b>) (isLeftBitMap: ClArray) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - - if localID < 2 then - let x = localID * (workGroupSize - 1) + i - 1 - - let diagonalNumber = min (sumOfSides - 1) x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - leftEdge <- max 0 leftEdge - - let mutable rightEdge = firstSide - 1 - - rightEdge <- min 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 - - barrierLocal () - - 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] - - barrierLocal () - - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstLocalLength - 1 - - rightEdge <- min 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 - secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - isLeftBitMap.[i] <- 0 - else - allIndicesBuffer.[i] <- fstIdx - firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - isLeftBitMap.[i] <- 1 @> - - let kernel = clContext.Compile merge - - fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (secondValues: ClArray<'b>) -> - - let firstSide = firstIndices.Length - - let secondSide = secondIndices.Length - - let sumOfSides = - firstIndices.Length + secondIndices.Length - - let allIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let firstResultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) - - let secondResultValues = - clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) - - let isLeftBitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) - - let ndRange = - Range1D.CreateValid(sumOfSides, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - firstIndices - firstValues - secondIndices - secondValues - allIndices - firstResultValues - secondResultValues - isLeftBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - allIndices, firstResultValues, secondResultValues, isLeftBitmap - - let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) - op - workGroupSize - = - - let preparePositions opAdd = - <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> - - let gid = ndRange.GlobalID0 - - if gid < length - 1 - && allIndices.[gid] = allIndices.[gid + 1] then - let result = - (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) - - (%PreparePositions.both) gid result positions allValues - elif (gid < length - && gid > 0 - && allIndices.[gid - 1] <> allIndices.[gid]) - || gid = 0 then - let leftResult = (%opAdd) (Some leftValues.[gid]) None - let rightResult = (%opAdd) None (Some rightValues.[gid]) - - (%PreparePositions.leftRight) gid leftResult rightResult isLeft allValues positions @> - - let kernel = clContext.Compile <| preparePositions op - - fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> - - let length = allIndices.Length - - let allValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) - - let positions = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - let ndRange = - Range1D.CreateValid(length, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - allValues, positions - - ///. - ///. - ///Should be a power of 2 and greater than 1. - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = - - let merge = merge clContext workGroupSize - - let prepare = - preparePositions<'a, 'b, 'c> clContext op workGroupSize - - let setPositions = - Common.setPositions clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> - - let allIndices, leftValues, rightValues, isLeft = - merge processor leftVector.Indices leftVector.Values rightVector.Indices rightVector.Values - - let allValues, positions = - prepare processor allIndices leftValues rightValues isLeft - - processor.Post(Msg.CreateFreeMsg<_>(leftValues)) - processor.Post(Msg.CreateFreeMsg<_>(rightValues)) - processor.Post(Msg.CreateFreeMsg<_>(isLeft)) - - let resultValues, resultIndices = - setPositions processor allocationMode allValues allIndices positions - - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) - processor.Post(Msg.CreateFreeMsg<_>(allValues)) - processor.Post(Msg.CreateFreeMsg<_>(positions)) - - { Context = clContext - Values = resultValues - Indices = resultIndices - Size = max leftVector.Size rightVector.Size } diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs new file mode 100644 index 00000000..5989fa70 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs @@ -0,0 +1,170 @@ +namespace GraphBLAS.FSharp.Backend.Vector.Sparse + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClContext + +module internal Merge = + let run<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = + + let merge = + <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allIndicesBuffer: ClArray) (firstResultValues: ClArray<'a>) (secondResultValues: ClArray<'b>) (isLeftBitMap: ClArray) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + + if lid < 2 then + // (n - 1) * wgSize - 1 for lid = 0 + // n * wgSize - 1 for lid = 1 + // where n in 1 .. wgGroupCount + let x = lid * (workGroupSize - 1) + gid - 1 + + let diagonalNumber = min (sumOfSides - 1) x + + let mutable leftEdge = + max 0 (diagonalNumber + 1 - secondSide) + + let mutable rightEdge = + min (firstSide - 1) 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 lid = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge + + barrierLocal () + + let beginIdx = beginIdxLocal + let endIdx = endIdxLocal + let firstLocalLength = endIdx - beginIdx + let mutable x = workGroupSize - firstLocalLength + + if endIdx = firstSide then + x <- secondSide - gid + lid + 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 lid < firstLocalLength then + localIndices.[lid] <- firstIndicesBuffer.[beginIdx + lid] + + if lid < secondLocalLength then + localIndices.[firstLocalLength + lid] <- secondIndicesBuffer.[gid - beginIdx] + + barrierLocal () + + if gid < sumOfSides then + let mutable leftEdge = lid + 1 - secondLocalLength + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstLocalLength - 1 + + rightEdge <- min rightEdge lid + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] + + let secondIndex = + localIndices.[firstLocalLength + lid - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + let boundaryX = rightEdge + let boundaryY = lid - 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.[gid] <- sndIdx + secondResultValues.[gid] <- secondValuesBuffer.[gid - lid - beginIdx + boundaryY] + isLeftBitMap.[gid] <- 0 + else + allIndicesBuffer.[gid] <- fstIdx + firstResultValues.[gid] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitMap.[gid] <- 1 @> + + let kernel = clContext.Compile merge + + fun (processor: MailboxProcessor<_>) (firstVector: ClVector.Sparse<'a>) (secondVector: ClVector.Sparse<'b>) -> + + let firstSide = firstVector.Indices.Length + + let secondSide = secondVector.Indices.Length + + let sumOfSides = firstSide + secondSide + + let allIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let firstValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) + + let secondValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, sumOfSides) + + let isLeftBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, sumOfSides) + + let ndRange = + Range1D.CreateValid(sumOfSides, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + firstVector.Indices + firstVector.Values + secondVector.Indices + secondVector.Values + allIndices + firstValues + secondValues + isLeftBitmap) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allIndices, firstValues, secondValues, isLeftBitmap + diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 2e597e1f..18d33dd3 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -12,7 +12,7 @@ module SparseVector = let map2 = Map2.run let map2AtLeastOne (clContext: ClContext) opAdd workGroupSize allocationMode = - Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize allocationMode + Map2.AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize allocationMode let assignByMask = Map2.assignByMask diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index e5c14ef8..9d8b24f7 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -32,11 +32,6 @@ - - - - - @@ -44,6 +39,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs b/tests/GraphBLAS-sharp.Tests/Vector/Merge.fs similarity index 94% rename from tests/GraphBLAS-sharp.Tests/Common/Merge.fs rename to tests/GraphBLAS-sharp.Tests/Vector/Merge.fs index c9c90366..68f3f6d8 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Merge.fs @@ -7,14 +7,13 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Brahma.FSharp open Expecto +open GraphBLAS.FSharp.Backend let processor = Context.defaultContext.Queue let context = Context.defaultContext.ClContext -type Result<'a>= None | Left of 'a | Right of 'a - -let config = { Utils.defaultConfig with endSize = 100000 } +let config = Utils.defaultConfig let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = let firstVector = Vector.Sparse.FromArray(firstArray, isEqual zero) @@ -67,7 +66,7 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = |> Utils.compareArrays (=) actualIndices expectedIndices let createTest<'a when 'a : struct> isEqual (zero: 'a) = - Merge.Vector.run context Utils.defaultWorkGroupSize + Vector.Sparse.Merge.run context Utils.defaultWorkGroupSize |> makeTest isEqual zero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" From 661e085fdcae7dcbdb906ea6782e0b54444d6276 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 09:35:24 +0300 Subject: [PATCH 101/143] add: Matrix.Merge.tests --- .../GraphBLAS-sharp.Backend.fsproj | 20 +- .../Matrix/{COOMatrix => COO}/Map.fs | 0 .../Matrix/{COOMatrix => COO}/Map2.fs | 122 +++++++++++- .../Matrix/{COOMatrix => COO}/Matrix.fs | 2 +- .../Map2AtLeastOne.fs => COO/Merge.fs} | 154 ++------------- .../Matrix/{CSRMatrix => CSR}/GetTuples.fs | 0 .../Matrix/{CSRMatrix => CSR}/Map.fs | 0 .../Matrix/{CSRMatrix => CSR}/Map2.fs | 122 ++++++++++++ .../Matrix/{CSRMatrix => CSR}/Matrix.fs | 28 +-- .../Map2AtLeastOne.fs => CSR/Merge.fs} | 164 ++-------------- .../{CSRMatrix => CSR}/SpGEMM/Expand.fs | 0 .../{CSRMatrix => CSR}/SpGEMM/Masked.fs | 0 .../Matrix/{CSRMatrix => CSR}/SpMSpV.fs | 0 .../Matrix/{CSRMatrix => CSR}/Transpose.fs | 0 src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 6 +- .../Vector/SparseVector/Map2.fs | 10 +- .../Vector/SparseVector/Merge.fs | 7 +- .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs | 177 ++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 5 +- tests/GraphBLAS-sharp.Tests/Vector/Merge.fs | 28 ++- 21 files changed, 512 insertions(+), 334 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix => COO}/Map.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix => COO}/Map2.fs (51%) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix => COO}/Matrix.fs (98%) rename src/GraphBLAS-sharp.Backend/Matrix/{COOMatrix/Map2AtLeastOne.fs => COO/Merge.fs} (54%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/GetTuples.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Map.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Map2.fs (53%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Matrix.fs (85%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix/Map2AtLeastOne.fs => CSR/Merge.fs} (57%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/SpGEMM/Expand.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/SpGEMM/Masked.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/SpMSpV.fs (100%) rename src/GraphBLAS-sharp.Backend/Matrix/{CSRMatrix => CSR}/Transpose.fs (100%) create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index a553abb0..2ca63116 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -36,16 +36,16 @@ - - - - - - - - - - + + + + + + + + + + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs similarity index 51% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs index ee0f1b4f..00ac1075 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs @@ -8,10 +8,8 @@ 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 module internal Map2 = - let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = @@ -134,3 +132,123 @@ module internal Map2 = Rows = resultRows Columns = resultColumns Values = resultValues } + + module AtLeastOne = + let preparePositionsAtLeastOne<'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 preparePositions = + <@ fun (ndRange: Range1D) length (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftValuesBuffer: ClArray<'a>) (rightValuesBuffer: ClArray<'b>) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) (isLeftBitmap: ClArray) -> + + let i = ndRange.GlobalID0 + + if (i < length - 1 + && allRowsBuffer.[i] = allRowsBuffer.[i + 1] + && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1]) then + + let result = + (%opAdd) (Some leftValuesBuffer.[i + 1]) (Some rightValuesBuffer.[i]) + + (%PreparePositions.both) i result rawPositionsBuffer allValuesBuffer + elif (i > 0 + && i < length + && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1] + || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1])) + || i = 0 then + + let leftResult = + (%opAdd) (Some leftValuesBuffer.[i]) None + + let rightResult = + (%opAdd) None (Some rightValuesBuffer.[i]) + + (%PreparePositions.leftRight) + i + leftResult + rightResult + isLeftBitmap + allValuesBuffer + rawPositionsBuffer @> + + let kernel = clContext.Compile(preparePositions) + + fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + let length = leftValues.Length + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let rawPositionsGpu = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + let allValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + length + allRows + allColumns + leftValues + rightValues + allValues + rawPositionsGpu + isLeft) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + rawPositionsGpu, allValues + + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let merge = Merge.run clContext workGroupSize + + let preparePositions = + preparePositionsAtLeastOne clContext opAdd workGroupSize + + let setPositions = + Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + + let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = + merge queue matrixLeft matrixRight + + let rawPositions, allValues = + preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft + + queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) + queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode allRows allColumns allValues rawPositions + + queue.Post(Msg.CreateFreeMsg<_>(isLeft)) + queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) + queue.Post(Msg.CreateFreeMsg<_>(allRows)) + queue.Post(Msg.CreateFreeMsg<_>(allColumns)) + queue.Post(Msg.CreateFreeMsg<_>(allValues)) + + { Context = clContext + RowCount = matrixLeft.RowCount + ColumnCount = matrixLeft.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs similarity index 98% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index f6a389d6..dd708c37 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -21,7 +21,7 @@ module Matrix = workGroupSize = - Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2.AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize let getTuples (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs similarity index 54% rename from src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs rename to src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs index 0c776f10..e9cbf08d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs @@ -1,90 +1,11 @@ namespace GraphBLAS.FSharp.Backend.Matrix.COO 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 +open GraphBLAS.FSharp.Backend.Objects -module internal Map2AtLeastOne = - let preparePositionsAtLeastOne<'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 preparePositions = - <@ fun (ndRange: Range1D) length (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftValuesBuffer: ClArray<'a>) (rightValuesBuffer: ClArray<'b>) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) (isLeftBitmap: ClArray) -> - - let i = ndRange.GlobalID0 - - if (i < length - 1 - && allRowsBuffer.[i] = allRowsBuffer.[i + 1] - && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1]) then - - let result = - (%opAdd) (Some leftValuesBuffer.[i + 1]) (Some rightValuesBuffer.[i]) - - (%PreparePositions.both) i result rawPositionsBuffer allValuesBuffer - elif (i > 0 - && i < length - && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1] - || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1])) - || i = 0 then - - let leftResult = - (%opAdd) (Some leftValuesBuffer.[i]) None - - let rightResult = - (%opAdd) None (Some rightValuesBuffer.[i]) - - (%PreparePositions.leftRight) - i - leftResult - rightResult - isLeftBitmap - allValuesBuffer - rawPositionsBuffer @> - - let kernel = clContext.Compile(preparePositions) - - fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> - let length = leftValues.Length - - let ndRange = - Range1D.CreateValid(length, workGroupSize) - - let rawPositionsGpu = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - let allValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allRows - allColumns - leftValues - rightValues - allValues - rawPositionsGpu - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - rawPositionsGpu, allValues - - let merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = +module Merge = + let run<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = let merge = <@ fun (ndRange: Range1D) firstSide secondSide sumOfSides (firstRowsBuffer: ClArray) (firstColumnsBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondRowsBuffer: ClArray) (secondColumnsBuffer: ClArray) (secondValuesBuffer: ClArray<'b>) (allRowsBuffer: ClArray) (allColumnsBuffer: ClArray) (leftMergedValuesBuffer: ClArray<'a>) (rightMergedValuesBuffer: ClArray<'b>) (isLeftBitmap: ClArray) -> @@ -209,10 +130,10 @@ module internal Map2AtLeastOne = let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (matrixLeftRows: ClArray) (matrixLeftColumns: ClArray) (matrixLeftValues: ClArray<'a>) (matrixRightRows: ClArray) (matrixRightColumns: ClArray) (matrixRightValues: ClArray<'b>) -> + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> - let firstSide = matrixLeftValues.Length - let secondSide = matrixRightValues.Length + let firstSide = leftMatrix.Columns.Length + let secondSide = rightMatrix.Columns.Length let sumOfSides = firstSide + secondSide let allRows = @@ -243,12 +164,12 @@ module internal Map2AtLeastOne = firstSide secondSide sumOfSides - matrixLeftRows - matrixLeftColumns - matrixLeftValues - matrixRightRows - matrixRightColumns - matrixRightValues + leftMatrix.Rows + leftMatrix.Columns + leftMatrix.Values + rightMatrix.Rows + rightMatrix.Columns + rightMatrix.Values allRows allColumns leftMergedValues @@ -259,54 +180,3 @@ module internal Map2AtLeastOne = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) allRows, allColumns, leftMergedValues, rightMergedValues, isLeft - - ///. - ///. - ///Should be a power of 2 and greater than 1. - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupSize - = - - let merge = merge clContext workGroupSize - - let preparePositions = - preparePositionsAtLeastOne clContext opAdd workGroupSize - - let setPositions = - Common.setPositions<'c> clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> - - let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = - merge - queue - matrixLeft.Rows - matrixLeft.Columns - matrixLeft.Values - matrixRight.Rows - matrixRight.Columns - matrixRight.Values - - let rawPositions, allValues = - preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft - - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) - - let resultRows, resultColumns, resultValues, _ = - setPositions queue allocationMode allRows allColumns allValues rawPositions - - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) - - { Context = clContext - RowCount = matrixLeft.RowCount - ColumnCount = matrixLeft.ColumnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/GetTuples.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/GetTuples.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/GetTuples.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/GetTuples.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs similarity index 53% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index b189da13..78360ddb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -149,3 +149,125 @@ module internal Map2 = fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> map2ToCOO queue allocationMode matrixLeft matrixRight |> toCSRInplace queue allocationMode + + module AtLeastOne = + let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let preparePositions = + <@ fun (ndRange: Range1D) length (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (allValues: ClArray<'c>) (rawPositions: ClArray) (isEndOfRowBitmap: ClArray) (isLeftBitmap: ClArray) -> + + let i = ndRange.GlobalID0 + + if (i < length - 1 + && allColumns.[i] = allColumns.[i + 1] + && isEndOfRowBitmap.[i] = 0) then + + let result = + (%opAdd) (Some leftValues.[i + 1]) (Some rightValues.[i]) + + (%PreparePositions.both) i result rawPositions allValues + elif i = 0 + || (i < length + && (allColumns.[i] <> allColumns.[i - 1] + || isEndOfRowBitmap.[i - 1] = 1)) then + + let leftResult = (%opAdd) (Some leftValues.[i]) None + let rightResult = (%opAdd) None (Some rightValues.[i]) + + (%PreparePositions.leftRight) i leftResult rightResult isLeftBitmap allValues rawPositions @> + + let kernel = clContext.Compile(preparePositions) + + fun (processor: MailboxProcessor<_>) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isEndOfRow: ClArray) (isLeft: ClArray) -> + let length = leftValues.Length + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let rowPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + let allValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + length + allColumns + leftValues + rightValues + allValues + rowPositions + isEndOfRow + isLeft) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + rowPositions, allValues + + 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 merge = + GraphBLAS.FSharp.Backend.Matrix.CSR.Merge.run clContext workGroupSize + + let preparePositions = + preparePositions clContext opAdd workGroupSize + + let setPositions = + Matrix.Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + + let allRows, allColumns, leftMergedValues, rightMergedValues, isRowEnd, isLeft = + merge queue matrixLeft matrixRight + + let positions, allValues = + preparePositions queue allColumns leftMergedValues rightMergedValues isRowEnd isLeft + + queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) + queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode allRows allColumns allValues positions + + queue.Post(Msg.CreateFreeMsg<_>(allRows)) + queue.Post(Msg.CreateFreeMsg<_>(isLeft)) + queue.Post(Msg.CreateFreeMsg<_>(isRowEnd)) + queue.Post(Msg.CreateFreeMsg<_>(positions)) + queue.Post(Msg.CreateFreeMsg<_>(allColumns)) + queue.Post(Msg.CreateFreeMsg<_>(allValues)) + + { 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 elementwiseToCOO = runToCOO clContext opAdd workGroupSize + + let toCSRInPlace = + Matrix.toCSRInplace clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + elementwiseToCOO queue allocationMode matrixLeft matrixRight + |> toCSRInPlace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs similarity index 85% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 63cd4fcc..12f42b57 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -37,7 +37,7 @@ module Matrix = Columns = cols Values = values } - let toCOOInplace (clContext: ClContext) workGroupSize = + let toCOOInPlace (clContext: ClContext) workGroupSize = let prepare = Common.expandRowPointers clContext workGroupSize @@ -64,7 +64,7 @@ module Matrix = workGroupSize = - Map2AtLeastOne.runToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2.AtLeastOne.runToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) @@ -72,37 +72,37 @@ module Matrix = workGroupSize = - Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2.AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize - let transposeInplace (clContext: ClContext) workGroupSize = + let transposeInPlace (clContext: ClContext) workGroupSize = - let toCOOInplace = toCOOInplace clContext workGroupSize + let toCOOInPlace = toCOOInPlace clContext workGroupSize - let transposeInplace = + let transposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize - let toCSRInplace = + let toCSRInPlace = COO.Matrix.toCSRInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - toCOOInplace queue allocationMode matrix - |> transposeInplace queue - |> toCSRInplace queue allocationMode + toCOOInPlace queue allocationMode matrix + |> transposeInPlace queue + |> toCSRInPlace queue allocationMode let transpose (clContext: ClContext) workGroupSize = let toCOO = toCOO clContext workGroupSize - let transposeInplace = + let transposeInPlace = COO.Matrix.transposeInplace clContext workGroupSize - let toCSRInplace = + let toCSRInPlace = COO.Matrix.toCSRInplace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix - |> transposeInplace queue - |> toCSRInplace queue allocationMode + |> transposeInPlace queue + |> toCSRInPlace queue allocationMode module SpGeMM = let masked diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs similarity index 57% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs index 65bc2e42..05402e21 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2AtLeastOne.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs @@ -1,80 +1,12 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR -open System open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Quotes -open Microsoft.FSharp.Quotations -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Backend.Matrix.COO +open System open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ClMatrix - -module internal Map2AtLeastOne = - let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupSize - = - - let preparePositions = - <@ fun (ndRange: Range1D) length (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (allValues: ClArray<'c>) (rawPositions: ClArray) (isEndOfRowBitmap: ClArray) (isLeftBitmap: ClArray) -> - - let i = ndRange.GlobalID0 - - if (i < length - 1 - && allColumns.[i] = allColumns.[i + 1] - && isEndOfRowBitmap.[i] = 0) then - - let result = - (%opAdd) (Some leftValues.[i + 1]) (Some rightValues.[i]) - - (%PreparePositions.both) i result rawPositions allValues - elif i = 0 - || (i < length - && (allColumns.[i] <> allColumns.[i - 1] - || isEndOfRowBitmap.[i - 1] = 1)) then - - let leftResult = (%opAdd) (Some leftValues.[i]) None - let rightResult = (%opAdd) None (Some rightValues.[i]) - - (%PreparePositions.leftRight) i leftResult rightResult isLeftBitmap allValues rawPositions @> - - let kernel = clContext.Compile(preparePositions) - - fun (processor: MailboxProcessor<_>) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isEndOfRow: ClArray) (isLeft: ClArray) -> - let length = leftValues.Length - - let ndRange = - Range1D.CreateValid(length, workGroupSize) - - let rowPositions = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - let allValues = - clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allColumns - leftValues - rightValues - allValues - rowPositions - isEndOfRow - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - rowPositions, allValues +open GraphBLAS.FSharp.Backend.Objects.ClContext - let merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = +module Merge = + let run<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = let localArraySize = workGroupSize + 2 let merge = @@ -229,10 +161,10 @@ module internal Map2AtLeastOne = let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (matrixLeftRowPointers: ClArray) (matrixLeftColumns: ClArray) (matrixLeftValues: ClArray<'a>) (matrixRightRowPointers: ClArray) (matrixRightColumns: ClArray) (matrixRightValues: ClArray<'b>) -> + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let firstLength = matrixLeftValues.Length - let secondLength = matrixRightValues.Length + let firstLength = leftMatrix.Columns.Length + let secondLength = rightMatrix.Columns.Length let resLength = firstLength + secondLength let allRows = @@ -254,7 +186,11 @@ module internal Map2AtLeastOne = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resLength) let ndRange = - Range1D.CreateValid((matrixLeftRowPointers.Length - 1) * workGroupSize, workGroupSize) + Range1D.CreateValid( + (leftMatrix.RowPointers.Length - 1) + * workGroupSize, + workGroupSize + ) let kernel = kernel.GetKernel() @@ -263,12 +199,12 @@ module internal Map2AtLeastOne = (fun () -> kernel.KernelFunc ndRange - matrixLeftRowPointers - matrixLeftColumns - matrixLeftValues - matrixRightRowPointers - matrixRightColumns - matrixRightValues + leftMatrix.RowPointers + leftMatrix.Columns + leftMatrix.Values + rightMatrix.RowPointers + rightMatrix.Columns + rightMatrix.Values allRows allColumns leftMergedValues @@ -280,67 +216,3 @@ module internal Map2AtLeastOne = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) allRows, allColumns, leftMergedValues, rightMergedValues, isEndOfRow, isLeft - - 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 merge = merge clContext workGroupSize - - let preparePositions = - preparePositions clContext opAdd workGroupSize - - let setPositions = - Matrix.Common.setPositions<'c> clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - - let allRows, allColumns, leftMergedValues, rightMergedValues, isRowEnd, isLeft = - merge - queue - matrixLeft.RowPointers - matrixLeft.Columns - matrixLeft.Values - matrixRight.RowPointers - matrixRight.Columns - matrixRight.Values - - let positions, allValues = - preparePositions queue allColumns leftMergedValues rightMergedValues isRowEnd isLeft - - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) - - let resultRows, resultColumns, resultValues, _ = - setPositions queue allocationMode allRows allColumns allValues positions - - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(isRowEnd)) - queue.Post(Msg.CreateFreeMsg<_>(positions)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) - - { 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 elementwiseToCOO = runToCOO clContext opAdd workGroupSize - - let toCSRInplace = - Matrix.toCSRInplace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - elementwiseToCOO queue allocationMode matrixLeft matrixRight - |> toCSRInplace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpMSpV.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpMSpV.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpMSpV.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/SpMSpV.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Transpose.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Transpose.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Transpose.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSR/Transpose.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 7b93b433..3458a4f8 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -73,7 +73,7 @@ module Matrix = COO.Matrix.toCSRInplace clContext workGroupSize let transposeInplace = - CSR.Matrix.transposeInplace clContext workGroupSize + CSR.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -117,7 +117,7 @@ module Matrix = ///Should be a power of 2 and greater than 1. let toCOOInplace (clContext: ClContext) workGroupSize = let toCOOInplace = - CSR.Matrix.toCOOInplace clContext workGroupSize + CSR.Matrix.toCOOInPlace clContext workGroupSize let transposeInplace = COO.Matrix.transposeInplace clContext workGroupSize @@ -173,7 +173,7 @@ module Matrix = COO.Matrix.toCSRInplace clContext workGroupSize let transposeCSRInplace = - CSR.Matrix.transposeInplace clContext workGroupSize + CSR.Matrix.transposeInPlace clContext workGroupSize let transposeCOOInplace = COO.Matrix.transposeInplace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs index b948b626..38137487 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs @@ -254,7 +254,15 @@ module internal Map2 = processor.Post( Msg.MsgSetArguments (fun () -> - kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions) + kernel.KernelFunc + ndRange + length + allIndices + leftValues + rightValues + isLeft + allValues + positions) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs index 5989fa70..459ab6d5 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs @@ -24,11 +24,9 @@ module internal Merge = let diagonalNumber = min (sumOfSides - 1) x - let mutable leftEdge = - max 0 (diagonalNumber + 1 - secondSide) + let mutable leftEdge = max 0 (diagonalNumber + 1 - secondSide) - let mutable rightEdge = - min (firstSide - 1) diagonalNumber + let mutable rightEdge = min (firstSide - 1) diagonalNumber while leftEdge <= rightEdge do let middleIdx = (leftEdge + rightEdge) / 2 @@ -167,4 +165,3 @@ module internal Merge = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) allIndices, firstValues, secondValues, isLeftBitmap - diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 9d8b24f7..c1ec2f78 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -48,6 +48,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs new file mode 100644 index 00000000..a77898a1 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs @@ -0,0 +1,177 @@ +module GraphBLAS.FSharp.Tests.Matrix.Merge + +open Brahma.FSharp +open Expecto +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = Utils.defaultConfig + +let checkResult isEqual zero (actual: Matrix.COO<'a>) (leftArray: 'a [,]) (rightArray: 'a [,]) = + + let leftMatrix = + Matrix.COO.FromArray2D(leftArray, isEqual zero) + + let rightMatrix = + Matrix.COO.FromArray2D(rightArray, isEqual zero) + + let expectedRows, expectedColumns, expectedValues = + let leftKeys = + Seq.zip3 leftMatrix.Rows leftMatrix.Columns leftMatrix.Values + + let rightKeys = + Seq.zip3 rightMatrix.Rows rightMatrix.Columns rightMatrix.Values + + // right first + Seq.concat [ rightKeys; leftKeys ] + |> Seq.sortBy (fun (fstKey, sndKey, _) -> (fstKey, sndKey)) + |> Seq.toArray + |> Array.unzip3 + + "Rows must be the same" + |> Expect.sequenceEqual actual.Rows expectedRows + + "Columns must be the same" + |> Expect.sequenceEqual actual.Columns expectedColumns + + "Values must be the same" + |> Utils.compareArrays isEqual actual.Values expectedValues + +let makeTestCOO isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Matrix.COO.FromArray2D(leftArray, isEqual zero) + + let rightMatrix = + Matrix.COO.FromArray2D(rightArray, isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + + let clRightMatrix = rightMatrix.ToDevice context + + let ((clRows: ClArray), + (clColumns: ClArray), + (clLeftValues: ClArray<'a>), + (clRightValues: ClArray<'a>), + (clIsLeft: ClArray)) = + testFun processor clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let leftValues = clLeftValues.ToHostAndFree processor + let rightValues = clRightValues.ToHostAndFree processor + let isLeft = clIsLeft.ToHostAndFree processor + + let actualValues = + Array.map3 + (fun leftValue rightValue isLeft -> + if isLeft = 1 then + leftValue + else + rightValue) + <| leftValues + <| rightValues + <| isLeft + + let actual = + { Matrix.COO.RowCount = leftMatrix.RowCount + Matrix.COO.ColumnCount = leftMatrix.ColumnCount + Matrix.COO.Rows = clRows.ToHostAndFree processor + Matrix.COO.Columns = clColumns.ToHostAndFree processor + Matrix.COO.Values = actualValues } + + checkResult isEqual zero actual leftArray rightArray + +let createTestCOO isEqual (zero: 'a) = + Matrix.COO.Merge.run context Utils.defaultWorkGroupSize + |> makeTestCOO isEqual zero + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let testsCOO = + [ createTestCOO (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTestCOO (=) 0.0 + + createTestCOO (=) 0.0f + createTestCOO (=) false ] + |> testList "COO" + +let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + let leftMatrix = + Matrix.CSR.FromArray2D(leftArray, isEqual zero) + + let rightMatrix = + Matrix.CSR.FromArray2D(rightArray, isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + + let clRightMatrix = rightMatrix.ToDevice context + + let ((clRows: ClArray), + (clColumns: ClArray), + (clLeftValues: ClArray<'a>), + (clRightValues: ClArray<'a>), + (clIsEndOfRow: ClArray), + (clIsLeft: ClArray)) = + testFun processor clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let leftValues = clLeftValues.ToHostAndFree processor + let rightValues = clRightValues.ToHostAndFree processor + clIsEndOfRow.Free processor + let isLeft = clIsLeft.ToHostAndFree processor + + let actualValues = + Array.map3 + (fun leftValue rightValue isLeft -> + if isLeft = 1 then + leftValue + else + rightValue) + <| leftValues + <| rightValues + <| isLeft + + let actual = + { Matrix.COO.RowCount = leftMatrix.RowCount + Matrix.COO.ColumnCount = leftMatrix.ColumnCount + Matrix.COO.Rows = clRows.ToHostAndFree processor + Matrix.COO.Columns = clColumns.ToHostAndFree processor + Matrix.COO.Values = actualValues } + + checkResult isEqual zero actual leftArray rightArray + +let createTestCSR isEqual (zero: 'a) = + Matrix.CSR.Merge.run context Utils.defaultWorkGroupSize + |> makeTestCSR isEqual zero + |> testPropertyWithConfig { config with endSize = 10 } $"test on {typeof<'a>}" + +let testsCSR = + [ createTestCSR (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTestCSR (=) 0.0 + + createTestCSR (=) 0.0f + createTestCSR (=) false ] + |> testList "CSR" + +let allTests = + [ testsCSR; testsCOO ] |> testList "Merge" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index d3e9b84e..0f9470b0 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,4 +94,7 @@ open GraphBLAS.FSharp.Tests // |> testSequenced [] -let main argv = Common.Merge.tests |> testSequenced |> runTestsWithCLIArgs [] argv +let main argv = + Matrix.Merge.testsCOO + |> testSequenced + |> runTestsWithCLIArgs [] argv diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Merge.fs b/tests/GraphBLAS-sharp.Tests/Vector/Merge.fs index 68f3f6d8..af693c80 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Merge.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Common.Merge +module GraphBLAS.FSharp.Tests.Vector.Merge open GraphBLAS.FSharp.Backend.Vector open GraphBLAS.FSharp.Backend.Common @@ -16,9 +16,11 @@ let context = Context.defaultContext.ClContext let config = Utils.defaultConfig let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = - let firstVector = Vector.Sparse.FromArray(firstArray, isEqual zero) + let firstVector = + Vector.Sparse.FromArray(firstArray, isEqual zero) - let secondVector = Vector.Sparse.FromArray(secondArray, isEqual zero) + let secondVector = + Vector.Sparse.FromArray(secondArray, isEqual zero) if firstVector.NNZ > 0 && secondVector.NNZ > 0 then @@ -27,7 +29,10 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = let clSecondVector = secondVector.ToDevice context - let (allIndices: ClArray), (firstValues: ClArray<'a>), (secondValues: ClArray<'a>), (isLeftBitmap: ClArray) = + let ((allIndices: ClArray), + (firstValues: ClArray<'a>), + (secondValues: ClArray<'a>), + (isLeftBitmap: ClArray)) = testFun processor clFirstVector clSecondVector clFirstVector.Dispose processor @@ -40,7 +45,12 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = let actualValues = (actualFirstValues, actualSecondValues, actualIsLeftBitmap) - |||> Array.map3 (fun leftValue rightValue isLeft -> if isLeft = 1 then leftValue else rightValue) + |||> Array.map3 + (fun leftValue rightValue isLeft -> + if isLeft = 1 then + leftValue + else + rightValue) // expected run let firstValuesAndIndices = @@ -51,7 +61,8 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = // preserve order of values then use stable sort let allValuesAndIndices = - Array.concat [ firstValuesAndIndices; secondValuesAndIndices ] + Array.concat [ firstValuesAndIndices + secondValuesAndIndices ] // stable sort let expectedValues, expectedIndices = @@ -65,7 +76,7 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = "Indices should be the same" |> Utils.compareArrays (=) actualIndices expectedIndices -let createTest<'a when 'a : struct> isEqual (zero: 'a) = +let createTest<'a when 'a: struct> isEqual (zero: 'a) = Vector.Sparse.Merge.run context Utils.defaultWorkGroupSize |> makeTest isEqual zero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -74,9 +85,8 @@ let tests = [ createTest (=) 0 if Utils.isFloat64Available context.ClDevice then - createTest (=) 0.0 + createTest (=) 0.0 createTest Utils.float32IsEqual 0.0f createTest (=) false ] |> testList "Merge" - From 850ca1490a8f62900c3dc4dcbe2a58544886a30e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 14:28:40 +0300 Subject: [PATCH 102/143] add: Common.Merge with explicit error --- src/GraphBLAS-sharp.Backend/Common/Merge.fs | 143 ++++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Common/Merge.fs | 54 +++++++ .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs | 2 +- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 6 files changed, 201 insertions(+), 2 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Common/Merge.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Merge.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Merge.fs b/src/GraphBLAS-sharp.Backend/Common/Merge.fs new file mode 100644 index 00000000..3395f7a8 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Merge.fs @@ -0,0 +1,143 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext + +module Merge = + let run<'a, 'b when 'a: struct and 'b: struct and 'a: comparison> (clContext: ClContext) workGroupSize = + + let defaultValue = Unchecked.defaultof<'a> + + let merge = + <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstValues: ClArray<'a>) (secondValues: ClArray<'a>) (resultValues: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + + if lid < 2 then + // (n - 1) * wgSize - 1 for lid = 0 + // n * wgSize - 1 for lid = 1 + // where n in 1 .. wgGroupCount + let x = lid * (workGroupSize - 1) + gid - 1 + + let diagonalNumber = min (sumOfSides - 1) x + + let mutable leftEdge = max 0 (diagonalNumber + 1 - secondSide) + + let mutable rightEdge = min (firstSide - 1) diagonalNumber + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let firstIndex = firstValues.[middleIdx] + + let secondIndex = + secondValues.[diagonalNumber - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + // Here localID equals either 0 or 1 + if lid = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge + + barrierLocal () + + let beginIdx = beginIdxLocal + let endIdx = endIdxLocal + let firstLocalLength = endIdx - beginIdx + let mutable x = workGroupSize - firstLocalLength + + if endIdx = firstSide then + x <- secondSide - gid + lid + 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<'a> workGroupSize + + if lid < firstLocalLength then + localIndices.[lid] <- firstValues.[beginIdx + lid] + + if lid < secondLocalLength then + localIndices.[firstLocalLength + lid] <- firstValues.[gid - beginIdx] + + barrierLocal () + + if gid < sumOfSides then + let mutable leftEdge = lid + 1 - secondLocalLength + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstLocalLength - 1 + + rightEdge <- min rightEdge lid + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] + + let secondIndex = + localIndices.[firstLocalLength + lid - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + let boundaryX = rightEdge + let boundaryY = lid - 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 = defaultValue + + if isValidX then + fstIdx <- localIndices.[boundaryX] + + let mutable sndIdx = defaultValue + + if isValidY then + sndIdx <- localIndices.[firstLocalLength + boundaryY] + + if not isValidX || isValidY && fstIdx <= sndIdx then + resultValues.[gid] <- sndIdx + else + resultValues.[gid] <- fstIdx @> + + let kernel = clContext.Compile merge + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'a>) -> + + let firstSide = firstValues.Length + + let secondSide = secondValues.Length + + let sumOfSides = firstSide + secondSide + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides) + + let ndRange = + Range1D.CreateValid(sumOfSides, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange firstSide secondSide sumOfSides firstValues secondValues resultValues) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultValues diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 2ca63116..e305fe11 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,6 +35,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs new file mode 100644 index 00000000..70132335 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs @@ -0,0 +1,54 @@ +module GraphBLAS.FSharp.Tests.Common.Merge + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + endSize = 10 } + +let makeTest isEqual testFun (leftArray: 'a []) (rightArray: 'a []) = + if leftArray.Length > 0 && rightArray.Length > 0 then + + let leftArray = Array.sort leftArray |> Array.distinct + + let rightArray = Array.sort rightArray |> Array.distinct + + let clLeftArray = context.CreateClArray leftArray + let clRightArray = context.CreateClArray rightArray + + let clResult: ClArray<'a> = + testFun processor clLeftArray clRightArray + + let result = clResult.ToHostAndFree processor + clLeftArray.Free processor + clRightArray.Free processor + + let expected = + Array.concat [ leftArray; rightArray ] + |> Array.sort + + "Results must be the same" + |> Utils.compareArrays isEqual result expected + +let createTest<'a> isEqual = + Merge.run context Utils.defaultWorkGroupSize + |> makeTest isEqual + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest (=) + + createTest (=) + createTest (=) ] + |> testList "Merge" diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index c1ec2f78..b7256d32 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -18,6 +18,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs index a77898a1..fef357de 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs @@ -161,7 +161,7 @@ let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let createTestCSR isEqual (zero: 'a) = Matrix.CSR.Merge.run context Utils.defaultWorkGroupSize |> makeTestCSR isEqual zero - |> testPropertyWithConfig { config with endSize = 10 } $"test on {typeof<'a>}" + |> testPropertyWithConfig config $"test on {typeof<'a>}" let testsCSR = [ createTestCSR (=) 0 diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 0f9470b0..c370b78a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,6 +95,6 @@ open GraphBLAS.FSharp.Tests [] let main argv = - Matrix.Merge.testsCOO + Common.Merge.tests |> testSequenced |> runTestsWithCLIArgs [] argv From ab4d3ac1a9791f72cb827f101ea7530a32c3ff7d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 14:57:51 +0300 Subject: [PATCH 103/143] refactor: Common.Merge --- src/GraphBLAS-sharp.Backend/Common/Merge.fs | 3 ++- tests/GraphBLAS-sharp.Tests/Common/Merge.fs | 4 +--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Merge.fs b/src/GraphBLAS-sharp.Backend/Common/Merge.fs index 3395f7a8..07199ef2 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Merge.fs @@ -53,6 +53,7 @@ module Merge = let beginIdx = beginIdxLocal let endIdx = endIdxLocal let firstLocalLength = endIdx - beginIdx + let mutable x = workGroupSize - firstLocalLength if endIdx = firstSide then @@ -68,7 +69,7 @@ module Merge = localIndices.[lid] <- firstValues.[beginIdx + lid] if lid < secondLocalLength then - localIndices.[firstLocalLength + lid] <- firstValues.[gid - beginIdx] + localIndices.[firstLocalLength + lid] <- secondValues.[gid - beginIdx] barrierLocal () diff --git a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs index 70132335..51ba5d65 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs @@ -10,9 +10,7 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let config = - { Utils.defaultConfig with - endSize = 10 } +let config = { Utils.defaultConfig with endSize = 10000000 } let makeTest isEqual testFun (leftArray: 'a []) (rightArray: 'a []) = if leftArray.Length > 0 && rightArray.Length > 0 then From becee4da08886054b71e492c5dca9f023175d1fc Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 16:17:55 +0300 Subject: [PATCH 104/143] refactor: formatting --- .../GraphBLAS-sharp.Backend.fsproj | 22 +- tests/GraphBLAS-sharp.Tests/Common/Merge.fs | 4 +- .../GraphBLAS-sharp.Tests.fsproj | 4 +- tests/GraphBLAS-sharp.Tests/Program.fs | 188 +++++++++--------- 4 files changed, 110 insertions(+), 108 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index e305fe11..48a0f30e 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -35,18 +35,18 @@ - + - - - - - - - - - - + + + + + + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs index 51ba5d65..d937da3c 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Merge.fs @@ -10,7 +10,9 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let config = { Utils.defaultConfig with endSize = 10000000 } +let config = + { Utils.defaultConfig with + endSize = 10000000 } let makeTest isEqual testFun (leftArray: 'a []) (rightArray: 'a []) = if leftArray.Length > 0 && rightArray.Length > 0 then diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index b7256d32..0d280f99 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -18,7 +18,7 @@ - + @@ -49,7 +49,7 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index c370b78a..70fb4dcc 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,99 +2,99 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Map.notTests -// Matrix.Map.addTests -// Matrix.Map.mulTests -// Matrix.Transpose.tests -// Matrix.SpGeMM.Masked.tests -// Matrix.SpGeMM.Expand.generalTests ] -// |> testSequenced -// -// let commonTests = -// let scanTests = -// testList -// "Scan" -// [ Common.Scan.ByKey.sequentialSegmentsTests -// Common.Scan.PrefixSum.tests ] -// -// let reduceTests = -// testList -// "Reduce" -// [ Common.Reduce.ByKey.allTests -// Common.Reduce.Reduce.tests -// Common.Reduce.Sum.tests ] -// -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.allTests ] -// -// let sortTests = -// testList -// "Sort" -// [ Common.Sort.Bitonic.tests -// Common.Sort.Radix.testByKeys -// Common.Sort.Radix.testKeysOnly ] -// -// testList -// "Common tests" -// [ Common.Scatter.allTests -// Common.Gather.allTests -// clArrayTests -// sortTests -// reduceTests -// scanTests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced -// -// [] -// let allTests = -// testList -// "All tests" -// [ matrixTests -// vectorTests -// commonTests -// algorithmsTests ] -// |> testSequenced +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Map.notTests + Matrix.Map.addTests + Matrix.Map.mulTests + Matrix.Transpose.tests + Matrix.Merge.allTests + Matrix.SpGeMM.Masked.tests + Matrix.SpGeMM.Expand.generalTests ] + |> testSequenced -[] -let main argv = - Common.Merge.tests +let commonTests = + let scanTests = + testList + "Scan" + [ Common.Scan.ByKey.sequentialSegmentsTests + Common.Scan.PrefixSum.tests ] + + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.allTests + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] + + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.allTests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.testByKeys + Common.Sort.Radix.testKeysOnly ] + + testList + "Common tests" + [ Common.Scatter.allTests + Common.Gather.allTests + Common.Merge.tests + clArrayTests + sortTests + reduceTests + scanTests ] + |> testSequenced + +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests + Vector.Merge.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] |> testSequenced - |> runTestsWithCLIArgs [] argv + +[] +let allTests = + testList + "All tests" + [ matrixTests + vectorTests + commonTests + algorithmsTests ] + |> testSequenced + +[] +let main argv = allTests |> runTestsWithCLIArgs [] argv From 655fe67dfee065bdb2a3fb38ccbb0d859dc0fd5b Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 16:35:10 +0300 Subject: [PATCH 105/143] refactor: list instead array in LIL --- src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs | 5 +++-- src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs | 9 +++++---- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 5 +---- src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs | 2 +- src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 2 +- src/GraphBLAS-sharp/Objects/Matrix.fs | 5 ++--- src/GraphBLAS-sharp/Objects/MatrixExtensions.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 2 +- 8 files changed, 15 insertions(+), 17 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 40095927..78ee25aa 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -149,14 +149,15 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> runLazy processor allocationMode matrix |> Seq.map (fun lazyValue -> lazyValue.Value) - |> Seq.toArray let toLIL (clContext: ClContext) workGroupSize = let byRows = byRows clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - let rows = byRows processor allocationMode matrix + let rows = + byRows processor allocationMode matrix + |> Seq.toList { Context = clContext RowCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs index 4cc3944a..34eff782 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs @@ -16,19 +16,20 @@ module Matrix = let rowsPointers = matrix.Rows - |> Array.map + |> List.map (function | None -> 0 | Some vector -> vector.Values.Length) + |> List.toArray // prefix sum |> Array.scan (+) 0 |> fun pointers -> clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, pointers) let valuesByRows, columnsIndicesByRows = matrix.Rows - |> Array.choose id - |> Array.map (fun vector -> vector.Values, vector.Indices) - |> Array.unzip + |> List.choose id + |> List.map (fun vector -> vector.Values, vector.Indices) + |> List.unzip let values = concatValues processor allocationMode valuesByRows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index f3b39641..7e174bd8 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -46,10 +46,7 @@ module Matrix = Values = copyData processor allocationMode m.Values } | ClMatrix.LIL matrix -> matrix.Rows - |> Array.map ( - Option.bind - <| (Some << (vectorCopy processor allocationMode)) - ) + |> List.map (Option.map (vectorCopy processor allocationMode)) |> fun rows -> { Context = clContext RowCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 704c0a98..b4b14bad 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -310,7 +310,7 @@ module Expand = result) lazyRow.Value) - |> Seq.toArray + |> Seq.toList |> fun rows -> rightMatrixRowsLengths.Free processor diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 3ddb7cea..650c40b3 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -86,7 +86,7 @@ module ClMatrix = { Context: ClContext RowCount: int ColumnCount: int - Rows: ClVector.Sparse<'elem> option [] + Rows: ClVector.Sparse<'elem> option list NNZ: int } interface IDeviceMemObject with diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index 558f965b..45754431 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -155,7 +155,7 @@ module Matrix = type LIL<'a when 'a: struct> = { RowCount: int ColumnCount: int - Rows: Vector.Sparse<'a> option [] + Rows: Vector.Sparse<'a> option list NNZ: int } static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = @@ -172,7 +172,6 @@ module Matrix = Some vector else None ] - |> Array.ofList { RowCount = Array2D.length1 array ColumnCount = Array2D.length2 array @@ -183,7 +182,7 @@ module Matrix = let rows = this.Rows - |> Array.map (Option.bind (fun vector -> Some <| vector.ToDevice(context))) + |> List.map (Option.map (fun vector -> vector.ToDevice(context))) { Context = context RowCount = this.RowCount diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index 47f987f8..d79a5d97 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -36,7 +36,7 @@ module MatrixExtensions = ColumnCount = m.ColumnCount Rows = m.Rows - |> Array.map (Option.bind (fun row -> Some <| row.ToHost q)) + |> List.map (Option.map (fun row -> row.ToHost q)) NNZ = m.NNZ } |> Matrix.LIL diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index f12bada0..f2403ddc 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -137,7 +137,7 @@ module Utils = "Rows count must be the same" |> Expect.equal actual.RowCount expected.RowCount - Array.iter2 + List.iter2 (fun actualRow expected -> match actualRow, expected with | Some actualVector, Some expectedVector -> compareSparseVectors isEqual actualVector expectedVector From 7f3cb901fdf6850e77fe7d5d0799af53edbe5ec0 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 20:37:25 +0300 Subject: [PATCH 106/143] refactor: SpGeMM.expand --- src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index b4b14bad..38cb28bb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -10,7 +10,6 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell open FSharp.Quotations -open GraphBLAS.FSharp.Backend.Vector.Sparse open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ClMatrix @@ -145,6 +144,8 @@ module Expand = .ToHostAndFree(processor) if resultLength = 0 then + positions.Free processor + None else let resultIndices = @@ -157,6 +158,8 @@ module Expand = assignValues processor firstValues secondValues positions resultValues + positions.Free processor + Some(resultValues, resultIndices) let sortByColumns (clContext: ClContext) workGroupSize = @@ -268,13 +271,12 @@ module Expand = // create sparse vector (TODO(empty vector)) reduceResult - |> Option.bind + |> Option.map (fun (values, columns) -> { Context = clContext Indices = columns Values = values - Size = rightMatrix.ColumnCount } - |> Some))) + Size = rightMatrix.ColumnCount }))) let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) From bf1cd58376ea93564c265edeac90232f7f6cd5ec Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 21:02:40 +0300 Subject: [PATCH 107/143] refactor: tests --- tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs | 6 +----- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +-- 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index e187d118..35db28f7 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -220,11 +220,7 @@ let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftAr let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = testFun opAddQ opMulQ context Utils.defaultWorkGroupSize |> makeGeneralTest<'a> zero isEqual opMul opAdd - |> testPropertyWithConfig - { config with - endSize = 1000 - maxTest = 2 } - $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 295430c8..ccee444f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -113,5 +113,4 @@ let allTests = [] let main argv = - Host.IO.MtxReader.test - |> runTestsWithCLIArgs [] argv + allTests |> runTestsWithCLIArgs [] argv From 76de19b71c37b88c5fb521a80abc186d13ba1fe2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 21:11:45 +0300 Subject: [PATCH 108/143] refactor: benchmark workflow --- .github/workflows/build-and-benchmark.yml | 2 +- .../BenchmarksTranspose.fs | 68 ------------------- 2 files changed, 1 insertion(+), 69 deletions(-) delete mode 100644 benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksTranspose.fs diff --git a/.github/workflows/build-and-benchmark.yml b/.github/workflows/build-and-benchmark.yml index ff8e88b4..2bde3398 100644 --- a/.github/workflows/build-and-benchmark.yml +++ b/.github/workflows/build-and-benchmark.yml @@ -36,7 +36,7 @@ jobs: with: name: BFS tool: 'benchmarkdotnet' - output-file-path: BenchmarkDotNet.Artifacts/results/GraphBLAS.FSharp.Benchmarks.BFSBenchmarksWithoutDataTransfer-report-brief.json + output-file-path: BenchmarkDotNet.Artifacts/results/GraphBLAS.FSharp.Benchmarks.BFSWithoutTransferBenchmarkInt32-report-brief.json # Access token to deploy GitHub Pages branch github-token: ${{ secrets._GITHUB_TOKEN }} # Push and deploy GitHub pages branch automatically diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksTranspose.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksTranspose.fs deleted file mode 100644 index 92a60f38..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksTranspose.fs +++ /dev/null @@ -1,68 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Algorithms -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open System.IO -open System -open System.Text.RegularExpressions -open Brahma.FSharp.OpenCL -open OpenCL.Net -open GraphBLAS.FSharp.IO - -[)>] -type TransposeBenchmarks() = - let mutable matrix = Unchecked.defaultof> - - //TODO fix me - (* - [] - member val OclContext = Unchecked.defaultof with get, set - member this.Context = - let (ClContext context) = this.OclContext - context - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - [] - member this.BuildMatrix() = - let inputMatrix = this.InputMatrixReader.ReadMatrixReal(float) - - matrix <- - graphblas { - return! Matrix.switch CSR inputMatrix - >>= Matrix.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.Transpose() = - Matrix.transpose matrix - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.ClearBuffers() = - this.Context.Provider.CloseAllBuffers() - - [] - member this.ClearContext() = - let (ClContext context) = this.OclContext - context.Provider.Dispose() - - static member AvaliableContextsProvider = Utils.avaliableContexts - - static member InputMatricesProvider = - "Common.txt" - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - match Path.GetExtension matrixFilename with - | ".mtx" -> MtxReader(Utils.getFullPathToMatrix "Common" matrixFilename) - | _ -> failwith "Unsupported matrix format" - ) -*) \ No newline at end of file From 4ea099c0db1a556da99aa20cc63b94a1f7e31674 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Apr 2023 21:17:02 +0300 Subject: [PATCH 109/143] refactor: formatting --- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index ccee444f..13b19cb8 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -112,5 +112,4 @@ let allTests = |> testSequenced [] -let main argv = - allTests |> runTestsWithCLIArgs [] argv +let main argv = allTests |> runTestsWithCLIArgs [] argv From ecb4eb56668b7531037c7dee89be87a438633416 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 29 Apr 2023 00:59:49 +0300 Subject: [PATCH 110/143] refactor: remove *.map2ToCOO --- src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs | 17 +------ .../Matrix/CSR/Map2.fs | 17 +------ .../Matrix/CSR/Matrix.fs | 9 ---- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 41 ++++------------- .../Backend/Matrix/Map.fs | 9 ++-- .../Backend/Matrix/Map2.fs | 37 +++------------ .../Backend/Matrix/SpGeMM/Expand.fs | 2 +- .../Backend/Vector/Map2.fs | 21 ++++++--- tests/GraphBLAS-sharp.Tests/Program.fs | 46 ++++++++----------- 9 files changed, 57 insertions(+), 142 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 49336bf9..0ca4148f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -81,7 +81,7 @@ module internal Map = resultBitmap, resultValues, resultRows, resultColumns - let runToCOO<'a, 'b when 'a: struct and 'b: struct and 'b: equality> + let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> (opAdd: Expr<'a option -> 'b option>) (clContext: ClContext) workGroupSize @@ -112,18 +112,3 @@ module internal Map = Rows = resultRows Columns = resultColumns Values = resultValues } - - let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> - (opAdd: Expr<'a option -> 'b option>) - (clContext: ClContext) - workGroupSize - = - - let mapToCOO = runToCOO opAdd clContext workGroupSize - - let toCSRInPlace = - Matrix.toCSRInPlace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - mapToCOO queue allocationMode matrix - |> toCSRInPlace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index 2d6cb681..41d0171b 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -215,7 +215,7 @@ module internal Map2 = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) rowPositions, allValues - let runToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (opAdd: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize @@ -257,18 +257,3 @@ module internal Map2 = Rows = resultRows Columns = resultColumns Values = resultValues } - - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (opAdd: Expr<'a option -> 'b option -> 'c option>) - (clContext: ClContext) - workGroupSize - = - - let elementwiseToCOO = runToCOO opAdd clContext workGroupSize - - let toCSRInPlace = - Matrix.toCSRInPlace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - elementwiseToCOO queue allocationMode matrixLeft matrixRight - |> toCSRInPlace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 97824b6a..e5f89e44 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -61,14 +61,6 @@ module Matrix = let map2 = Map2.run - let map2AtLeastOneToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - workGroupSize - = - - Map2.AtLeastOne.runToCOO (Convert.atLeastOneToOption opAdd) clContext workGroupSize - let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) (opAdd: Expr -> 'c option>) @@ -77,7 +69,6 @@ module Matrix = Map2.AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize - let transposeInPlace (clContext: ClContext) workGroupSize = let toCOOInPlace = toCOOInPlace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 7e174bd8..79061a81 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -264,10 +264,10 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode matrix -> match matrix with | ClMatrix.COO m -> mapCOO processor allocationMode m |> ClMatrix.COO - | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.CSR + | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.COO | ClMatrix.CSC m -> - (mapCSR processor allocationMode m.ToCSR).ToCSC - |> ClMatrix.CSC + (mapCSR processor allocationMode m.ToCSR) + |> ClMatrix.COO | _ -> failwith "Not yet implemented" let map2 (opAdd: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = @@ -292,47 +292,22 @@ module Matrix = | _ -> failwith "Matrix formats are not matching" let map2AtLeastOne (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = - let COOElementwise = + let COOMap2 = COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize - let CSRElementwise = + let CSRMap2 = CSR.Matrix.map2AtLeastOne clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> - COOElementwise processor allocationMode m1 m2 - |> ClMatrix.COO - | ClMatrix.CSR m1, ClMatrix.CSR m2 -> - CSRElementwise processor allocationMode m1 m2 - |> ClMatrix.CSR - | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - (CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR) - .ToCSC - |> ClMatrix.CSC - | _ -> failwith "Matrix formats are not matching" - - let map2AtLeastOneToCOO (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = - let COOElementwise = - COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize - - let CSRElementwise = - CSR.Matrix.map2AtLeastOneToCOO clContext opAdd workGroupSize - - let transposeCOOInPlace = - COO.Matrix.transposeInPlace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> - match matrix1, matrix2 with - | ClMatrix.COO m1, ClMatrix.COO m2 -> - COOElementwise processor allocationMode m1 m2 + COOMap2 processor allocationMode m1 m2 |> ClMatrix.COO | ClMatrix.CSR m1, ClMatrix.CSR m2 -> - CSRElementwise processor allocationMode m1 m2 + CSRMap2 processor allocationMode m1 m2 |> ClMatrix.COO | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR - |> transposeCOOInPlace processor + (CSRMap2 processor allocationMode m1.ToCSR m2.ToCSR) |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs index 508f7d75..6276019b 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs @@ -113,7 +113,7 @@ let testFixturesMapNot case = createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] let notTests = - operationGPUTests "Backend.Matrix.map not tests" testFixturesMapNot + operationGPUTests "not" testFixturesMapNot let testFixturesMapAdd case = [ let context = case.TestContext.ClContext @@ -130,7 +130,7 @@ let testFixturesMapAdd case = createTestMap case 0uy 10uy (+) (=) ArithmeticOperations.addLeftConst ] let addTests = - operationGPUTests "Backend.Matrix.map add tests" testFixturesMapAdd + operationGPUTests "add" testFixturesMapAdd let testFixturesMapMul case = [ let context = case.TestContext.ClContext @@ -147,4 +147,7 @@ let testFixturesMapMul case = createTestMap case 0uy 10uy (*) (=) ArithmeticOperations.mulLeftConst ] let mulTests = - operationGPUTests "Backend.Matrix.map mul tests" testFixturesMapMul + operationGPUTests "mul" testFixturesMapMul + +let allTests = + testList "Map" [ addTests; mulTests; notTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs index da0fd3c3..1a8e2dab 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs @@ -151,36 +151,6 @@ let testFixturesMap2AddAtLeastOne case = let addAtLeastOneTests = operationGPUTests "Backend.Matrix.map2AtLeastOne add tests" testFixturesMap2AddAtLeastOne -let testFixturesMap2AddAtLeastOneToCOO case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) - - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOneToCOO - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOneToCOO - - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add - case - 0.0 - (+) - Utils.floatIsEqual - ArithmeticOperations.floatSumAtLeastOne - Matrix.map2AtLeastOneToCOO - - creatTestMap2Add - case - 0.0f - (+) - Utils.float32IsEqual - ArithmeticOperations.float32SumAtLeastOne - Matrix.map2AtLeastOneToCOO - - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOneToCOO ] - -let addAtLeastOneToCOOTests = - operationGPUTests "Backend.Matrix.map2AtLeastOneToCOO add tests" testFixturesMap2AddAtLeastOneToCOO - let testFixturesMap2MulAtLeastOne case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue @@ -204,3 +174,10 @@ let testFixturesMap2MulAtLeastOne case = let mulAtLeastOneTests = operationGPUTests "Backend.Matrix.map2AtLeastOne multiplication tests" testFixturesMap2MulAtLeastOne + +let allTests = + testList + "Map2" + [ addTests + addAtLeastOneTests + mulAtLeastOneTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index 35db28f7..5f7c1b78 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -220,7 +220,7 @@ let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftAr let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = testFun opAddQ opMulQ context Utils.defaultWorkGroupSize |> makeGeneralTest<'a> zero isEqual opMul opAdd - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + |> testPropertyWithConfig { config with endSize = 500 } $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs index fee9103a..e5eadaa4 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs @@ -110,8 +110,7 @@ let addTestFixtures case = createTest case (=) false (||) ArithmeticOperations.boolSumOption Vector.map2 createTest case (=) 0uy (+) ArithmeticOperations.byteSumOption Vector.map2 ] -let addTests = - operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures +let addTests = operationGPUTests "add" addTestFixtures let mulTestFixtures case = let context = case.TestContext.ClContext @@ -125,8 +124,7 @@ let mulTestFixtures case = createTest case (=) false (&&) ArithmeticOperations.boolMulOption Vector.map2 createTest case (=) 0uy (*) ArithmeticOperations.byteMulOption Vector.map2 ] -let mulTests = - operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures +let mulTests = operationGPUTests "mul" addTestFixtures let addAtLeastOneTestFixtures case = let context = case.TestContext.ClContext @@ -141,7 +139,7 @@ let addAtLeastOneTestFixtures case = createTest case (=) 0uy (+) ArithmeticOperations.byteSumAtLeastOne Vector.map2AtLeastOne ] let addAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2LeastOne add tests" addTestFixtures + operationGPUTests "addAtLeastOne" addTestFixtures let mulAtLeastOneTestFixtures case = let context = case.TestContext.ClContext @@ -156,7 +154,7 @@ let mulAtLeastOneTestFixtures case = createTest case (=) 0uy (*) ArithmeticOperations.byteMulAtLeastOne Vector.map2AtLeastOne ] let mulAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2AtLeasOne mul tests" mulTestFixtures + operationGPUTests "mulAtLeastOne" mulTestFixtures let fillSubVectorComplementedQ<'a, 'b> value = <@ fun (left: 'a option) (right: 'b option) -> @@ -199,4 +197,13 @@ let complementedGeneralTestFixtures case = let complementedGeneralTests = - operationGPUTests "Backend.Vector.Map2Gen mask tests" complementedGeneralTestFixtures + operationGPUTests "mask" complementedGeneralTestFixtures + +let allTests = + testList + "Map" + [ addTests + mulTests + addAtLeastOneTests + mulAtLeastOneTests + complementedGeneralTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 1bcc77c1..f3dada66 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,31 +2,19 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -let hostTests = - testList - "Host" - [ Host.Matrix.FromArray2D.tests - Host.Matrix.Convert.tests - Host.IO.MtxReader.test ] - |> testSequenced - let matrixTests = testList - "Matrix tests" + "Matrix" [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Map.notTests - Matrix.Map.addTests - Matrix.Map.mulTests - Matrix.SpGeMM.Expand.generalTests - Matrix.SpGeMM.Masked.tests + Matrix.Map2.allTests + Matrix.Map.allTests Matrix.Merge.allTests Matrix.Transpose.tests Matrix.RowsLengths.tests - Matrix.ByRows.tests ] + Matrix.ByRows.tests + + Matrix.SpGeMM.Expand.generalTests + Matrix.SpGeMM.Masked.tests ] |> testSequenced let commonTests = @@ -67,7 +55,7 @@ let commonTests = Common.Sort.Radix.allTests ] testList - "Common tests" + "Common" [ Common.Scatter.allTests Common.Gather.allTests Common.Merge.tests @@ -79,17 +67,13 @@ let commonTests = let vectorTests = testList - "Vector tests" + "Vector" [ Vector.SpMV.tests Vector.ZeroCreate.tests Vector.OfList.tests Vector.Copy.tests Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.complementedGeneralTests + Vector.Map2.allTests Vector.AssignByMask.tests Vector.AssignByMask.complementedTests Vector.Reduce.tests @@ -109,9 +93,17 @@ let deviceTests = algorithmsTests ] |> testSequenced +let hostTests = + testList + "Host" + [ Host.Matrix.FromArray2D.tests + Host.Matrix.Convert.tests + Host.IO.MtxReader.test ] + |> testSequenced + [] let allTests = - testList "All tests" [ deviceTests; hostTests ] + testList "All" [ deviceTests; hostTests ] |> testSequenced [] From dffcb5f338567916d1f9053720bfec8bf58a0d52 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 29 Apr 2023 11:27:13 +0300 Subject: [PATCH 111/143] refactor: Matrix.map*, ClArray.choose --- README.md | 4 +- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 15 +++-- .../Matrix/CSR/Map2.fs | 18 +---- .../Matrix/CSR/Matrix.fs | 2 - src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 13 +++- .../Vector/Dense/Vector.fs | 20 ++---- .../Backend/Common/ClArray/Choose.fs | 67 +++++++++---------- 7 files changed, 64 insertions(+), 75 deletions(-) diff --git a/README.md b/README.md index c58f7839..6ddbc2c0 100644 --- a/README.md +++ b/README.md @@ -19,8 +19,8 @@ GraphBLAS# is a GPGPU-based [GraphBLAS](https://graphblas.org/)-like API impleme | Left of 't1 | Right of 't2 ``` - So, type of matrix-matrix elementwise oertion is ```Matrix> -> Matrix> -> (AtLeastOne<'t1,'t2> -> Option<'t3>) -> Matrix>```. -- No semirings. Just functions. Ofcourse one can implement semirings on the top of provided API. + So, type of matrix-matrix elementwise operation is ```Matrix> -> Matrix> -> (AtLeastOne<'t1,'t2> -> Option<'t3>) -> Matrix>```. +- No semirings. Just functions. Of course one can implement semirings on the top of provided API. - Minimal core: high-order functions allows us to minimaze core by functions unification. For example, such functions as matrix-matrix addition, matrix-matrix element-wise multiplication, masking all are partial case of `map2` function. ### Operations diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 9763db01..b104ca55 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -390,12 +390,19 @@ module ClArray = (prefixSum processor positions) .ToHostAndFree(processor) - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + if resultLength = 0 then + positions.Free processor + + None + else + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - assignValues processor sourceValues positions result + assignValues processor sourceValues positions result - result + positions.Free processor + + Some result let assignOption2 (op: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index 41d0171b..bfd5f161 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -94,7 +94,7 @@ module internal Map2 = ///. ///. ///Should be a power of 2 and greater than 1. - let runToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (opAdd: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize @@ -135,22 +135,6 @@ module internal Map2 = Columns = resultColumns Values = resultValues } - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (opAdd: Expr<'a option -> 'b option -> 'c option>) - (clContext: ClContext) - workGroupSize - = - - let map2ToCOO = runToCOO opAdd clContext workGroupSize - - let toCSRInPlace = - Matrix.toCSRInPlace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - map2ToCOO queue allocationMode matrixLeft matrixRight - |> toCSRInPlace queue allocationMode - - module AtLeastOne = let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (opAdd: Expr<'a option -> 'b option -> 'c option>) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index e5f89e44..dd41f748 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -10,8 +10,6 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open GraphBLAS.FSharp.Backend.Objects.ClCell module Matrix = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 79061a81..0501c882 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -261,12 +261,16 @@ module Matrix = let mapCSR = CSR.Matrix.map opAdd clContext workGroupSize + let transposeCOO = + COO.Matrix.transposeInPlace clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode matrix -> match matrix with | ClMatrix.COO m -> mapCOO processor allocationMode m |> ClMatrix.COO | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.COO | ClMatrix.CSC m -> (mapCSR processor allocationMode m.ToCSR) + |> transposeCOO processor |> ClMatrix.COO | _ -> failwith "Not yet implemented" @@ -277,6 +281,9 @@ module Matrix = let map2CSR = CSR.Matrix.map2 opAdd clContext workGroupSize + let transposeCOO = + COO.Matrix.transposeInPlace clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> @@ -284,11 +291,11 @@ module Matrix = |> ClMatrix.COO | ClMatrix.CSR m1, ClMatrix.CSR m2 -> map2CSR processor allocationMode m1 m2 - |> ClMatrix.CSR + |> ClMatrix.COO | ClMatrix.CSC m1, ClMatrix.CSC m2 -> (map2CSR processor allocationMode m1.ToCSR m2.ToCSR) - .ToCSC - |> ClMatrix.CSC + |> transposeCOO processor + |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" let map2AtLeastOne (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index 756de4bb..97570dcc 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -156,18 +156,12 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - let notEmpty = - (containsNonZero processor vector) - .ToHostAndFree processor + choose processor DeviceOnly vector + |> function + | Some values -> + let result = reduce processor values - if notEmpty then - let values = choose processor DeviceOnly vector + processor.Post(Msg.CreateFreeMsg<_>(values)) - let result = reduce processor values - - processor.Post(Msg.CreateFreeMsg<_>(values)) - - result - - else - clContext.CreateClCell Unchecked.defaultof<'a> + result + | None -> clContext.CreateClCell Unchecked.defaultof<'a> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs index 7fa142dd..c79d035f 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs @@ -13,37 +13,31 @@ let workGroupSize = Utils.defaultWorkGroupSize let config = Utils.defaultConfig -let context = Context.defaultContext.ClContext - -let processor = defaultContext.Queue +let makeTest<'a, 'b> testContext mapFun isEqual choose (array: 'a []) = + let context = testContext.ClContext + let q = testContext.Queue -let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = if array.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue - - let clArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) - - let (clResult: ClArray<'b>) = choose q HostInterop clArray - let hostResult = Array.zeroCreate clResult.Length + let clArray = context.CreateClArray array - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, hostResult, ch)) - |> ignore + let (clResult: ClArray<'b> option) = choose q HostInterop clArray let expectedResult = Array.choose mapFun array - "Result should be the same" - |> Utils.compareArrays isEqual hostResult expectedResult + match clResult with + | Some clResult -> + let hostResult = clResult.ToHostAndFree testContext.Queue -let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = - let context = testContext.ClContext + "Result should be the same" + |> Utils.compareArrays isEqual hostResult expectedResult + | None -> + "Result must be empty" + |> Expect.isTrue (expectedResult.Length = 0) - let choose = - ClArray.choose mapFunQ context workGroupSize - - makeTest<'a, 'b> testContext choose mapFun isEqual +let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = + ClArray.choose mapFunQ testContext.ClContext workGroupSize + |> makeTest<'a, 'b> testContext mapFun isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>} -> %A{typeof<'b>}" let testFixtures testContext = @@ -61,7 +55,10 @@ let testFixtures testContext = let tests = TestCases.gpuTests "choose id" testFixtures -let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = +let makeTest2 testContext isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = + let context = testContext.ClContext + let processor = testContext.Queue + if firstArray.Length > 0 && secondArray.Length > 0 then let expected = @@ -81,21 +78,23 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = "Results must be the same" |> Utils.compareArrays isEqual actual expected -let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = - let testFun = - testFun opMapQ context Utils.defaultWorkGroupSize - - makeTest2 isEqual opMap testFun +let createTest2 testsContext (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = + testFun opMapQ testsContext.ClContext Utils.defaultWorkGroupSize + |> makeTest2 testsContext isEqual opMap |> testPropertyWithConfig config $"test on %A{typeof<'a>}" -let tests2 = - [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 +let testsFixtures2 testContext = + let context = testContext.ClContext + + [ createTest2 testContext (=) ArithmeticOperations.intAdd ClArray.choose2 if Utils.isFloat64Available context.ClDevice then - createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 + createTest2 testContext (=) ArithmeticOperations.floatAdd ClArray.choose2 - createTest2 (=) ArithmeticOperations.float32Add ClArray.choose2 - createTest2 (=) ArithmeticOperations.boolAdd ClArray.choose2 ] - |> testList "choose2 add" + createTest2 testContext (=) ArithmeticOperations.float32Add ClArray.choose2 + createTest2 testContext (=) ArithmeticOperations.boolAdd ClArray.choose2 ] + +let tests2 = + TestCases.gpuTests "choose2 add" testsFixtures2 let allTests = testList "Choose" [ tests; tests2 ] From 1e3b53cd5263746c9de26b383ef5dc2fee144212 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 29 Apr 2023 11:44:27 +0300 Subject: [PATCH 112/143] refactor: Dense.reduce --- src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index 97570dcc..53f8de3e 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -151,11 +151,7 @@ module Vector = let reduce = Reduce.reduce opAdd clContext workGroupSize - let containsNonZero = - ClArray.exists Predicates.isSome clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - choose processor DeviceOnly vector |> function | Some values -> From 45e4536ab9d5fc517629a84a124d461cbd383aeb Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 29 Apr 2023 16:03:57 +0300 Subject: [PATCH 113/143] refactor: Matrix.AtLeastOne --- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 0501c882..b8df2c6c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -305,6 +305,9 @@ module Matrix = let CSRMap2 = CSR.Matrix.map2AtLeastOne clContext opAdd workGroupSize + let COOTranspose = + COO.Matrix.transposeInPlace clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> @@ -315,6 +318,7 @@ module Matrix = |> ClMatrix.COO | ClMatrix.CSC m1, ClMatrix.CSC m2 -> (CSRMap2 processor allocationMode m1.ToCSR m2.ToCSR) + |> COOTranspose processor |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" From 269fc21a3de71b86d56db1a0b0849c30b092fad3 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 30 Apr 2023 23:25:32 +0300 Subject: [PATCH 114/143] refactor: ClArray.Bitmap module --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 246 +++++++++--------- .../Matrix/SpGeMM/Expand.fs | 2 +- 2 files changed, 124 insertions(+), 124 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index b104ca55..98afc2c2 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -132,208 +132,207 @@ module ClArray = outputArray - let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize = + let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = - let getUniqueBitmap = - <@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray) -> + let map = + <@ fun (ndRange: Range1D) lenght (inputArray: ClArray<'a>) (result: ClArray<'b>) -> let gid = ndRange.GlobalID0 - if gid < inputLength then - let isUnique = (%predicate) gid inputLength inputArray // brahma error - - if isUnique then - isUniqueBitmap.[gid] <- 1 - else - isUniqueBitmap.[gid] <- 0 @> + if gid < lenght then + result.[gid] <- (%op) inputArray.[gid] @> - let kernel = clContext.Compile(getUniqueBitmap) + let kernel = clContext.Compile map fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> - let inputLength = inputArray.Length + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) let ndRange = - Range1D.CreateValid(inputLength, workGroupSize) - - let bitmap = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputLength) + Range1D.CreateValid(inputArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray inputLength bitmap)) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length inputArray result)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - bitmap + result - let getUniqueBitmapFirstOccurrence clContext = - getUniqueBitmapGeneral - <| Predicates.firstOccurrence () - <| clContext + let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = - let getUniqueBitmapLastOccurrence clContext = - getUniqueBitmapGeneral - <| Predicates.lastOccurrence () - <| clContext + let kernel = + <@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> - ///Remove duplicates form the given array. - ///Computational context - ///Should be a power of 2 and greater than 1. - ///Should be sorted. - let removeDuplications (clContext: ClContext) workGroupSize = + let gid = ndRange.GlobalID0 - let scatter = - Scatter.lastOccurrence clContext workGroupSize + if gid < length then - let getUniqueBitmap = - getUniqueBitmapLastOccurrence clContext workGroupSize + resultArray.[gid] <- (%map) leftArray.[gid] rightArray.[gid] @> - let prefixSumExclude = - PrefixSum.runExcludeInPlace <@ (+) @> clContext workGroupSize + let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> - let bitmap = - getUniqueBitmap processor DeviceOnly inputArray + let ndRange = + Range1D.CreateValid(resultArray.Length, workGroupSize) - let resultLength = - (prefixSumExclude processor bitmap 0) - .ToHostAndFree(processor) + let kernel = kernel.GetKernel() - let outputArray = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange resultArray.Length leftArray rightArray resultArray) + ) - scatter processor bitmap inputArray outputArray + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - processor.Post <| Msg.CreateFreeMsg<_>(bitmap) + let map2<'a, 'b, 'c> map (clContext: ClContext) workGroupSize = + let map2 = + map2InPlace<'a, 'b, 'c> map clContext workGroupSize - outputArray + fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> - let exists (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize = + let resultArray = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftArray.Length) - let exists = - <@ fun (ndRange: Range1D) length (vector: ClArray<'a>) (result: ClCell) -> + map2 processor leftArray rightArray resultArray - let gid = ndRange.GlobalID0 + resultArray - if gid < length then - let isExist = (%predicate) vector.[gid] + module Bitmap = + let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize = - if isExist then result.Value <- true @> + let getUniqueBitmap = + <@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray) -> - let kernel = clContext.Compile exists + let gid = ndRange.GlobalID0 - fun (processor: MailboxProcessor<_>) (vector: ClArray<'a>) -> + if gid < inputLength then + let isUnique = (%predicate) gid inputLength inputArray // brahma error - let result = clContext.CreateClCell false + if isUnique then + isUniqueBitmap.[gid] <- 1 + else + isUniqueBitmap.[gid] <- 0 @> - let ndRange = - Range1D.CreateValid(vector.Length, workGroupSize) + let kernel = clContext.Compile(getUniqueBitmap) - let kernel = kernel.GetKernel() + fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange vector.Length vector result)) + let inputLength = inputArray.Length - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let ndRange = + Range1D.CreateValid(inputLength, workGroupSize) - result + let bitmap = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputLength) - let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = + let kernel = kernel.GetKernel() - let map = - <@ fun (ndRange: Range1D) lenght (inputArray: ClArray<'a>) (result: ClArray<'b>) -> + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray inputLength bitmap)) - let gid = ndRange.GlobalID0 + processor.Post(Msg.CreateRunMsg<_, _> kernel) - if gid < lenght then - result.[gid] <- (%op) inputArray.[gid] @> + bitmap - let kernel = clContext.Compile map + let firstOccurrence clContext = + getUniqueBitmapGeneral + <| Predicates.firstOccurrence () + <| clContext - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> + let lastOccurrence clContext = + getUniqueBitmapGeneral + <| Predicates.lastOccurrence () + <| clContext - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + let private getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = - let ndRange = - Range1D.CreateValid(inputArray.Length, workGroupSize) + let map = + map2 <@ fun x y -> x ||| y @> clContext workGroupSize - let kernel = kernel.GetKernel() + let firstGetBitmap = getUniqueBitmap clContext workGroupSize - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length inputArray result)) + fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> + let firstBitmap = + firstGetBitmap processor DeviceOnly firstArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let secondBitmap = + firstGetBitmap processor DeviceOnly secondArray - result + let result = + map processor allocationMode firstBitmap secondBitmap - let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = + firstBitmap.Free processor + secondBitmap.Free processor - let kernel = - <@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> + result - let gid = ndRange.GlobalID0 + let firstOccurrence2 clContext = getUniqueBitmap2General firstOccurrence clContext - if gid < length then + let lastOccurrence2 clContext = getUniqueBitmap2General lastOccurrence clContext - resultArray.[gid] <- (%map) leftArray.[gid] rightArray.[gid] @> + ///Remove duplicates form the given array. + ///Computational context + ///Should be a power of 2 and greater than 1. + ///Should be sorted. + let removeDuplications (clContext: ClContext) workGroupSize = - let kernel = clContext.Compile kernel + let scatter = + Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> + let getUniqueBitmap = + Bitmap.lastOccurrence clContext workGroupSize - let ndRange = - Range1D.CreateValid(resultArray.Length, workGroupSize) + let prefixSumExclude = + PrefixSum.runExcludeInPlace <@ (+) @> clContext workGroupSize - let kernel = kernel.GetKernel() + fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange resultArray.Length leftArray rightArray resultArray) - ) + let bitmap = + getUniqueBitmap processor DeviceOnly inputArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let resultLength = + (prefixSumExclude processor bitmap 0) + .ToHostAndFree(processor) - let map2<'a, 'b, 'c> map (clContext: ClContext) workGroupSize = - let map2 = - map2InPlace<'a, 'b, 'c> map clContext workGroupSize + let outputArray = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> + scatter processor bitmap inputArray outputArray - let resultArray = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftArray.Length) + processor.Post <| Msg.CreateFreeMsg<_>(bitmap) - map2 processor leftArray rightArray resultArray + outputArray - resultArray + let exists (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize = - let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = + let exists = + <@ fun (ndRange: Range1D) length (vector: ClArray<'a>) (result: ClCell) -> - let map = - map2 <@ fun x y -> x ||| y @> clContext workGroupSize + let gid = ndRange.GlobalID0 + + if gid < length then + let isExist = (%predicate) vector.[gid] - let firstGetBitmap = getUniqueBitmap clContext workGroupSize + if isExist then result.Value <- true @> - fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> - let firstBitmap = - firstGetBitmap processor DeviceOnly firstArray + let kernel = clContext.Compile exists - let secondBitmap = - firstGetBitmap processor DeviceOnly secondArray + fun (processor: MailboxProcessor<_>) (vector: ClArray<'a>) -> - let result = - map processor allocationMode firstBitmap secondBitmap + let result = clContext.CreateClCell false - firstBitmap.Free processor - secondBitmap.Free processor + let ndRange = + Range1D.CreateValid(vector.Length, workGroupSize) - result + let kernel = kernel.GetKernel() - let getUniqueBitmap2FirstOccurrence clContext = - getUniqueBitmap2General getUniqueBitmapFirstOccurrence clContext + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange vector.Length vector result)) - let getUniqueBitmap2LastOccurrence clContext = - getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + result let assignOption (op: Expr<'a -> 'b option>) (clContext: ClContext) workGroupSize = @@ -694,3 +693,4 @@ module ClArray = Some result else None + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 38cb28bb..65271049 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -185,7 +185,7 @@ module Expand = Reduce.ByKey.Option.segmentSequential opAdd clContext workGroupSize let getUniqueBitmap = - ClArray.getUniqueBitmapLastOccurrence clContext workGroupSize + ClArray.Bitmap.lastOccurrence clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInPlace clContext workGroupSize From 1ebf84bb3df1c6fff3906ad368c0c8f063d660f5 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 1 May 2023 13:02:56 +0300 Subject: [PATCH 115/143] refactor: CSR.expandRowsPointers --- .../Matrix/CSR/Matrix.fs | 49 +- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 41 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 32 +- .../Matrix/SpGeMM/Expand.fs | 302 +----------- src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 22 + .../Backend/Matrix/ExpandRows.fs | 48 ++ .../Backend/Matrix/SpGeMM/Expand.fs | 452 +++++++++--------- .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Program.fs | 105 +--- 9 files changed, 383 insertions(+), 669 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index dd41f748..c549e973 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -13,9 +13,46 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Matrix = + let expandRowPointers (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) columnsLength pointersLength (pointers: ClArray) (results: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < columnsLength then + let result = + (%Search.Bin.lowerBound 0) pointersLength gid pointers + + results.[gid] <- result - 1 @> + + let program = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, matrix.Columns.Length) + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(matrix.Columns.Length, workGroupSize) + + processor.Post(Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + matrix.Columns.Length + matrix.RowPointers.Length + matrix.RowPointers + rows)) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + rows + let toCOO (clContext: ClContext) workGroupSize = - let prepare = - Common.expandRowPointers clContext workGroupSize + let prepare = expandRowPointers clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -23,7 +60,7 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = - prepare processor allocationMode matrix.RowPointers matrix.Columns.Length matrix.RowCount + prepare processor allocationMode matrix let cols = copy processor allocationMode matrix.Columns @@ -39,12 +76,11 @@ module Matrix = Values = values } let toCOOInPlace (clContext: ClContext) workGroupSize = - let prepare = - Common.expandRowPointers clContext workGroupSize + let prepare = expandRowPointers clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = - prepare processor allocationMode matrix.RowPointers matrix.Columns.Length matrix.RowCount + prepare processor allocationMode matrix processor.Post(Msg.CreateFreeMsg(matrix.RowPointers)) @@ -92,7 +128,6 @@ module Matrix = let toCSRInPlace = COO.Matrix.toCSRInPlace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix |> transposeInPlace queue diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index edf5efef..2f59ad03 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -4,8 +4,10 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Quotes -module Common = +module internal Common = ///. ///Should be a power of 2 and greater than 1. let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = @@ -40,40 +42,3 @@ module Common = valuesScatter processor positions allValues resultValues resultRows, resultColumns, resultValues, resultLength - - let expandRowPointers (clContext: ClContext) workGroupSize = - - let expandRowPointers = - <@ fun (ndRange: Range1D) (rowPointers: ClArray) (rowCount: int) (rows: ClArray) -> - - let i = ndRange.GlobalID0 - - if i < rowCount then - let rowPointer = rowPointers.[i] - - if rowPointer <> rowPointers.[i + 1] then - rows.[rowPointer] <- i @> - - let program = clContext.Compile expandRowPointers - - let create = - ClArray.zeroCreate clContext workGroupSize - - let scan = - PrefixSum.runIncludeInPlace <@ max @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> - - let rows = create processor allocationMode nnz - - let kernel = program.GetKernel() - - let ndRange = - Range1D.CreateValid(rowCount, workGroupSize) - - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowPointers rowCount rows)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - (scan processor rows 0).Free processor - - rows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index b8df2c6c..4fc2b776 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -405,19 +405,19 @@ module Matrix = | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" - let expand - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - (clContext: ClContext) - workGroupSize - = - - let run = - SpGeMM.Expand.run clContext workGroupSize opAdd opMul - - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> - match leftMatrix, rightMatrix with - | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> - ClMatrix.LIL - <| run processor allocationMode leftMatrix rightMatrix - | _ -> failwith "Matrix formats are not matching" + // let expand + // (opAdd: Expr<'c -> 'c -> 'c option>) + // (opMul: Expr<'a -> 'b -> 'c option>) + // (clContext: ClContext) + // workGroupSize + // = + // + // let run = + // SpGeMM.Expand.run clContext workGroupSize opAdd opMul + // + // fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + // match leftMatrix, rightMatrix with + // | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> + // ClMatrix.LIL + // <| run processor allocationMode leftMatrix rightMatrix + // | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 65271049..18e15dd9 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -21,13 +21,13 @@ module Expand = let prefixSum = PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrixRowsLengths: ClArray) -> + fun (processor: MailboxProcessor<_>) (leftMatrixRow: ClMatrix.CSR<'a>) (rightMatrixRowsLengths: ClArray) -> let segmentsLengths = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRow.NNZ) // extract needed lengths by left matrix nnz - gather processor leftMatrixRow.Indices rightMatrixRowsLengths segmentsLengths + gather processor leftMatrixRow.Columns rightMatrixRowsLengths segmentsLengths // compute pointers let length = @@ -36,298 +36,44 @@ module Expand = length, segmentsLengths - let expand (clContext: ClContext) workGroupSize = + let runByRows (clContext: ClContext) workGroupSize = - let idScatter = - Scatter.initLastOccurrence Map.id clContext workGroupSize + fun (processor: MailboxProcessor<_>) startRow endRow (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'a>) -> - let scatter = - Scatter.lastOccurrence clContext workGroupSize - let zeroCreate = - ClArray.zeroCreate clContext workGroupSize - let maxPrefixSum = - PrefixSum.runIncludeInPlace <@ max @> clContext workGroupSize + () - let create = ClArray.create clContext workGroupSize + let CUSP (clContext: ClContext) workGroupSize = - let gather = Gather.run clContext workGroupSize - - let segmentPrefixSum = - PrefixSum.ByKey.sequentialInclude <@ (+) @> 0 clContext workGroupSize - - let removeDuplicates = - ClArray.removeDuplications clContext workGroupSize - - let leftMatrixGather = Gather.run clContext workGroupSize - - let rightMatrixGather = Gather.run clContext workGroupSize - - fun (processor: MailboxProcessor<_>) length (segmentsPointers: ClArray) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - if length = 0 then - None - else - // Compute left matrix positions - let leftMatrixPositions = zeroCreate processor DeviceOnly length - - idScatter processor segmentsPointers leftMatrixPositions - - (maxPrefixSum processor leftMatrixPositions 0) - .Free processor - - // Compute right matrix positions - let rightMatrixPositions = create processor DeviceOnly length 1 - - let requiredRightMatrixPointers = - zeroCreate processor DeviceOnly leftMatrixRow.Indices.Length - - gather processor leftMatrixRow.Indices rightMatrix.RowPointers requiredRightMatrixPointers - - scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions - - requiredRightMatrixPointers.Free processor - - // another way to get offsets ??? - let offsets = - removeDuplicates processor segmentsPointers - - segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets - - offsets.Free processor - - // compute columns - let columns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - gather processor rightMatrixPositions rightMatrix.Columns columns - - // compute left matrix values - let leftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - leftMatrixGather processor leftMatrixPositions leftMatrixRow.Values leftMatrixValues - - leftMatrixPositions.Free processor - - // compute right matrix values - let rightMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) - - rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues - - rightMatrixPositions.Free processor - - // left, right matrix values, columns indices - Some(leftMatrixValues, rightMatrixValues, columns) - - let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = - let getBitmap = - ClArray.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize - - let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize - - let assignValues = - ClArray.assignOption2 predicate clContext workGroupSize - - let scatter = - Scatter.lastOccurrence clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) -> - - let positions = - getBitmap processor DeviceOnly firstValues secondValues - - let resultLength = - (prefixSum processor positions) - .ToHostAndFree(processor) - - if resultLength = 0 then - positions.Free processor - - None - else - let resultIndices = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - scatter processor positions columns resultIndices - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - assignValues processor firstValues secondValues positions resultValues - - positions.Free processor - - Some(resultValues, resultIndices) - - let sortByColumns (clContext: ClContext) workGroupSize = - - let sortByKeyValues = - Radix.runByKeysStandard clContext workGroupSize - - let sortKeys = - Radix.standardRunKeysOnly clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: ClArray) -> - // sort by columns - let sortedValues = - sortByKeyValues processor DeviceOnly columns values - - let sortedColumns = sortKeys processor columns - - sortedValues, sortedColumns - - let reduce (clContext: ClContext) workGroupSize opAdd = - - let reduce = - Reduce.ByKey.Option.segmentSequential opAdd clContext workGroupSize - - let getUniqueBitmap = - ClArray.Bitmap.lastOccurrence clContext workGroupSize - - let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize - - let idScatter = - Scatter.initFirsOccurrence Map.id clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: ClArray) -> - - let bitmap = - getUniqueBitmap processor DeviceOnly columns - - let uniqueKeysCount = - (prefixSum processor bitmap) - .ToHostAndFree processor - - let offsets = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) - - idScatter processor bitmap offsets - - bitmap.Free processor - - let reduceResult = // by size variance TODO() - reduce processor allocationMode uniqueKeysCount offsets columns values - - offsets.Free processor - - reduceResult + let getNNZInRows = + CSR.Matrix.NNZInRows clContext workGroupSize - let runRow (clContext: ClContext) workGroupSize opAdd opMul = let getSegmentPointers = getSegmentPointers clContext workGroupSize - let expand = expand clContext workGroupSize - - let multiply = multiply clContext workGroupSize opMul - - let sort = sortByColumns clContext workGroupSize - - let reduce = reduce clContext workGroupSize opAdd - - // left matrix last --- for curring - fun (processor: MailboxProcessor<_>) allocationMode (rightMatrix: ClMatrix.CSR<'b>) (leftMatrixRowsLengths: ClArray) (leftMatrixRow: ClVector.Sparse<'a>) -> - // TODO(sort in range) - // required right matrix lengths - let length, segmentPointers = - getSegmentPointers processor leftMatrixRow leftMatrixRowsLengths - - // expand - let expandResult = - expand processor length segmentPointers leftMatrixRow rightMatrix - - segmentPointers.Free processor - - expandResult - |> Option.bind - (fun (leftMatrixValues, rightMatrixValues, columns) -> - // multiplication - let mulResult = - multiply processor leftMatrixValues rightMatrixValues columns - - leftMatrixValues.Free processor - rightMatrixValues.Free processor - columns.Free processor - - // check multiplication result - mulResult - |> Option.bind - (fun (resultValues, resultColumns) -> - // sort - let sortedValues, sortedColumns = - sort processor resultValues resultColumns + let gather = + Gather.run clContext workGroupSize - resultValues.Free processor - resultColumns.Free processor + fun (processor: MailboxProcessor<_>) maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let reduceResult = - reduce processor allocationMode sortedValues sortedColumns - - sortedValues.Free processor - sortedColumns.Free processor - - // create sparse vector (TODO(empty vector)) - reduceResult - |> Option.map - (fun (values, columns) -> - { Context = clContext - Indices = columns - Values = values - Size = rightMatrix.ColumnCount }))) - - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) - workGroupSize - opAdd - (opMul: Expr<'a -> 'b -> 'c option>) - = - - let getNNZInRows = - CSR.Matrix.NNZInRows clContext workGroupSize - - let split = - CSR.Matrix.byRowsLazy clContext workGroupSize + let rightMatrixRowsNNZ = + getNNZInRows processor DeviceOnly rightMatrix - let runRow = - runRow clContext workGroupSize opAdd opMul + let length, segmentLengths = + getSegmentPointers processor leftMatrix rightMatrixRowsNNZ - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + if length < maxAllocSize then + // compute in one step - let rightMatrixRowsLengths = - getNNZInRows processor DeviceOnly rightMatrix - - let runRow = - runRow processor allocationMode rightMatrix rightMatrixRowsLengths + () + else + // extract segment lengths by left matrix rows pointers + let segmentPointersByLeftMatrixRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) - split processor allocationMode leftMatrix - |> Seq.map - (fun lazyRow -> - Option.bind - (fun row -> - let result = runRow row - row.Dispose processor - result) - lazyRow.Value) - |> Seq.toList - |> fun rows -> - rightMatrixRowsLengths.Free processor - // compute nnz - let nnz = - rows - |> Seq.fold - (fun count -> - function - | Some row -> count + row.Size - | None -> count) - 0 + () - { LIL.Context = clContext - RowCount = leftMatrix.RowCount - ColumnCount = rightMatrix.ColumnCount - Rows = rows - NNZ = nnz } + () diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index 5d958986..cc68c629 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -102,6 +102,7 @@ module Search = let mutable leftEdge = 0 let mutable rightEdge = lenght - 1 + let mutable resultPosition = None while leftEdge <= rightEdge do @@ -119,3 +120,24 @@ module Search = leftEdge <- currentPosition + 1 resultPosition @> + + let lowerBound<'a when 'a : equality and 'a : comparison> startValue = + <@ fun lenght sourceItem (keys: ClArray<'a>) -> + + let mutable leftEdge = 0 + let mutable rightEdge = lenght - 1 + + let mutable resultPosition = startValue + + while leftEdge <= rightEdge do + let currentPosition = (leftEdge + rightEdge) / 2 + let currentKey = keys.[currentPosition] + + if sourceItem < currentKey then + resultPosition <- currentPosition + + rightEdge <- currentPosition - 1 + else + leftEdge <- currentPosition + 1 + + resultPosition @> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs new file mode 100644 index 00000000..1eec8ffb --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs @@ -0,0 +1,48 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.ExpandRows + +open Expecto +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects.ClContext +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = Utils.defaultConfig + +let makeTest isZero testFun (array: 'a [,]) = + + let matrix = Matrix.CSR.FromArray2D(array, isZero) + + if matrix.NNZ > 0 then + + let clMatrix = matrix.ToDevice context + + let (clRows: ClArray) = testFun processor HostInterop clMatrix + + let actual = clRows.ToHostAndFree processor + + let expected = Matrix.COO.FromArray2D(array, isZero).Rows + + "Result must be the same" + |> Expect.sequenceEqual actual expected + +let createTest (isZero: 'a -> bool) = + CSR.Matrix.expandRowPointers context Utils.defaultWorkGroupSize + |> makeTest isZero + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let tests = + [ createTest ((=) 0) + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) + + createTest ((=) 0.0f) + createTest ((=) false) ] + |> testList "Expand rows" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index 5f7c1b78..00a2b0c9 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -16,229 +16,229 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Objects.MatrixExtensions -let context = Context.defaultContext.ClContext - -let processor = Context.defaultContext.Queue - -processor.Error.Add(fun e -> failwithf "%A" e) - -let config = - { Utils.defaultConfig with - arbitrary = - [ typeof - typeof ] } - -let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = - - let leftMatrixRow = - Vector.Sparse.FromArray(leftArray, isZero) - - let rightMatrix = - Matrix.CSR.FromArray2D(rightArray, isZero) - - if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then - - // compute expected result - let rightMatrixRowsLength = - rightMatrix.RowPointers - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) - - let expectedPointers, expectedLength = - Array.init leftMatrixRow.Indices.Length (fun index -> rightMatrixRowsLength.[leftMatrixRow.Indices.[index]]) - |> HostPrimitives.prefixSumExclude 0 (+) - - let clLeftMatrixRow = leftMatrixRow.ToDevice context - - let clRightMatrixRowsLength = - context.CreateClArray rightMatrixRowsLength - - let actualLength, (clActual: ClArray) = - testFun processor clLeftMatrixRow clRightMatrixRowsLength - - clLeftMatrixRow.Dispose processor - - let actualPointers = clActual.ToHostAndFree processor - - "Results lengths must be the same" - |> Expect.equal actualLength expectedLength - - "Result pointers must be the same" - |> Expect.sequenceEqual actualPointers expectedPointers - -let createTest<'a when 'a: struct> (isZero: 'a -> bool) = - Expand.getSegmentPointers context Utils.defaultWorkGroupSize - |> makeTest isZero - |> testPropertyWithConfig config $"test on {typeof<'a>}" - -// Debug tests -let getSegmentsTests = - [ createTest ((=) 0) - - if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) - - createTest ((=) 0f) - createTest ((=) false) - createTest ((=) 0uy) ] - |> testList "get segment pointers" - -let expand (leftMatrixRow: Vector.Sparse<'a>) (rightMatrix: Matrix.CSR<'b>) = - let rightMatrixRowsLengths = - rightMatrix.RowPointers - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) - - let segmentsLengths = - Array.map (fun columnIndex -> rightMatrixRowsLengths.[columnIndex]) leftMatrixRow.Indices - - let leftMatrixValues = - Array.map2 Array.create segmentsLengths leftMatrixRow.Values - |> Array.concat - - let rightMatrixRowPointers = - Array.map (fun index -> rightMatrix.RowPointers.[index]) leftMatrixRow.Indices - - let rightMatrixValues = - Array.map2 - (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.Values.[rowPointer..]) - rightMatrixRowPointers - segmentsLengths - |> Array.concat - - let columns = - Array.map2 - (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.ColumnIndices.[rowPointer..]) - rightMatrixRowPointers - segmentsLengths - |> Array.concat - - leftMatrixValues, rightMatrixValues, columns - -let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = - - let leftMatrixRow = - Vector.Sparse.FromArray(leftArray, (isEqual zero)) - - let rightMatrix = - Matrix.CSR.FromArray2D(rightArray, (isEqual zero)) - - if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then - - let clPointers, lenght = - rightMatrix.RowPointers - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) - |> fun rightMatrixRowsLengths -> - Array.init - leftMatrixRow.Indices.Length - (fun index -> rightMatrixRowsLengths.[leftMatrixRow.Indices.[index]]) - |> HostPrimitives.prefixSumExclude 0 (+) - |> fun (pointers, length) -> context.CreateClArray(pointers), length - - let clLeftMatrixRow = leftMatrixRow.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - - let result = - testFun processor lenght clPointers clLeftMatrixRow clRightMatrix - - clLeftMatrixRow.Dispose processor - clRightMatrix.Dispose processor - clPointers.Free processor - - let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns = expand leftMatrixRow rightMatrix - - match result with - | Some (clActualLeftValues: ClArray<'a>, clActualRightValues: ClArray<'a>, clActualColumns: ClArray) -> - - let actualLeftValues = - clActualLeftValues.ToHostAndFree processor - - let actualRightValues = - clActualRightValues.ToHostAndFree processor - - let actualColumns = clActualColumns.ToHostAndFree processor - - "Left values must be the same" - |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues - - "Right values must be the same" - |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues - - "Columns must be the same" - |> Utils.compareArrays (=) actualColumns expectedColumns - | None -> - "Result must be empty" - |> Expect.isTrue (expectedColumns.Length = 0) - -let createExpandTest isEqual (zero: 'a) testFun = - testFun context Utils.defaultWorkGroupSize - |> makeExpandTest isEqual zero - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -// (Debug only) expand phase tests -let expandTests = - [ createExpandTest (=) 0 Expand.expand - - if Utils.isFloat64Available context.ClDevice then - createExpandTest Utils.floatIsEqual 0.0 Expand.expand - - createExpandTest Utils.float32IsEqual 0f Expand.expand - createExpandTest (=) false Expand.expand - createExpandTest (=) 0uy Expand.expand ] - |> testList "Expand.expand" - -let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) - - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - - let (clMatrixActual: ClMatrix<_>) = - testFun processor HostInterop clLeftMatrix clRightMatrix - - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - - let matrixActual = - clMatrixActual.ToHostAndDispose processor - - match matrixActual with - | Matrix.LIL actual -> - HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray - |> fun array -> Matrix.LIL.FromArray2D(array, (isEqual zero)) - |> Utils.compareLILMatrix isEqual actual - | _ -> failwith "Matrix format are not matching" - -let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = - testFun opAddQ opMulQ context Utils.defaultWorkGroupSize - |> makeGeneralTest<'a> zero isEqual opMul opAdd - |> testPropertyWithConfig { config with endSize = 500 } $"test on %A{typeof<'a>}" - -let generalTests = - [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand - - if Utils.isFloat64Available context.ClDevice then - createGeneralTest - 0.0 - Utils.floatIsEqual - ArithmeticOperations.floatAdd - ArithmeticOperations.floatMul - Matrix.SpGeMM.expand - - createGeneralTest - 0.0f - Utils.float32IsEqual - ArithmeticOperations.float32Add - ArithmeticOperations.float32Mul - Matrix.SpGeMM.expand - - createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] - |> testList "general" +// let context = Context.defaultContext.ClContext +// +// let processor = Context.defaultContext.Queue +// +// processor.Error.Add(fun e -> failwithf "%A" e) +// +// let config = +// { Utils.defaultConfig with +// arbitrary = +// [ typeof +// typeof ] } +// +// let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = +// +// let leftMatrixRow = +// Vector.Sparse.FromArray(leftArray, isZero) +// +// let rightMatrix = +// Matrix.CSR.FromArray2D(rightArray, isZero) +// +// if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then +// +// // compute expected result +// let rightMatrixRowsLength = +// rightMatrix.RowPointers +// |> Array.pairwise +// |> Array.map (fun (fst, snd) -> snd - fst) +// +// let expectedPointers, expectedLength = +// Array.init leftMatrixRow.Indices.Length (fun index -> rightMatrixRowsLength.[leftMatrixRow.Indices.[index]]) +// |> HostPrimitives.prefixSumExclude 0 (+) +// +// let clLeftMatrixRow = leftMatrixRow.ToDevice context +// +// let clRightMatrixRowsLength = +// context.CreateClArray rightMatrixRowsLength +// +// let actualLength, (clActual: ClArray) = +// testFun processor clLeftMatrixRow clRightMatrixRowsLength +// +// clLeftMatrixRow.Dispose processor +// +// let actualPointers = clActual.ToHostAndFree processor +// +// "Results lengths must be the same" +// |> Expect.equal actualLength expectedLength +// +// "Result pointers must be the same" +// |> Expect.sequenceEqual actualPointers expectedPointers +// +// let createTest<'a when 'a: struct> (isZero: 'a -> bool) = +// Expand.getSegmentPointers context Utils.defaultWorkGroupSize +// |> makeTest isZero +// |> testPropertyWithConfig config $"test on {typeof<'a>}" +// +// // Debug tests +// let getSegmentsTests = +// [ createTest ((=) 0) +// +// if Utils.isFloat64Available context.ClDevice then +// createTest ((=) 0.0) +// +// createTest ((=) 0f) +// createTest ((=) false) +// createTest ((=) 0uy) ] +// |> testList "get segment pointers" +// +// let expand (leftMatrixRow: Vector.Sparse<'a>) (rightMatrix: Matrix.CSR<'b>) = +// let rightMatrixRowsLengths = +// rightMatrix.RowPointers +// |> Array.pairwise +// |> Array.map (fun (fst, snd) -> snd - fst) +// +// let segmentsLengths = +// Array.map (fun columnIndex -> rightMatrixRowsLengths.[columnIndex]) leftMatrixRow.Indices +// +// let leftMatrixValues = +// Array.map2 Array.create segmentsLengths leftMatrixRow.Values +// |> Array.concat +// +// let rightMatrixRowPointers = +// Array.map (fun index -> rightMatrix.RowPointers.[index]) leftMatrixRow.Indices +// +// let rightMatrixValues = +// Array.map2 +// (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.Values.[rowPointer..]) +// rightMatrixRowPointers +// segmentsLengths +// |> Array.concat +// +// let columns = +// Array.map2 +// (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.ColumnIndices.[rowPointer..]) +// rightMatrixRowPointers +// segmentsLengths +// |> Array.concat +// +// leftMatrixValues, rightMatrixValues, columns +// +// let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = +// +// let leftMatrixRow = +// Vector.Sparse.FromArray(leftArray, (isEqual zero)) +// +// let rightMatrix = +// Matrix.CSR.FromArray2D(rightArray, (isEqual zero)) +// +// if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then +// +// let clPointers, lenght = +// rightMatrix.RowPointers +// |> Array.pairwise +// |> Array.map (fun (fst, snd) -> snd - fst) +// |> fun rightMatrixRowsLengths -> +// Array.init +// leftMatrixRow.Indices.Length +// (fun index -> rightMatrixRowsLengths.[leftMatrixRow.Indices.[index]]) +// |> HostPrimitives.prefixSumExclude 0 (+) +// |> fun (pointers, length) -> context.CreateClArray(pointers), length +// +// let clLeftMatrixRow = leftMatrixRow.ToDevice context +// let clRightMatrix = rightMatrix.ToDevice context +// +// let result = +// testFun processor lenght clPointers clLeftMatrixRow clRightMatrix +// +// clLeftMatrixRow.Dispose processor +// clRightMatrix.Dispose processor +// clPointers.Free processor +// +// let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns = expand leftMatrixRow rightMatrix +// +// match result with +// | Some (clActualLeftValues: ClArray<'a>, clActualRightValues: ClArray<'a>, clActualColumns: ClArray) -> +// +// let actualLeftValues = +// clActualLeftValues.ToHostAndFree processor +// +// let actualRightValues = +// clActualRightValues.ToHostAndFree processor +// +// let actualColumns = clActualColumns.ToHostAndFree processor +// +// "Left values must be the same" +// |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues +// +// "Right values must be the same" +// |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues +// +// "Columns must be the same" +// |> Utils.compareArrays (=) actualColumns expectedColumns +// | None -> +// "Result must be empty" +// |> Expect.isTrue (expectedColumns.Length = 0) +// +// let createExpandTest isEqual (zero: 'a) testFun = +// testFun context Utils.defaultWorkGroupSize +// |> makeExpandTest isEqual zero +// |> testPropertyWithConfig config $"test on %A{typeof<'a>}" +// +// // (Debug only) expand phase tests +// let expandTests = +// [ createExpandTest (=) 0 Expand.expand +// +// if Utils.isFloat64Available context.ClDevice then +// createExpandTest Utils.floatIsEqual 0.0 Expand.expand +// +// createExpandTest Utils.float32IsEqual 0f Expand.expand +// createExpandTest (=) false Expand.expand +// createExpandTest (=) 0uy Expand.expand ] +// |> testList "Expand.expand" +// +// let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = +// +// let leftMatrix = +// Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) +// +// let rightMatrix = +// Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) +// +// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then +// +// let clLeftMatrix = leftMatrix.ToDevice context +// let clRightMatrix = rightMatrix.ToDevice context +// +// let (clMatrixActual: ClMatrix<_>) = +// testFun processor HostInterop clLeftMatrix clRightMatrix +// +// clLeftMatrix.Dispose processor +// clRightMatrix.Dispose processor +// +// let matrixActual = +// clMatrixActual.ToHostAndDispose processor +// +// match matrixActual with +// | Matrix.LIL actual -> +// HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray +// |> fun array -> Matrix.LIL.FromArray2D(array, (isEqual zero)) +// |> Utils.compareLILMatrix isEqual actual +// | _ -> failwith "Matrix format are not matching" +// +// let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = +// testFun opAddQ opMulQ context Utils.defaultWorkGroupSize +// |> makeGeneralTest<'a> zero isEqual opMul opAdd +// |> testPropertyWithConfig { config with endSize = 500 } $"test on %A{typeof<'a>}" +// +// let generalTests = +// [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand +// +// if Utils.isFloat64Available context.ClDevice then +// createGeneralTest +// 0.0 +// Utils.floatIsEqual +// ArithmeticOperations.floatAdd +// ArithmeticOperations.floatMul +// Matrix.SpGeMM.expand +// +// createGeneralTest +// 0.0f +// Utils.float32IsEqual +// ArithmeticOperations.float32Add +// ArithmeticOperations.float32Mul +// Matrix.SpGeMM.expand +// +// createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] +// |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index b94a57be..b3f4d6cf 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -48,6 +48,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f3dada66..d933ffd5 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,109 +2,6 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -let matrixTests = - testList - "Matrix" - [ Matrix.Convert.tests - Matrix.Map2.allTests - Matrix.Map.allTests - Matrix.Merge.allTests - Matrix.Transpose.tests - Matrix.RowsLengths.tests - Matrix.ByRows.tests - - Matrix.SpGeMM.Expand.generalTests - Matrix.SpGeMM.Masked.tests ] - |> testSequenced - -let commonTests = - let scanTests = - testList - "Scan" - [ Common.Scan.ByKey.sequentialSegmentsTests - Common.Scan.PrefixSum.tests ] - - let reduceTests = - testList - "Reduce" - [ Common.Reduce.ByKey.allTests - Common.Reduce.Reduce.tests - Common.Reduce.Sum.tests ] - - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.allTests - Common.ClArray.ChunkBySize.allTests - Common.ClArray.Blit.tests - Common.ClArray.Concat.tests - Common.ClArray.Fill.tests - Common.ClArray.Pairwise.tests ] - - let sortTests = - testList - "Sort" - [ Common.Sort.Bitonic.tests - Common.Sort.Radix.allTests ] - - testList - "Common" - [ Common.Scatter.allTests - Common.Gather.allTests - Common.Merge.tests - clArrayTests - sortTests - reduceTests - scanTests ] - |> testSequenced - -let vectorTests = - testList - "Vector" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.allTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests - Vector.Merge.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced - -let deviceTests = - testList - "Device" - [ matrixTests - commonTests - vectorTests - algorithmsTests ] - |> testSequenced - -let hostTests = - testList - "Host" - [ Host.Matrix.FromArray2D.tests - Host.Matrix.Convert.tests - Host.IO.MtxReader.test ] - |> testSequenced - -[] -let allTests = - testList "All" [ deviceTests; hostTests ] - |> testSequenced [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = Matrix.ExpandRows.tests |> testSequenced |> runTestsWithCLIArgs [] argv From 3d2cc7f77f28d70502bc73cb23c02a0d003436f9 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 1 May 2023 18:32:11 +0300 Subject: [PATCH 116/143] add: CSR.subByRows --- .../Matrix/SpGeMM/Expand.fs | 22 +-- .../Matrix/CSR/Matrix.fs | 78 +++++++++++ .../Objects/MatrixExtensions.fs | 127 +++++++++++++----- .../Backend/Matrix/SubRows.fs | 62 +++++++++ tests/GraphBLAS-sharp.Tests/Generators.fs | 59 ++++++++ .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 16 +++ .../Host/Matrix/FromaArray2D.fs | 9 +- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 9 files changed, 325 insertions(+), 51 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs index 3f1751af..9376873d 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -134,14 +134,14 @@ module WithoutTransfer = override this.GlobalCleanup () = this.ClearInputMatrices() - type Float32() = - - inherit Benchmark( - Matrix.SpGeMM.expand (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) - ) - - static member InputMatrixProvider = - Benchmarks<_>.InputMatrixProviderBuilder "SpGeMM.txt" + // type Float32() = + // + // inherit Benchmark( + // Matrix.SpGeMM.expand (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), + // float32, + // (fun _ -> Utils.nextSingle (System.Random())), + // (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) + // ) + // + // static member InputMatrixProvider = + // Benchmarks<_>.InputMatrixProviderBuilder "SpGeMM.txt" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index c549e973..f1f66c63 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -51,6 +51,84 @@ module Matrix = rows + let subRows (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) resultLength sourceRow pointersLength (pointers: ClArray) (results: ClArray) -> + + let gid = ndRange.GlobalID0 + + let shift = pointers.[sourceRow] + let shiftedId = gid + shift + + if gid < resultLength then + let result = + (%Search.Bin.lowerBound 0) pointersLength shiftedId pointers + + results.[gid] <- result - 1 @> + + let program = clContext.Compile kernel + + let blit = ClArray.blit clContext workGroupSize + + let blitData = ClArray.blit clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode startIndex count (matrix: ClMatrix.CSR<'a>) -> + if count <= 0 then + failwith "Count must be greater than zero" + + if startIndex < 0 then + failwith "startIndex must be greater then zero" + + if startIndex + count > matrix.RowCount then + failwith "startIndex and count sum is larger than the matrix row count" + + // extract rows + let rowPointers = matrix.RowPointers.ToHost processor + + let resultLength = rowPointers.[startIndex + count] - rowPointers.[startIndex] + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(matrix.Columns.Length, workGroupSize) + + processor.Post(Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + resultLength + startIndex + matrix.RowPointers.Length + matrix.RowPointers + rows)) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + let startPosition = rowPointers.[startIndex] + + // extract values + let values = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blitData processor matrix.Values startPosition values 0 resultLength + + // extract indices + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blit processor matrix.Columns startPosition columns 0 resultLength + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + Columns = columns + Values = values } + let toCOO (clContext: ClContext) workGroupSize = let prepare = expandRowPointers clContext workGroupSize diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index d79a5d97..52f1c21a 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -7,42 +7,105 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Objects.ClVectorExtensions module MatrixExtensions = + // Matrix.Free + type ClMatrix.COO<'a when 'a : struct> with + member this.Free(q: MailboxProcessor<_>) = + this.Columns.Free q + this.Values.Free q + this.Rows.Free q + + member this.ToHost(q: MailboxProcessor<_>) = + { RowCount = this.RowCount + ColumnCount = this.ColumnCount + Rows = this.Rows.ToHost q + Columns = this.Columns.ToHost q + Values = this.Values.ToHost q } + + member this.ToHostAndFree(q: MailboxProcessor<_>) = + let result = this.ToHost q + this.Free q + + result + + type ClMatrix.CSR<'a when 'a : struct> with + member this.Free(q: MailboxProcessor<_>) = + this.Values.Free q + this.Columns.Free q + this.RowPointers.Free q + + member this.ToHost(q: MailboxProcessor<_>) = + { RowCount = this.RowCount + ColumnCount = this.ColumnCount + RowPointers = this.RowPointers.ToHost q + ColumnIndices = this.Columns.ToHost q + Values = this.Values.ToHost q } + + member this.ToHostAndFree(q: MailboxProcessor<_>) = + let result = this.ToHost q + this.Free q + + result + + type ClMatrix.CSC<'a when 'a : struct> with + member this.Free(q: MailboxProcessor<_>) = + this.Values.Free q + this.Rows.Free q + this.ColumnPointers.Free q + + member this.ToHost(q: MailboxProcessor<_>) = + { RowCount = this.RowCount + ColumnCount = this.ColumnCount + RowIndices = this.Rows.ToHost q + ColumnPointers = this.ColumnPointers.ToHost q + Values = this.Values.ToHost q } + + member this.ToHostAndFree(q: MailboxProcessor<_>) = + let result = this.ToHost q + this.Free q + + result + + type ClMatrix.LIL<'a when 'a : struct> with + member this.Free(q: MailboxProcessor<_>) = + this.Rows + |> List.iter (Option.iter (fun row -> row.Dispose q)) + + member this.ToHost(q: MailboxProcessor<_>) = + { RowCount = this.RowCount + ColumnCount = this.ColumnCount + Rows = + this.Rows + |> List.map (Option.map (fun row -> row.ToHost q)) + NNZ = this.NNZ } + + member this.ToHostAndFree(q: MailboxProcessor<_>) = + let result = this.ToHost q + this.Free q + + result + type ClMatrix<'a when 'a: struct> with member this.ToHost(q: MailboxProcessor<_>) = match this with - | ClMatrix.COO m -> - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - Rows = m.Rows.ToHost q - Columns = m.Columns.ToHost q - Values = m.Values.ToHost q } - |> Matrix.COO - | ClMatrix.CSR m -> - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowPointers = m.RowPointers.ToHost q - ColumnIndices = m.Columns.ToHost q - Values = m.Values.ToHost q } - |> Matrix.CSR - | ClMatrix.CSC m -> - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowIndices = m.Rows.ToHost q - ColumnPointers = m.ColumnPointers.ToHost q - Values = m.Values.ToHost q } - |> Matrix.CSC - | ClMatrix.LIL m -> - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - Rows = - m.Rows - |> List.map (Option.map (fun row -> row.ToHost q)) - NNZ = m.NNZ } - |> Matrix.LIL - - member this.ToHostAndDispose(processor: MailboxProcessor<_>) = + | ClMatrix.COO m -> m.ToHost q |> Matrix.COO + | ClMatrix.CSR m -> m.ToHost q |> Matrix.CSR + | ClMatrix.CSC m -> m.ToHost q |> Matrix.CSC + | ClMatrix.LIL m -> m.ToHost q |> Matrix.LIL + + member this.Free(q: MailboxProcessor<_>) = + match this with + | ClMatrix.COO m -> m.Free q + | ClMatrix.CSR m -> m.Free q + | ClMatrix.CSC m -> m.Free q + | ClMatrix.LIL m -> m.Free q + + member this.FreeAndWait(processor: MailboxProcessor<_>) = + this.Free processor + processor.PostAndReply(MsgNotifyMe) + + member this.ToHostAndFree(processor: MailboxProcessor<_>) = let result = this.ToHost processor - this.Dispose processor + this.Free processor result diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs new file mode 100644 index 00000000..363d48ad --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs @@ -0,0 +1,62 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.SubRows + +open Expecto +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions +open GraphBLAS.FSharp.Objects.Matrix + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = { Utils.defaultConfig with arbitrary = [ typeof ] } + +let makeTest isEqual zero testFun (array: 'a [,], sourceRow, count) = + + let matrix = Matrix.CSR.FromArray2D(array, isEqual zero) + + if matrix.NNZ > 0 then + + let clMatrix = matrix.ToDevice context + + let clActual: ClMatrix.COO<'a> = testFun processor HostInterop sourceRow count clMatrix + + let actual = clActual.ToHostAndFree processor + + let expected = + array + |> Array2D.mapi (fun rowIndex columnIndex value -> (value, rowIndex, columnIndex)) + |> fun array -> array.[sourceRow .. sourceRow + count - 1, *] + |> Seq.cast<'a * int * int> + |> Seq.filter (fun (value, _, _) -> (not <| isEqual zero value)) + |> Seq.toArray + |> Array.unzip3 + |> fun (values, rows, columns) -> + { RowCount = Array2D.length1 array + ColumnCount = Array2D.length2 array + Rows = rows + Columns = columns + Values = values } + + Utils.compareCOOMatrix isEqual actual expected + +let createTest isEqual (zero: 'a) = + CSR.Matrix.subRows context Utils.defaultWorkGroupSize + |> makeTest isEqual zero + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let tests = + [ createTest (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTest (=) 0.0 + + createTest (=) 0.0f + createTest (=) false ] + |> testList "Blit" diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 089602f4..9e046e6a 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -1159,3 +1159,62 @@ module Generators = static member BoolType() = pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen + + module Matrix = + type Sub() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! rowsCount = Gen.sized <| fun size -> Gen.choose (2, size + 2) + let! columnsCount = Gen.sized <| fun size -> Gen.choose (1, size + 1) + + let! array = Gen.array2DOfDim (rowsCount, columnsCount) valuesGenerator + + let! startPosition = Gen.choose (0, rowsCount - 2) + let! count = Gen.choose (1, rowsCount - startPosition - 1) + + return (array, startPosition, count) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index b3f4d6cf..1903377b 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -49,6 +49,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index f2403ddc..e0e55b97 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -162,6 +162,22 @@ module Utils = "Row pointers" |> compareArrays (=) actual.RowPointers expected.RowPointers + let compareCOOMatrix isEqual (actual: Matrix.COO<'a>) (expected: Matrix.COO<'a>) = + "Column count must be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount + + "Rows count must be the same" + |> Expect.equal actual.RowCount expected.RowCount + + "Values must be the same" + |> compareArrays isEqual actual.Values expected.Values + + "Column indices must be the same" + |> compareArrays (=) actual.Columns expected.Columns + + "Row pointers" + |> compareArrays (=) actual.Rows expected.Rows + let listOfUnionCases<'a> = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) diff --git a/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs index 7d2a3bdd..a15bc37d 100644 --- a/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs +++ b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs @@ -69,13 +69,8 @@ let makeTest isEqual zero createMatrix (array: 'a [,]) = let expectedColumns, expectedRows, expectedValues = array - |> Seq.cast<'a> - |> Seq.mapi - (fun index value -> - let columnIndex = index % arrayColumnCount - let rowIndex = index / arrayColumnCount - - (columnIndex, rowIndex, value)) + |> Array2D.mapi (fun rowIndex columnIndex value -> (columnIndex, rowIndex, value)) + |> Seq.cast |> Seq.filter (fun (_, _, value) -> ((<<) not <| isEqual zero) value) |> Seq.toArray |> Array.unzip3 diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index d933ffd5..11c62b70 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -4,4 +4,4 @@ open GraphBLAS.FSharp.Tests [] -let main argv = Matrix.ExpandRows.tests |> testSequenced |> runTestsWithCLIArgs [] argv +let main argv = Backend.Matrix.SubRows.tests |> testSequenced |> runTestsWithCLIArgs [] argv From 5551c5705c2ae48ca39051d49cbe1cb2c4a749c0 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 1 May 2023 20:45:54 +0300 Subject: [PATCH 117/143] add: ClArray.upperBound --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 30 ++++++++++ .../Matrix/SpGeMM/Expand.fs | 9 +++ src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 22 +++---- .../Backend/Common/ClArray/UpperBound.fs | 60 +++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Generators.fs | 58 ++++++++++++++++++ .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 7 files changed, 171 insertions(+), 11 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 98afc2c2..ea494882 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -694,3 +694,33 @@ module ClArray = else None + let upperBound<'a when 'a : equality and 'a : comparison> (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (value: ClCell<'a>) (result: ClCell) -> + + let value = value.Value + let gid = ndRange.GlobalID0 + + if gid = 0 then + + result.Value <- + (%Search.Bin.lowerBound 0) length value values @> + + let program = clContext.Compile(kernel) + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (value: ClCell<'a>) -> + let result = clContext.CreateClCell 0 + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(1, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values value result)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + result + + + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 18e15dd9..2dd3b22d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -72,7 +72,16 @@ module Expand = let segmentPointersByLeftMatrixRows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) + gather processor segmentLengths leftMatrix.RowPointers segmentPointersByLeftMatrixRows + let segmentPointersByLeftMatrixRows = segmentPointersByLeftMatrixRows.ToHostAndFree processor + + let beginRow = 0 + let totalWork = 0 + + while beginRow < leftMatrix.RowCount do + + //let endRow = () diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index cc68c629..0b7b1773 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -121,7 +121,7 @@ module Search = resultPosition @> - let lowerBound<'a when 'a : equality and 'a : comparison> startValue = + let lowerBound<'a when 'a: comparison> startValue = <@ fun lenght sourceItem (keys: ClArray<'a>) -> let mutable leftEdge = 0 @@ -129,15 +129,17 @@ module Search = let mutable resultPosition = startValue - while leftEdge <= rightEdge do - let currentPosition = (leftEdge + rightEdge) / 2 - let currentKey = keys.[currentPosition] + if sourceItem >= keys.[lenght - 1] then lenght - 1 + else + while leftEdge <= rightEdge do + let currentPosition = (leftEdge + rightEdge) / 2 + let currentKey = keys.[currentPosition] - if sourceItem < currentKey then - resultPosition <- currentPosition + if sourceItem < currentKey then + resultPosition <- currentPosition - rightEdge <- currentPosition - 1 - else - leftEdge <- currentPosition + 1 + rightEdge <- currentPosition - 1 + else + leftEdge <- currentPosition + 1 - resultPosition @> + resultPosition @> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs new file mode 100644 index 00000000..2884e714 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs @@ -0,0 +1,60 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.UpperBound + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ClCell + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest testFun (array: 'a [], value: 'a) = + + if array.Length > 0 then + + let array = Array.sort array + + let clArray = context.CreateClArray array + let clValue = context.CreateClCell value + + let actual = + (testFun processor clArray clValue: ClCell<_>) + .ToHostAndFree processor + + let expected = + let mutable expected = 0 + + let array = Array.rev array + + for i in 0 .. array.Length - 1 do + let currentValue = array.[i] + + if value < currentValue then + expected <- i + + array.Length - expected - 1 + + "Results must be the same" + |> Expect.equal actual expected + +let createTest<'a when 'a : equality and 'a : comparison> = + ClArray.upperBound<'a> context Utils.defaultWorkGroupSize + |> makeTest + |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" + +let tests = + [ createTest + + if Utils.isFloat64Available context.ClDevice then + createTest + + createTest + createTest ] + |> testList "UpperBound" diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 9e046e6a..702c6083 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -1160,6 +1160,64 @@ module Generators = pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen + type UpperBound() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! size = Gen.sized <| fun size -> Gen.choose (1, size + 1) + + let! array = Gen.arrayOfLength size valuesGenerator + + let! valueIndex = Gen.choose (0, array.Length - 1) + + let value = array.[valueIndex] + + return (array, value) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + module Matrix = type Sub() = static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 1903377b..c9379b9d 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -29,6 +29,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 11c62b70..8e3d0a2c 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -4,4 +4,4 @@ open GraphBLAS.FSharp.Tests [] -let main argv = Backend.Matrix.SubRows.tests |> testSequenced |> runTestsWithCLIArgs [] argv +let main argv = Common.ClArray.UpperBound.tests |> testSequenced |> runTestsWithCLIArgs [] argv From 5b1b3cda61f992fec9b0d82f0d1472fec20b6e74 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 1 May 2023 23:48:18 +0300 Subject: [PATCH 118/143] add: Search.Bin.lowerBound comments --- src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 17 +++++++++++++++++ .../Backend/Common/ClArray/UpperBound.fs | 2 +- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index 0b7b1773..a7cb2e13 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -121,6 +121,23 @@ module Search = resultPosition @> + /// + /// lowerBound is a version of binary search: it attempts to find the element value in an ordered range [first, last). + /// Specifically, it returns the last position where value could be inserted without violating the ordering. + /// + /// + /// + /// let array = [ 0; 2; 5; 7; 8; ] + /// + /// lowerBound array 0 // return 1 + /// lowerBound array 1 // return 1 + /// lowerBound array 2 // return 2 + /// lowerBound array 3 // return 2 + /// lowerBound array 8 // return array.Length - 1 + /// lowerBound array 9 // return array.Length - 1 + /// + /// + /// Position value before search. let lowerBound<'a when 'a: comparison> startValue = <@ fun lenght sourceItem (keys: ClArray<'a>) -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs index 2884e714..753ccb70 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs @@ -47,7 +47,7 @@ let makeTest testFun (array: 'a [], value: 'a) = let createTest<'a when 'a : equality and 'a : comparison> = ClArray.upperBound<'a> context Utils.defaultWorkGroupSize |> makeTest - |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let tests = [ createTest From 970ffa02860d905c472456f2f967760a97838034 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 2 May 2023 17:39:05 +0300 Subject: [PATCH 119/143] wip: SpGeMM --- .../Matrix/COO/Matrix.fs | 1 + src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 32 +- .../Matrix/SpGeMM/Expand.fs | 419 +++++++++++++++-- .../Backend/Matrix/SpGeMM/Expand.fs | 436 +++++++++--------- tests/GraphBLAS-sharp.Tests/Generators.fs | 66 ++- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 6 files changed, 682 insertions(+), 274 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index ac46e816..fd0fc338 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext module Matrix = let map = Map.run diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 4fc2b776..db9dbc54 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -405,19 +405,19 @@ module Matrix = | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" - // let expand - // (opAdd: Expr<'c -> 'c -> 'c option>) - // (opMul: Expr<'a -> 'b -> 'c option>) - // (clContext: ClContext) - // workGroupSize - // = - // - // let run = - // SpGeMM.Expand.run clContext workGroupSize opAdd opMul - // - // fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> - // match leftMatrix, rightMatrix with - // | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> - // ClMatrix.LIL - // <| run processor allocationMode leftMatrix rightMatrix - // | _ -> failwith "Matrix formats are not matching" + let expand + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let run = + SpGeMM.Expand.run opAdd opMul clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + match leftMatrix, rightMatrix with + | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> + // TODO(max alloc size) + run processor allocationMode 1000 leftMatrix rightMatrix + | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 2dd3b22d..a4d347aa 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -10,7 +10,6 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell open FSharp.Quotations -open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ClMatrix module Expand = @@ -21,13 +20,13 @@ module Expand = let prefixSum = PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrixRow: ClMatrix.CSR<'a>) (rightMatrixRowsLengths: ClArray) -> + fun (processor: MailboxProcessor<_>) (leftMatrixColumns: ClArray) (rightMatrixRowsLengths: ClArray) -> let segmentsLengths = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRow.NNZ) + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixColumns.Length) // extract needed lengths by left matrix nnz - gather processor leftMatrixRow.Columns rightMatrixRowsLengths segmentsLengths + gather processor leftMatrixColumns rightMatrixRowsLengths segmentsLengths // compute pointers let length = @@ -36,15 +35,367 @@ module Expand = length, segmentsLengths - let runByRows (clContext: ClContext) workGroupSize = + let multiply (predicate: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = + let getBitmap = + ClArray.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize - fun (processor: MailboxProcessor<_>) startRow endRow (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'a>) -> + let prefixSum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + let assignValues = + ClArray.assignOption2 predicate clContext workGroupSize + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) (rows: ClArray) -> + + let positions = + getBitmap processor DeviceOnly firstValues secondValues + + let resultLength = + (prefixSum processor positions) + .ToHostAndFree(processor) + + if resultLength = 0 then + positions.Free processor + + None + else + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions columns resultColumns + + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions rows resultRows + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + assignValues processor firstValues secondValues positions resultValues + + Some(resultValues, resultColumns, resultRows) + + let expand (clContext: ClContext) workGroupSize = + + let idScatter = + Scatter.initLastOccurrence Map.id clContext workGroupSize + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + let zeroCreate = + ClArray.zeroCreate clContext workGroupSize + + let maxPrefixSum = + PrefixSum.runIncludeInPlace <@ max @> clContext workGroupSize + + let create = ClArray.create clContext workGroupSize + + let gather = Gather.run clContext workGroupSize + + let segmentPrefixSum = + PrefixSum.ByKey.sequentialInclude <@ (+) @> 0 clContext workGroupSize + + let removeDuplicates = + ClArray.removeDuplications clContext workGroupSize + + let leftMatrixGather = Gather.run clContext workGroupSize + + let rightMatrixGather = Gather.run clContext workGroupSize + + fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + // Compute left matrix positions + let leftMatrixPositions = zeroCreate processor DeviceOnly lengths + + idScatter processor segmentsPointers leftMatrixPositions + + (maxPrefixSum processor leftMatrixPositions 0) + .Free processor + + // Compute right matrix positions + let rightMatrixPositions = create processor DeviceOnly lengths 1 + + let requiredRightMatrixPointers = + zeroCreate processor DeviceOnly leftMatrix.Columns.Length + + gather processor leftMatrix.Columns rightMatrix.RowPointers requiredRightMatrixPointers + + scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions + + requiredRightMatrixPointers.Free processor + + // another way to get offsets ??? + let offsets = + removeDuplicates processor segmentsPointers + + segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets + + offsets.Free processor + + // compute columns + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor rightMatrixPositions rightMatrix.Columns columns + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor leftMatrixPositions leftMatrix.Rows rows + + // compute left matrix values + let leftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues + + leftMatrixPositions.Free processor + + // compute right matrix values + let rightMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues + + rightMatrixPositions.Free processor + + // left, right matrix values, columns and rows indices + leftMatrixValues, rightMatrixValues, columns, rows + + let sortByColumnsAndRows (clContext: ClContext) workGroupSize = + + let sortByKeyIndices = + Radix.runByKeysStandard clContext workGroupSize + + let sortByKeyValues = + Radix.runByKeysStandard clContext workGroupSize + + let sortKeys = + Radix.standardRunKeysOnly clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> + // sort by columns + let valuesSortedByColumns = + sortByKeyValues processor DeviceOnly columns values + + let rowsSortedByColumns = + sortByKeyIndices processor DeviceOnly columns rows + + let sortedColumns = sortKeys processor columns + + // sort by rows + let valuesSortedByRows = + sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns + + let columnsSortedByRows = + sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns + + let sortedRows = sortKeys processor rowsSortedByColumns + + valuesSortedByColumns.Free processor + rowsSortedByColumns.Free processor + sortedColumns.Free processor + + valuesSortedByRows, columnsSortedByRows, sortedRows + + let reduce opAdd (clContext: ClContext) workGroupSize = + + let reduce = + Reduce.ByKey2D.Option.segmentSequential opAdd clContext workGroupSize + + let getUniqueBitmap = + ClArray.Bitmap.lastOccurrence2 clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + let idScatter = + Scatter.initFirsOccurrence Map.id clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> - () + let bitmap = + getUniqueBitmap processor DeviceOnly columns rows - let CUSP (clContext: ClContext) workGroupSize = + let uniqueKeysCount = + (prefixSum processor bitmap) + .ToHostAndFree processor + + let offsets = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + idScatter processor bitmap offsets + + bitmap.Free processor + + let reduceResult = + reduce processor allocationMode uniqueKeysCount offsets columns rows values + + offsets.Free processor + + // reducedValues, reducedColumns, reducedRows + + reduceResult + + let runCOO opAdd opMul (clContext: ClContext) workGroupSize = + + let getSegmentPointers = getSegmentPointers clContext workGroupSize + + let expand = expand clContext workGroupSize + + let multiply = multiply opMul clContext workGroupSize + + let sort = + sortByColumnsAndRows clContext workGroupSize + + let reduce = reduce opAdd clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (rightMatrixRowsNNZ: ClArray) (rightMatrix: ClMatrix.CSR<'b>) (leftMatrix: ClMatrix.COO<'a>) -> + + let length, segmentPointers = + getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ + + if length = 0 then + segmentPointers.Free processor + + None + else + // expand + let leftMatrixValues, rightMatrixValues, columns, rows = + expand processor length segmentPointers leftMatrix rightMatrix + + // multiply + let mulResult = + multiply processor leftMatrixValues rightMatrixValues columns rows + + leftMatrixValues.Free processor + rightMatrixValues.Free processor + columns.Free processor + rows.Free processor + + mulResult + |> Option.bind (fun (resultValues, resultColumns, resultRows) -> + // sort + let sortedValues, sortedColumns, sortedRows = + sort processor resultValues resultColumns resultRows + + resultValues.Free processor + resultColumns.Free processor + resultRows.Free processor + + // addition + let reduceResult = + reduce processor allocationMode sortedValues sortedColumns sortedRows + + reduceResult + |> Option.map (fun (reducedValues, reducedColumns, reducedRows) -> + + sortedValues.Free processor + sortedColumns.Free processor + sortedRows.Free processor + + reducedValues, reducedColumns, reducedRows)) + + let runOneStep opAdd opMul (clContext: ClContext) workGroupSize = + + let runCOO = runCOO opAdd opMul clContext workGroupSize + + let expandRowPointers = + CSR.Matrix.expandRowPointers clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + + let rows = expandRowPointers processor DeviceOnly leftMatrix + + let leftMatrixCOO = + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = leftMatrix.ColumnCount + Rows = rows + Columns = leftMatrix.Columns + Values = leftMatrix.Values } + + let result = + runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix leftMatrixCOO + + rows.Free processor + + result + |> Option.map ( fun (values, columns, rows) -> + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + Columns = columns + Values = values }) + + let runManySteps opAdd opMul (clContext: ClContext) workGroupSize = + + let gather = + Gather.run clContext workGroupSize + + let upperBound = ClArray.upperBound clContext workGroupSize + + let subMatrix = CSR.Matrix.subRows clContext workGroupSize + + let runCOO = runCOO opAdd opMul clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + // extract segment lengths by left matrix rows pointers + let segmentPointersByLeftMatrixRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) + + gather processor leftMatrix.RowPointers segmentLengths segmentPointersByLeftMatrixRows + + // curring + let upperBound = upperBound processor segmentPointersByLeftMatrixRows + let subMatrix = subMatrix processor DeviceOnly + let runCOO = runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix + + let rec helper beginRow workOffset previousResult = + if beginRow < leftMatrix.RowCount then + let currentBound = + clContext.CreateClCell(workOffset + maxAllocSize: int) + + // find largest row that fit into maxAllocSize + let endRow = (upperBound currentBound).ToHostAndFree processor + + // TODO(handle largest rows) + // (we can split row, multiply and merge them but merge path needed) + if endRow = beginRow then + let segments = segmentPointersByLeftMatrixRows.ToHost processor + printfn "seg pointers: %A" <| segments.[beginRow + 1] + + failwith "It is impossible to multiply such a long row" + + // extract matrix + let subMatrix = subMatrix beginRow (endRow - beginRow) leftMatrix + // compute sub result + let result = runCOO subMatrix + + let workOffset = workOffset + (endRow - beginRow) + + match result with + | Some result -> + helper endRow workOffset <| result :: previousResult + | None -> + helper endRow workOffset previousResult + else + previousResult + + let result = helper 0 0 [] |> List.rev + + segmentPointersByLeftMatrixRows.Free processor + rightMatrixRowsNNZ.Free processor + + result + + let run opAdd opMul (clContext: ClContext) workGroupSize = let getNNZInRows = CSR.Matrix.NNZInRows clContext workGroupSize @@ -52,37 +403,49 @@ module Expand = let getSegmentPointers = getSegmentPointers clContext workGroupSize - let gather = - Gather.run clContext workGroupSize + let runOneStep = runOneStep opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let concat = ClArray.concat clContext workGroupSize + + let concatData = ClArray.concat clContext workGroupSize + + let runManySteps = runManySteps opAdd opMul clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let rightMatrixRowsNNZ = getNNZInRows processor DeviceOnly rightMatrix let length, segmentLengths = - getSegmentPointers processor leftMatrix rightMatrixRowsNNZ + getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ if length < maxAllocSize then - // compute in one step - - () + runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix else - // extract segment lengths by left matrix rows pointers - let segmentPointersByLeftMatrixRows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) - - gather processor segmentLengths leftMatrix.RowPointers segmentPointersByLeftMatrixRows - - let segmentPointersByLeftMatrixRows = segmentPointersByLeftMatrixRows.ToHostAndFree processor + let result = + runManySteps processor allocationMode maxAllocSize leftMatrix segmentLengths rightMatrixRowsNNZ rightMatrix - let beginRow = 0 - let totalWork = 0 + match result with + | _ :: _ -> + let valuesList, columnsList, rowsList = + result + |> List.unzip3 - while beginRow < leftMatrix.RowCount do + let values = concatData processor allocationMode valuesList + let columns = concat processor allocationMode columnsList + let rows = concat processor allocationMode rowsList - //let endRow = + // release resources + valuesList |> List.iter (fun array -> array.Free processor) + columnsList |> List.iter (fun array -> array.Free processor) + rowsList |> List.iter (fun array -> array.Free processor) - () + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + Columns = columns + Values = values } + |> Some + | _ -> None - () diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index 00a2b0c9..10728508 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -16,229 +16,213 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Objects.MatrixExtensions -// let context = Context.defaultContext.ClContext -// -// let processor = Context.defaultContext.Queue -// -// processor.Error.Add(fun e -> failwithf "%A" e) -// -// let config = -// { Utils.defaultConfig with -// arbitrary = -// [ typeof -// typeof ] } -// -// let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = -// -// let leftMatrixRow = -// Vector.Sparse.FromArray(leftArray, isZero) -// -// let rightMatrix = -// Matrix.CSR.FromArray2D(rightArray, isZero) -// -// if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then -// -// // compute expected result -// let rightMatrixRowsLength = -// rightMatrix.RowPointers -// |> Array.pairwise -// |> Array.map (fun (fst, snd) -> snd - fst) -// -// let expectedPointers, expectedLength = -// Array.init leftMatrixRow.Indices.Length (fun index -> rightMatrixRowsLength.[leftMatrixRow.Indices.[index]]) -// |> HostPrimitives.prefixSumExclude 0 (+) -// -// let clLeftMatrixRow = leftMatrixRow.ToDevice context -// -// let clRightMatrixRowsLength = -// context.CreateClArray rightMatrixRowsLength -// -// let actualLength, (clActual: ClArray) = -// testFun processor clLeftMatrixRow clRightMatrixRowsLength -// -// clLeftMatrixRow.Dispose processor -// -// let actualPointers = clActual.ToHostAndFree processor -// -// "Results lengths must be the same" -// |> Expect.equal actualLength expectedLength -// -// "Result pointers must be the same" -// |> Expect.sequenceEqual actualPointers expectedPointers -// -// let createTest<'a when 'a: struct> (isZero: 'a -> bool) = -// Expand.getSegmentPointers context Utils.defaultWorkGroupSize -// |> makeTest isZero -// |> testPropertyWithConfig config $"test on {typeof<'a>}" -// -// // Debug tests -// let getSegmentsTests = -// [ createTest ((=) 0) -// -// if Utils.isFloat64Available context.ClDevice then -// createTest ((=) 0.0) -// -// createTest ((=) 0f) -// createTest ((=) false) -// createTest ((=) 0uy) ] -// |> testList "get segment pointers" -// -// let expand (leftMatrixRow: Vector.Sparse<'a>) (rightMatrix: Matrix.CSR<'b>) = -// let rightMatrixRowsLengths = -// rightMatrix.RowPointers -// |> Array.pairwise -// |> Array.map (fun (fst, snd) -> snd - fst) -// -// let segmentsLengths = -// Array.map (fun columnIndex -> rightMatrixRowsLengths.[columnIndex]) leftMatrixRow.Indices -// -// let leftMatrixValues = -// Array.map2 Array.create segmentsLengths leftMatrixRow.Values -// |> Array.concat -// -// let rightMatrixRowPointers = -// Array.map (fun index -> rightMatrix.RowPointers.[index]) leftMatrixRow.Indices -// -// let rightMatrixValues = -// Array.map2 -// (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.Values.[rowPointer..]) -// rightMatrixRowPointers -// segmentsLengths -// |> Array.concat -// -// let columns = -// Array.map2 -// (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.ColumnIndices.[rowPointer..]) -// rightMatrixRowPointers -// segmentsLengths -// |> Array.concat -// -// leftMatrixValues, rightMatrixValues, columns -// -// let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = -// -// let leftMatrixRow = -// Vector.Sparse.FromArray(leftArray, (isEqual zero)) -// -// let rightMatrix = -// Matrix.CSR.FromArray2D(rightArray, (isEqual zero)) -// -// if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then -// -// let clPointers, lenght = -// rightMatrix.RowPointers -// |> Array.pairwise -// |> Array.map (fun (fst, snd) -> snd - fst) -// |> fun rightMatrixRowsLengths -> -// Array.init -// leftMatrixRow.Indices.Length -// (fun index -> rightMatrixRowsLengths.[leftMatrixRow.Indices.[index]]) -// |> HostPrimitives.prefixSumExclude 0 (+) -// |> fun (pointers, length) -> context.CreateClArray(pointers), length -// -// let clLeftMatrixRow = leftMatrixRow.ToDevice context -// let clRightMatrix = rightMatrix.ToDevice context -// -// let result = -// testFun processor lenght clPointers clLeftMatrixRow clRightMatrix -// -// clLeftMatrixRow.Dispose processor -// clRightMatrix.Dispose processor -// clPointers.Free processor -// -// let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns = expand leftMatrixRow rightMatrix -// -// match result with -// | Some (clActualLeftValues: ClArray<'a>, clActualRightValues: ClArray<'a>, clActualColumns: ClArray) -> -// -// let actualLeftValues = -// clActualLeftValues.ToHostAndFree processor -// -// let actualRightValues = -// clActualRightValues.ToHostAndFree processor -// -// let actualColumns = clActualColumns.ToHostAndFree processor -// -// "Left values must be the same" -// |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues -// -// "Right values must be the same" -// |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues -// -// "Columns must be the same" -// |> Utils.compareArrays (=) actualColumns expectedColumns -// | None -> -// "Result must be empty" -// |> Expect.isTrue (expectedColumns.Length = 0) -// -// let createExpandTest isEqual (zero: 'a) testFun = -// testFun context Utils.defaultWorkGroupSize -// |> makeExpandTest isEqual zero -// |> testPropertyWithConfig config $"test on %A{typeof<'a>}" -// -// // (Debug only) expand phase tests -// let expandTests = -// [ createExpandTest (=) 0 Expand.expand -// -// if Utils.isFloat64Available context.ClDevice then -// createExpandTest Utils.floatIsEqual 0.0 Expand.expand -// -// createExpandTest Utils.float32IsEqual 0f Expand.expand -// createExpandTest (=) false Expand.expand -// createExpandTest (=) 0uy Expand.expand ] -// |> testList "Expand.expand" -// -// let makeGeneralTest<'a when 'a: struct> zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = -// -// let leftMatrix = -// Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) -// -// let rightMatrix = -// Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) -// -// if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then -// -// let clLeftMatrix = leftMatrix.ToDevice context -// let clRightMatrix = rightMatrix.ToDevice context -// -// let (clMatrixActual: ClMatrix<_>) = -// testFun processor HostInterop clLeftMatrix clRightMatrix -// -// clLeftMatrix.Dispose processor -// clRightMatrix.Dispose processor -// -// let matrixActual = -// clMatrixActual.ToHostAndDispose processor -// -// match matrixActual with -// | Matrix.LIL actual -> -// HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray -// |> fun array -> Matrix.LIL.FromArray2D(array, (isEqual zero)) -// |> Utils.compareLILMatrix isEqual actual -// | _ -> failwith "Matrix format are not matching" -// -// let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = -// testFun opAddQ opMulQ context Utils.defaultWorkGroupSize -// |> makeGeneralTest<'a> zero isEqual opMul opAdd -// |> testPropertyWithConfig { config with endSize = 500 } $"test on %A{typeof<'a>}" -// -// let generalTests = -// [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand -// -// if Utils.isFloat64Available context.ClDevice then -// createGeneralTest -// 0.0 -// Utils.floatIsEqual -// ArithmeticOperations.floatAdd -// ArithmeticOperations.floatMul -// Matrix.SpGeMM.expand -// -// createGeneralTest -// 0.0f -// Utils.float32IsEqual -// ArithmeticOperations.float32Add -// ArithmeticOperations.float32Mul -// Matrix.SpGeMM.expand -// -// createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] -// |> testList "general" +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with arbitrary = [ typeof ] } + +let getSegmentsPointers (leftMatrixColumns: int []) (rightRowsPointers: int []) = + Array.map + (fun item -> rightRowsPointers.[item + 1] - rightRowsPointers.[item]) + leftMatrixColumns + |> HostPrimitives.prefixSumExclude 0 (+) + +let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = Matrix.CSR.FromArray2D(leftArray, isZero) + + let rightMatrix = Matrix.CSR.FromArray2D(rightArray, isZero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + + let clRightMatrix = rightMatrix.ToDevice context + + let actualLength, (clActual: ClArray) = + testFun processor clLeftMatrix.Columns clRightMatrix.RowPointers + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let actualPointers = clActual.ToHostAndFree processor + + let expectedPointers, expectedLength = + getSegmentsPointers leftMatrix.ColumnIndices rightMatrix.RowPointers + + "Results lengths must be the same" + |> Expect.equal actualLength expectedLength + + "Result pointers must be the same" + |> Expect.sequenceEqual actualPointers expectedPointers + +let createTest<'a when 'a: struct> (isZero: 'a -> bool) = + Expand.getSegmentPointers context Utils.defaultWorkGroupSize + |> makeTest isZero + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let getSegmentsTests = + [ createTest ((=) 0) + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) + + createTest ((=) 0f) + createTest ((=) false) + createTest ((=) 0uy) ] + |> testList "get segment pointers" + +let expand length segmentPointers (leftMatrix: Matrix.COO<'a>) (rightMatrix: Matrix.CSR<'b>) = + let segmentsLengths = + Array.append segmentPointers [| length |] + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let leftMatrixValues, expectedRows = + let tripleFst (fst, _, _) = fst + + Array.zip3 segmentsLengths leftMatrix.Values leftMatrix.Rows + // select items each segment length not zero + |> Array.filter (tripleFst >> ((=) 0) >> not) + |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) + |> Array.unzip + + let rightMatrixValues, expectedColumns = + let valuesAndColumns = + Array.zip rightMatrix.Values rightMatrix.ColumnIndices + + Array.map2 + (fun column length -> + let rowStart = rightMatrix.RowPointers.[column] + Array.take length valuesAndColumns.[rowStart..]) + leftMatrix.Columns + segmentsLengths + |> Array.concat + |> Array.unzip + + leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows + +// Expand tests (debug only) +let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = Matrix.COO.FromArray2D(leftArray, isEqual zero) + + let rightMatrix = Matrix.CSR.FromArray2D(rightArray, isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let segmentPointers, length = + getSegmentsPointers leftMatrix.Columns rightMatrix.RowPointers + + if length > 0 then + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + let clSegmentPointers = context.CreateClArray segmentPointers + + let (clActualLeftValues: ClArray<'a>, + clActualRightValues: ClArray<'a>, + clActualColumns: ClArray, + clActualRows: ClArray) = + testFun processor length clSegmentPointers clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + clSegmentPointers.Free processor + + let actualLeftValues = + clActualLeftValues.ToHostAndFree processor + + let actualRightValues = + clActualRightValues.ToHostAndFree processor + + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor + + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = + expand length segmentPointers leftMatrix rightMatrix + + "Left values must be the same" + |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues + + "Right values must be the same" + |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expectedColumns + + "Rows must be the same" + |> Utils.compareArrays (=) actualRows expectedRows + +let createExpandTest isEqual (zero: 'a) testFun = + testFun context Utils.defaultWorkGroupSize + |> makeExpandTest isEqual zero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +// expand phase tests +let expandTests = + [ createExpandTest (=) 0 Expand.expand + + if Utils.isFloat64Available context.ClDevice then + createExpandTest Utils.floatIsEqual 0.0 Expand.expand + + createExpandTest Utils.float32IsEqual 0f Expand.expand + createExpandTest (=) false Expand.expand + createExpandTest (=) 0uy Expand.expand ] + |> testList "Expand.expand" + +let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clMatrixActual: ClMatrix.COO<_> option) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + let expected = + HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray + |> fun array -> Matrix.COO.FromArray2D(array, isEqual zero) + + match clMatrixActual with + | Some clMatrixActual -> + + let matrixActual = clMatrixActual.ToHost processor + clMatrixActual.Dispose processor + + Utils.compareCOOMatrix isEqual matrixActual expected + | None -> + "Expected should be empty" + |> Expect.isTrue (expected.NNZ = 0) + +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = + testFun opAddQ opMulQ context Utils.defaultWorkGroupSize + |> makeGeneralTest zero isEqual opAdd opMul + |> testPropertyWithConfig { config with endSize = 1000; maxTest = 100 } $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest + 0.0 + Utils.floatIsEqual + ArithmeticOperations.floatAdd + ArithmeticOperations.floatMul + Matrix.SpGeMM.expand + + createGeneralTest + 0.0f + Utils.float32IsEqual + ArithmeticOperations.float32Add + ArithmeticOperations.float32Mul + Matrix.SpGeMM.expand + createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] + |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 702c6083..8c4d7623 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -37,7 +37,7 @@ module Generators = let genericSparseGenerator zero valuesGen handler = let maxSparsity = 100 - let sparsityGen = Gen.choose (0, maxSparsity) + let sparsityGen = Gen.choose (1, 10) let genWithSparsity sparseValuesGenProvider = gen { @@ -54,8 +54,8 @@ module Generators = genWithSparsity <| fun sparsity -> - [ (maxSparsity - sparsity, valuesGen) - (sparsity, Gen.constant zero) ] + [ (sparsity, valuesGen) + (maxSparsity - sparsity, Gen.constant zero) ] |> Gen.frequency |> handler @@ -228,6 +228,66 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen + type PairOfSparseMatricesWithCompatibleSizes() = // TODO to module Matrix + static let pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = + gen { + let! firstCount, secondCount, thirdCount = dimension3DGenerator + + let! matrixA = + valuesGenerator + |> Gen.array2DOfDim (firstCount, secondCount) + + let! matrixB = + valuesGenerator + |> Gen.array2DOfDim (secondCount, thirdCount) + + return (matrixA, matrixB) + } + + static member IntType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator + 0. + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0.0f (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator false Arb.generate + |> Arb.fromGen + type PairOfSparseMatrixAndVectorsCompatibleSize() = static let pairOfMatrixAndVectorOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = gen { diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 8e3d0a2c..1de9a5b9 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -4,4 +4,4 @@ open GraphBLAS.FSharp.Tests [] -let main argv = Common.ClArray.UpperBound.tests |> testSequenced |> runTestsWithCLIArgs [] argv +let main argv = Matrix.SpGeMM.Expand.generalTests |> testSequenced |> runTestsWithCLIArgs [] argv From fcbeee423a45e137931c59ffbe8536340dbc8138 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 2 May 2023 19:52:24 +0300 Subject: [PATCH 120/143] add: ClArray.upperBoundWithValue --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 28 ++- .../Matrix/CSR/Matrix.fs | 62 +++--- .../Matrix/SpGeMM/Expand.fs | 178 ++++++++++-------- src/GraphBLAS-sharp.Backend/Quotes/Search.fs | 34 +++- .../Objects/MatrixExtensions.fs | 12 +- .../Backend/Common/ClArray/UpperBound.fs | 6 +- .../Backend/Matrix/ExpandRows.fs | 5 +- .../Backend/Matrix/SpGeMM/Expand.fs | 27 ++- .../Backend/Matrix/SubRows.fs | 16 +- tests/GraphBLAS-sharp.Tests/Generators.fs | 86 ++++----- .../Host/Matrix/FromaArray2D.fs | 2 +- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +- 12 files changed, 272 insertions(+), 189 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index ea494882..fa8a8997 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -268,9 +268,11 @@ module ClArray = result - let firstOccurrence2 clContext = getUniqueBitmap2General firstOccurrence clContext + let firstOccurrence2 clContext = + getUniqueBitmap2General firstOccurrence clContext - let lastOccurrence2 clContext = getUniqueBitmap2General lastOccurrence clContext + let lastOccurrence2 clContext = + getUniqueBitmap2General lastOccurrence clContext ///Remove duplicates form the given array. ///Computational context @@ -694,33 +696,39 @@ module ClArray = else None - let upperBound<'a when 'a : equality and 'a : comparison> (clContext: ClContext) workGroupSize = + let private bound<'a, 'b when 'a: equality and 'a: comparison> + (lowerBound: Expr<(int -> 'a -> ClArray<'a> -> 'b)>) + (clContext: ClContext) + workGroupSize + = let kernel = - <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (value: ClCell<'a>) (result: ClCell) -> + <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (value: ClCell<'a>) (result: ClCell<'b>) -> let value = value.Value let gid = ndRange.GlobalID0 if gid = 0 then - result.Value <- - (%Search.Bin.lowerBound 0) length value values @> + result.Value <- (%lowerBound) length value values @> let program = clContext.Compile(kernel) fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (value: ClCell<'a>) -> - let result = clContext.CreateClCell 0 + let result = + clContext.CreateClCell Unchecked.defaultof<'b> let kernel = program.GetKernel() - let ndRange = - Range1D.CreateValid(1, workGroupSize) + let ndRange = Range1D.CreateValid(1, workGroupSize) processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values value result)) processor.Post(Msg.CreateRunMsg<_, _> kernel) result + let upperBoundAndValue<'a when 'a: comparison> clContext = + bound<'a, int * 'a> Search.Bin.lowerBoundAndValue clContext - + let upperBound<'a when 'a: comparison> clContext = + bound<'a, int> Search.Bin.lowerBound clContext diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index f1f66c63..3078bdbb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -22,9 +22,9 @@ module Matrix = if gid < columnsLength then let result = - (%Search.Bin.lowerBound 0) pointersLength gid pointers + (%Search.Bin.lowerBound) pointersLength gid pointers - results.[gid] <- result - 1 @> + results.[gid] <- result - 1 @> let program = clContext.Compile kernel @@ -38,14 +38,16 @@ module Matrix = let ndRange = Range1D.CreateValid(matrix.Columns.Length, workGroupSize) - processor.Post(Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - matrix.Columns.Length - matrix.RowPointers.Length - matrix.RowPointers - rows)) + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + matrix.Columns.Length + matrix.RowPointers.Length + matrix.RowPointers + rows) + ) processor.Post(Msg.CreateRunMsg<_, _> kernel) @@ -63,9 +65,9 @@ module Matrix = if gid < resultLength then let result = - (%Search.Bin.lowerBound 0) pointersLength shiftedId pointers + (%Search.Bin.lowerBound) pointersLength shiftedId pointers - results.[gid] <- result - 1 @> + results.[gid] <- result - 1 @> let program = clContext.Compile kernel @@ -86,7 +88,9 @@ module Matrix = // extract rows let rowPointers = matrix.RowPointers.ToHost processor - let resultLength = rowPointers.[startIndex + count] - rowPointers.[startIndex] + let resultLength = + rowPointers.[startIndex + count] + - rowPointers.[startIndex] let rows = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -96,15 +100,17 @@ module Matrix = let ndRange = Range1D.CreateValid(matrix.Columns.Length, workGroupSize) - processor.Post(Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - resultLength - startIndex - matrix.RowPointers.Length - matrix.RowPointers - rows)) + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + startIndex + matrix.RowPointers.Length + matrix.RowPointers + rows) + ) processor.Post(Msg.CreateRunMsg<_, _> kernel) @@ -130,15 +136,15 @@ module Matrix = Values = values } let toCOO (clContext: ClContext) workGroupSize = - let prepare = expandRowPointers clContext workGroupSize + let prepare = + expandRowPointers clContext workGroupSize let copy = ClArray.copy clContext workGroupSize let copyData = ClArray.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - let rows = - prepare processor allocationMode matrix + let rows = prepare processor allocationMode matrix let cols = copy processor allocationMode matrix.Columns @@ -154,11 +160,11 @@ module Matrix = Values = values } let toCOOInPlace (clContext: ClContext) workGroupSize = - let prepare = expandRowPointers clContext workGroupSize + let prepare = + expandRowPointers clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - let rows = - prepare processor allocationMode matrix + let rows = prepare processor allocationMode matrix processor.Post(Msg.CreateFreeMsg(matrix.RowPointers)) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index a4d347aa..1dfb7de3 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -244,7 +244,8 @@ module Expand = let runCOO opAdd opMul (clContext: ClContext) workGroupSize = - let getSegmentPointers = getSegmentPointers clContext workGroupSize + let getSegmentPointers = + getSegmentPointers clContext workGroupSize let expand = expand clContext workGroupSize @@ -279,38 +280,42 @@ module Expand = rows.Free processor mulResult - |> Option.bind (fun (resultValues, resultColumns, resultRows) -> - // sort - let sortedValues, sortedColumns, sortedRows = - sort processor resultValues resultColumns resultRows + |> Option.bind + (fun (resultValues, resultColumns, resultRows) -> + // sort + let sortedValues, sortedColumns, sortedRows = + sort processor resultValues resultColumns resultRows - resultValues.Free processor - resultColumns.Free processor - resultRows.Free processor + resultValues.Free processor + resultColumns.Free processor + resultRows.Free processor - // addition - let reduceResult = - reduce processor allocationMode sortedValues sortedColumns sortedRows + // addition + let reduceResult = + reduce processor allocationMode sortedValues sortedColumns sortedRows - reduceResult - |> Option.map (fun (reducedValues, reducedColumns, reducedRows) -> + reduceResult + |> Option.map + (fun (reducedValues, reducedColumns, reducedRows) -> - sortedValues.Free processor - sortedColumns.Free processor - sortedRows.Free processor + sortedValues.Free processor + sortedColumns.Free processor + sortedRows.Free processor - reducedValues, reducedColumns, reducedRows)) + reducedValues, reducedColumns, reducedRows)) let runOneStep opAdd opMul (clContext: ClContext) workGroupSize = - let runCOO = runCOO opAdd opMul clContext workGroupSize + let runCOO = + runCOO opAdd opMul clContext workGroupSize let expandRowPointers = CSR.Matrix.expandRowPointers clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> - let rows = expandRowPointers processor DeviceOnly leftMatrix + let rows = + expandRowPointers processor DeviceOnly leftMatrix let leftMatrixCOO = { Context = clContext @@ -326,74 +331,76 @@ module Expand = rows.Free processor result - |> Option.map ( fun (values, columns, rows) -> - { Context = clContext - RowCount = leftMatrix.RowCount - ColumnCount = rightMatrix.ColumnCount - Rows = rows - Columns = columns - Values = values }) + |> Option.map + (fun (values, columns, rows) -> + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + Columns = columns + Values = values }) let runManySteps opAdd opMul (clContext: ClContext) workGroupSize = - let gather = - Gather.run clContext workGroupSize + let gather = Gather.run clContext workGroupSize - let upperBound = ClArray.upperBound clContext workGroupSize + let upperBound = + ClArray.upperBoundAndValue clContext workGroupSize - let subMatrix = CSR.Matrix.subRows clContext workGroupSize + let subMatrix = + CSR.Matrix.subRows clContext workGroupSize - let runCOO = runCOO opAdd opMul clContext workGroupSize + let runCOO = + runCOO opAdd opMul clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> // extract segment lengths by left matrix rows pointers - let segmentPointersByLeftMatrixRows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) + let segmentPointersByLeftMatrixRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) - gather processor leftMatrix.RowPointers segmentLengths segmentPointersByLeftMatrixRows + gather processor leftMatrix.RowPointers segmentLengths segmentPointersByLeftMatrixRows - // curring - let upperBound = upperBound processor segmentPointersByLeftMatrixRows - let subMatrix = subMatrix processor DeviceOnly - let runCOO = runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix + // curring + let upperBound = + upperBound processor segmentPointersByLeftMatrixRows - let rec helper beginRow workOffset previousResult = - if beginRow < leftMatrix.RowCount then - let currentBound = - clContext.CreateClCell(workOffset + maxAllocSize: int) + let subMatrix = subMatrix processor DeviceOnly - // find largest row that fit into maxAllocSize - let endRow = (upperBound currentBound).ToHostAndFree processor + let runCOO = + runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix - // TODO(handle largest rows) - // (we can split row, multiply and merge them but merge path needed) - if endRow = beginRow then - let segments = segmentPointersByLeftMatrixRows.ToHost processor - printfn "seg pointers: %A" <| segments.[beginRow + 1] + let rec helper beginRow workOffset previousResult = + if beginRow < leftMatrix.RowCount then + let currentBound = + clContext.CreateClCell(workOffset + maxAllocSize: int) - failwith "It is impossible to multiply such a long row" + // find largest row that fit into maxAllocSize + let endRow, value = + (upperBound currentBound).ToHostAndFree processor - // extract matrix - let subMatrix = subMatrix beginRow (endRow - beginRow) leftMatrix - // compute sub result - let result = runCOO subMatrix + // TODO(handle largest rows) + // (we can split row, multiply and merge them but merge path needed) + if endRow = beginRow then + failwith "It is impossible to multiply such a long row" - let workOffset = workOffset + (endRow - beginRow) + // extract matrix TODO(Transfer overhead) + let subMatrix = + subMatrix beginRow (endRow - beginRow) leftMatrix + // compute sub result + let result = runCOO subMatrix - match result with - | Some result -> - helper endRow workOffset <| result :: previousResult - | None -> - helper endRow workOffset previousResult - else - previousResult + match result with + | Some result -> helper endRow value <| result :: previousResult + | None -> helper endRow value previousResult + else + previousResult - let result = helper 0 0 [] |> List.rev + let result = helper 0 0 [] |> List.rev - segmentPointersByLeftMatrixRows.Free processor - rightMatrixRowsNNZ.Free processor + segmentPointersByLeftMatrixRows.Free processor + rightMatrixRowsNNZ.Free processor - result + result let run opAdd opMul (clContext: ClContext) workGroupSize = @@ -403,13 +410,15 @@ module Expand = let getSegmentPointers = getSegmentPointers clContext workGroupSize - let runOneStep = runOneStep opAdd opMul clContext workGroupSize + let runOneStep = + runOneStep opAdd opMul clContext workGroupSize let concat = ClArray.concat clContext workGroupSize let concatData = ClArray.concat clContext workGroupSize - let runManySteps = runManySteps opAdd opMul clContext workGroupSize + let runManySteps = + runManySteps opAdd opMul clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> @@ -423,22 +432,36 @@ module Expand = runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix else let result = - runManySteps processor allocationMode maxAllocSize leftMatrix segmentLengths rightMatrixRowsNNZ rightMatrix + runManySteps + processor + allocationMode + maxAllocSize + leftMatrix + segmentLengths + rightMatrixRowsNNZ + rightMatrix match result with | _ :: _ -> - let valuesList, columnsList, rowsList = - result - |> List.unzip3 + let valuesList, columnsList, rowsList = result |> List.unzip3 + + let values = + concatData processor allocationMode valuesList + + let columns = + concat processor allocationMode columnsList - let values = concatData processor allocationMode valuesList - let columns = concat processor allocationMode columnsList let rows = concat processor allocationMode rowsList // release resources - valuesList |> List.iter (fun array -> array.Free processor) - columnsList |> List.iter (fun array -> array.Free processor) - rowsList |> List.iter (fun array -> array.Free processor) + valuesList + |> List.iter (fun array -> array.Free processor) + + columnsList + |> List.iter (fun array -> array.Free processor) + + rowsList + |> List.iter (fun array -> array.Free processor) { Context = clContext RowCount = leftMatrix.RowCount @@ -448,4 +471,3 @@ module Expand = Values = values } |> Some | _ -> None - diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index a7cb2e13..d2ea346a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -137,16 +137,16 @@ module Search = /// lowerBound array 9 // return array.Length - 1 /// /// - /// Position value before search. - let lowerBound<'a when 'a: comparison> startValue = + let lowerBound<'a when 'a: comparison> = <@ fun lenght sourceItem (keys: ClArray<'a>) -> let mutable leftEdge = 0 let mutable rightEdge = lenght - 1 - let mutable resultPosition = startValue + let mutable resultPosition = 0 - if sourceItem >= keys.[lenght - 1] then lenght - 1 + if sourceItem >= keys.[lenght - 1] then + lenght - 1 else while leftEdge <= rightEdge do let currentPosition = (leftEdge + rightEdge) / 2 @@ -160,3 +160,29 @@ module Search = leftEdge <- currentPosition + 1 resultPosition @> + + let lowerBoundAndValue<'a when 'a: comparison> = + let defaultValue = Unchecked.defaultof<'a> + + <@ fun lenght sourceItem (keys: ClArray<'a>) -> + + let mutable leftEdge = 0 + let mutable rightEdge = lenght - 1 + + let mutable resultPosition = 0, defaultValue + + if sourceItem >= keys.[lenght - 1] then + (lenght - 1), keys.[lenght - 1] + else + while leftEdge <= rightEdge do + let currentPosition = (leftEdge + rightEdge) / 2 + let currentKey = keys.[currentPosition] + + if sourceItem < currentKey then + resultPosition <- currentPosition, currentKey + + rightEdge <- currentPosition - 1 + else + leftEdge <- currentPosition + 1 + + resultPosition @> diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index 52f1c21a..f310ca31 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -8,7 +8,7 @@ open GraphBLAS.FSharp.Objects.ClVectorExtensions module MatrixExtensions = // Matrix.Free - type ClMatrix.COO<'a when 'a : struct> with + type ClMatrix.COO<'a when 'a: struct> with member this.Free(q: MailboxProcessor<_>) = this.Columns.Free q this.Values.Free q @@ -27,7 +27,7 @@ module MatrixExtensions = result - type ClMatrix.CSR<'a when 'a : struct> with + type ClMatrix.CSR<'a when 'a: struct> with member this.Free(q: MailboxProcessor<_>) = this.Values.Free q this.Columns.Free q @@ -46,7 +46,7 @@ module MatrixExtensions = result - type ClMatrix.CSC<'a when 'a : struct> with + type ClMatrix.CSC<'a when 'a: struct> with member this.Free(q: MailboxProcessor<_>) = this.Values.Free q this.Rows.Free q @@ -65,10 +65,10 @@ module MatrixExtensions = result - type ClMatrix.LIL<'a when 'a : struct> with + type ClMatrix.LIL<'a when 'a: struct> with member this.Free(q: MailboxProcessor<_>) = - this.Rows - |> List.iter (Option.iter (fun row -> row.Dispose q)) + this.Rows + |> List.iter (Option.iter (fun row -> row.Dispose q)) member this.ToHost(q: MailboxProcessor<_>) = { RowCount = this.RowCount diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs index 753ccb70..78905478 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs @@ -36,7 +36,7 @@ let makeTest testFun (array: 'a [], value: 'a) = for i in 0 .. array.Length - 1 do let currentValue = array.[i] - if value < currentValue then + if value < currentValue then expected <- i array.Length - expected - 1 @@ -44,7 +44,7 @@ let makeTest testFun (array: 'a [], value: 'a) = "Results must be the same" |> Expect.equal actual expected -let createTest<'a when 'a : equality and 'a : comparison> = +let createTest<'a when 'a: equality and 'a: comparison> = ClArray.upperBound<'a> context Utils.defaultWorkGroupSize |> makeTest |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -53,7 +53,7 @@ let tests = [ createTest if Utils.isFloat64Available context.ClDevice then - createTest + createTest createTest createTest ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs index 1eec8ffb..413df587 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs @@ -27,7 +27,8 @@ let makeTest isZero testFun (array: 'a [,]) = let actual = clRows.ToHostAndFree processor - let expected = Matrix.COO.FromArray2D(array, isZero).Rows + let expected = + Matrix.COO.FromArray2D(array, isZero).Rows "Result must be the same" |> Expect.sequenceEqual actual expected @@ -41,7 +42,7 @@ let tests = [ createTest ((=) 0) if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) + createTest ((=) 0.0) createTest ((=) 0.0f) createTest ((=) false) ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index 10728508..03bf484c 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -21,19 +21,24 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue let config = - { Utils.defaultConfig with arbitrary = [ typeof ] } + { Utils.defaultConfig with + arbitrary = [ typeof ] } let getSegmentsPointers (leftMatrixColumns: int []) (rightRowsPointers: int []) = Array.map - (fun item -> rightRowsPointers.[item + 1] - rightRowsPointers.[item]) + (fun item -> + rightRowsPointers.[item + 1] + - rightRowsPointers.[item]) leftMatrixColumns |> HostPrimitives.prefixSumExclude 0 (+) let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - let leftMatrix = Matrix.CSR.FromArray2D(leftArray, isZero) + let leftMatrix = + Matrix.CSR.FromArray2D(leftArray, isZero) - let rightMatrix = Matrix.CSR.FromArray2D(rightArray, isZero) + let rightMatrix = + Matrix.CSR.FromArray2D(rightArray, isZero) if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then @@ -107,9 +112,11 @@ let expand length segmentPointers (leftMatrix: Matrix.COO<'a>) (rightMatrix: Mat // Expand tests (debug only) let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - let leftMatrix = Matrix.COO.FromArray2D(leftArray, isEqual zero) + let leftMatrix = + Matrix.COO.FromArray2D(leftArray, isEqual zero) - let rightMatrix = Matrix.CSR.FromArray2D(rightArray, isEqual zero) + let rightMatrix = + Matrix.CSR.FromArray2D(rightArray, isEqual zero) if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then @@ -174,6 +181,8 @@ let expandTests = let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = + printfn "run test" + let leftMatrix = Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) @@ -205,7 +214,11 @@ let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightAr let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = testFun opAddQ opMulQ context Utils.defaultWorkGroupSize |> makeGeneralTest zero isEqual opAdd opMul - |> testPropertyWithConfig { config with endSize = 1000; maxTest = 100 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig + { config with + endSize = 10000 + maxTest = 100 } + $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs index 363d48ad..e48a20e0 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs @@ -15,24 +15,28 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let config = { Utils.defaultConfig with arbitrary = [ typeof ] } +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } let makeTest isEqual zero testFun (array: 'a [,], sourceRow, count) = - let matrix = Matrix.CSR.FromArray2D(array, isEqual zero) + let matrix = + Matrix.CSR.FromArray2D(array, isEqual zero) if matrix.NNZ > 0 then let clMatrix = matrix.ToDevice context - let clActual: ClMatrix.COO<'a> = testFun processor HostInterop sourceRow count clMatrix + let clActual: ClMatrix.COO<'a> = + testFun processor HostInterop sourceRow count clMatrix let actual = clActual.ToHostAndFree processor let expected = array |> Array2D.mapi (fun rowIndex columnIndex value -> (value, rowIndex, columnIndex)) - |> fun array -> array.[sourceRow .. sourceRow + count - 1, *] + |> fun array -> array.[sourceRow..sourceRow + count - 1, *] |> Seq.cast<'a * int * int> |> Seq.filter (fun (value, _, _) -> (not <| isEqual zero value)) |> Seq.toArray @@ -42,7 +46,7 @@ let makeTest isEqual zero testFun (array: 'a [,], sourceRow, count) = ColumnCount = Array2D.length2 array Rows = rows Columns = columns - Values = values } + Values = values } Utils.compareCOOMatrix isEqual actual expected @@ -55,7 +59,7 @@ let tests = [ createTest (=) 0 if Utils.isFloat64Available context.ClDevice then - createTest (=) 0.0 + createTest (=) 0.0 createTest (=) 0.0f createTest (=) false ] diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 8c4d7623..34969380 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -228,7 +228,7 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen - type PairOfSparseMatricesWithCompatibleSizes() = // TODO to module Matrix + type PairOfSparseMatricesWithCompatibleSizes() = static let pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = gen { let! firstCount, secondCount, thirdCount = dimension3DGenerator @@ -1221,62 +1221,62 @@ module Generators = |> Arb.fromGen type UpperBound() = - static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = - gen { - let! size = Gen.sized <| fun size -> Gen.choose (1, size + 1) + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! size = Gen.sized <| fun size -> Gen.choose (1, size + 1) - let! array = Gen.arrayOfLength size valuesGenerator + let! array = Gen.arrayOfLength size valuesGenerator - let! valueIndex = Gen.choose (0, array.Length - 1) + let! valueIndex = Gen.choose (0, array.Length - 1) - let value = array.[valueIndex] + let value = array.[valueIndex] - return (array, value) - } + return (array, value) + } - static member IntType() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen - static member FloatType() = - arrayAndChunkPosition - <| (Arb.Default.NormalFloat() - |> Arb.toGen - |> Gen.map float) - |> Arb.fromGen + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen - static member Float32Type() = - arrayAndChunkPosition - <| (normalFloat32Generator <| System.Random()) - |> Arb.fromGen + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen - static member SByteType() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen - static member ByteType() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen - static member Int16Type() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen - static member UInt16Type() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen - static member Int32Type() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen - static member UInt32Type() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen - static member BoolType() = - arrayAndChunkPosition <| Arb.generate - |> Arb.fromGen + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen module Matrix = type Sub() = diff --git a/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs index a15bc37d..ad800dd8 100644 --- a/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs +++ b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs @@ -70,7 +70,7 @@ let makeTest isEqual zero createMatrix (array: 'a [,]) = let expectedColumns, expectedRows, expectedValues = array |> Array2D.mapi (fun rowIndex columnIndex value -> (columnIndex, rowIndex, value)) - |> Seq.cast + |> Seq.cast |> Seq.filter (fun (_, _, value) -> ((<<) not <| isEqual zero) value) |> Seq.toArray |> Array.unzip3 diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 1de9a5b9..80ff00b7 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -4,4 +4,7 @@ open GraphBLAS.FSharp.Tests [] -let main argv = Matrix.SpGeMM.Expand.generalTests |> testSequenced |> runTestsWithCLIArgs [] argv +let main argv = + Matrix.SpGeMM.Expand.generalTests + |> testSequenced + |> runTestsWithCLIArgs [] argv From 02fa1fffdd7a5b230d26fe876d01b86ae37c7a28 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 2 May 2023 23:41:02 +0300 Subject: [PATCH 121/143] add: MaxMemAllocSize --- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 4 ++-- src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs | 7 +++++++ .../GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs | 4 +--- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index db9dbc54..89a06558 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Vector +open GraphBLAS.FSharp.Backend.Objects.ClContext module Matrix = let copy (clContext: ClContext) workGroupSize = @@ -418,6 +419,5 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> match leftMatrix, rightMatrix with | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> - // TODO(max alloc size) - run processor allocationMode 1000 leftMatrix rightMatrix + run processor allocationMode (clContext.MaxMemAllocSize / 10) leftMatrix rightMatrix | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs index 650a423e..320e14a1 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs @@ -41,3 +41,10 @@ module ClContext = hostAccessMode = HostAccessMode.ReadWrite, allocationMode = AllocationMode.CopyHostPtr ) + + member this.MaxMemAllocSize = + let error = ref Unchecked.defaultof + + Cl + .GetDeviceInfo(this.ClDevice.Device, OpenCL.Net.DeviceInfo.MaxMemAllocSize, error) + .CastTo() diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index 03bf484c..a1faf1b3 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -215,9 +215,7 @@ let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun testFun opAddQ opMulQ context Utils.defaultWorkGroupSize |> makeGeneralTest zero isEqual opAdd opMul |> testPropertyWithConfig - { config with - endSize = 10000 - maxTest = 100 } + { config with endSize = 100; maxTest = 10 } $"test on %A{typeof<'a>}" let generalTests = From 9662efe811447e94bf07daeb5bc046dd9883b1f8 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 2 May 2023 23:56:27 +0300 Subject: [PATCH 122/143] refactor: release in spgemm --- .../Matrix/SpGeMM/Expand.fs | 25 +++++++++++-------- .../Backend/Matrix/SpGeMM/Expand.fs | 6 +---- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 1dfb7de3..e8455cf7 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -77,6 +77,8 @@ module Expand = assignValues processor firstValues secondValues positions resultValues + positions.Free processor + Some(resultValues, resultColumns, resultRows) let expand (clContext: ClContext) workGroupSize = @@ -238,8 +240,7 @@ module Expand = offsets.Free processor - // reducedValues, reducedColumns, reducedRows - + // reducedValues, reducedColumns, reducedRows option reduceResult let runCOO opAdd opMul (clContext: ClContext) workGroupSize = @@ -270,6 +271,8 @@ module Expand = let leftMatrixValues, rightMatrixValues, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix + segmentPointers.Free processor + // multiply let mulResult = multiply processor leftMatrixValues rightMatrixValues columns rows @@ -294,15 +297,11 @@ module Expand = let reduceResult = reduce processor allocationMode sortedValues sortedColumns sortedRows - reduceResult - |> Option.map - (fun (reducedValues, reducedColumns, reducedRows) -> - - sortedValues.Free processor - sortedColumns.Free processor - sortedRows.Free processor + sortedValues.Free processor + sortedColumns.Free processor + sortedRows.Free processor - reducedValues, reducedColumns, reducedRows)) + reduceResult) let runOneStep opAdd opMul (clContext: ClContext) workGroupSize = @@ -398,7 +397,6 @@ module Expand = let result = helper 0 0 [] |> List.rev segmentPointersByLeftMatrixRows.Free processor - rightMatrixRowsNNZ.Free processor result @@ -429,6 +427,8 @@ module Expand = getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ if length < maxAllocSize then + segmentLengths.Free processor + runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix else let result = @@ -441,6 +441,9 @@ module Expand = rightMatrixRowsNNZ rightMatrix + rightMatrixRowsNNZ.Free processor + segmentLengths.Free processor + match result with | _ :: _ -> let valuesList, columnsList, rowsList = result |> List.unzip3 diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index a1faf1b3..67eac9d3 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -181,8 +181,6 @@ let expandTests = let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = - printfn "run test" - let leftMatrix = Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) @@ -214,9 +212,7 @@ let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightAr let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = testFun opAddQ opMulQ context Utils.defaultWorkGroupSize |> makeGeneralTest zero isEqual opAdd opMul - |> testPropertyWithConfig - { config with endSize = 100; maxTest = 10 } - $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand From 7e58687268b927e0c4ca14625255ce4b218add93 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 3 May 2023 00:27:14 +0300 Subject: [PATCH 123/143] add: maxAllocSize assert --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 3 +++ src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs | 3 +++ 2 files changed, 6 insertions(+) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index fa8a8997..cdbc8ee8 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -613,6 +613,9 @@ module ClArray = sourceArrays |> Seq.sumBy (fun array -> array.Length) + if resultLength >= clContext.MaxMemAllocSize then + failwith "It is impossible to allocate more than MaxAllocSize" + let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index e8455cf7..4ea97a38 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -111,6 +111,8 @@ module Expand = fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + assert (lengths < clContext.MaxMemAllocSize) + // Compute left matrix positions let leftMatrixPositions = zeroCreate processor DeviceOnly lengths @@ -456,6 +458,7 @@ module Expand = let rows = concat processor allocationMode rowsList + // TODO(overhead: compute result length 3 time) // release resources valuesList |> List.iter (fun array -> array.Free processor) From bae988eb483bdc50f77f41515a2dfa5e6308daf0 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 3 May 2023 15:10:42 +0300 Subject: [PATCH 124/143] add: measure maxAllocSize --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 3 --- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 11 ++++++++++- src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs | 5 +---- .../Objects/ClContextExtensions.fs | 1 + .../GraphBLAS-sharp.Tests.fsproj | 6 +++--- 5 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index cdbc8ee8..fa8a8997 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -613,9 +613,6 @@ module ClArray = sourceArrays |> Seq.sumBy (fun array -> array.Length) - if resultLength >= clContext.MaxMemAllocSize then - failwith "It is impossible to allocate more than MaxAllocSize" - let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 89a06558..4c23531e 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -419,5 +419,14 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> match leftMatrix, rightMatrix with | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> - run processor allocationMode (clContext.MaxMemAllocSize / 10) leftMatrix rightMatrix + let allocCapacity = + List.max [ sizeof<'a> + sizeof<'c> + sizeof<'b> ] + * 1 + + let resultCapacity = + (clContext.MaxMemAllocSize / allocCapacity) / 3 + + run processor allocationMode resultCapacity leftMatrix rightMatrix | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 4ea97a38..a43e862c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -109,10 +109,7 @@ module Expand = let rightMatrixGather = Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - - assert (lengths < clContext.MaxMemAllocSize) - + fun (processor: MailboxProcessor<_>) (lengths: int) (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute left matrix positions let leftMatrixPositions = zeroCreate processor DeviceOnly lengths diff --git a/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs index 320e14a1..bd5c8a3a 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ClContextExtensions.fs @@ -48,3 +48,4 @@ module ClContext = Cl .GetDeviceInfo(this.ClDevice.Device, OpenCL.Net.DeviceInfo.MaxMemAllocSize, error) .CastTo() + * 1 diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index c9379b9d..c0cb07dc 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -29,7 +29,7 @@ - + @@ -49,8 +49,8 @@ - - + + From 2ddbe377bd298c875aafe813dff42184881bcd67 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 3 May 2023 15:52:17 +0300 Subject: [PATCH 125/143] refactor: tests --- .../Matrix/SpGeMM/Expand.fs | 28 +++-- tests/GraphBLAS-sharp.Tests/Program.fs | 111 +++++++++++++++++- 2 files changed, 122 insertions(+), 17 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs index 9376873d..0a7193e7 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -30,7 +30,7 @@ type Benchmarks<'elem when 'elem : struct>( let mutable firstMatrixHost = Unchecked.defaultof<_> let mutable secondMatrixHost = Unchecked.defaultof<_> - member val ResultMatrix = Unchecked.defaultof> with get, set + member val ResultMatrix = Unchecked.defaultof option> with get, set [] member val OclContextInfo = Unchecked.defaultof with get, set @@ -85,7 +85,9 @@ type Benchmarks<'elem when 'elem : struct>( secondMatrix.Dispose this.Processor member this.ClearResult() = - this.ResultMatrix.Dispose this.Processor + match this.ResultMatrix with + | Some matrix -> matrix.Dispose this.Processor + | None -> () member this.ReadMatrices() = firstMatrixHost <- this.ReadMatrix this.InputMatrixReader @@ -134,14 +136,14 @@ module WithoutTransfer = override this.GlobalCleanup () = this.ClearInputMatrices() - // type Float32() = - // - // inherit Benchmark( - // Matrix.SpGeMM.expand (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), - // float32, - // (fun _ -> Utils.nextSingle (System.Random())), - // (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) - // ) - // - // static member InputMatrixProvider = - // Benchmarks<_>.InputMatrixProviderBuilder "SpGeMM.txt" + type Float32() = + + inherit Benchmark( + Matrix.SpGeMM.expand (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) + ) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "SpGeMM.txt" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 80ff00b7..0e5a065a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,9 +2,112 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests +let matrixTests = + testList + "Matrix" + [ Matrix.Convert.tests + Matrix.Map2.allTests + Matrix.Map.allTests + Matrix.Merge.allTests + Matrix.Transpose.tests + Matrix.RowsLengths.tests + Matrix.ByRows.tests + Matrix.ExpandRows.tests + Matrix.SubRows.tests -[] -let main argv = - Matrix.SpGeMM.Expand.generalTests + Matrix.SpGeMM.Expand.generalTests + Matrix.SpGeMM.Masked.tests ] + |> testSequenced + +let commonTests = + let scanTests = + testList + "Scan" + [ Common.Scan.ByKey.sequentialSegmentsTests + Common.Scan.PrefixSum.tests ] + + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.allTests + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] + + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.allTests + Common.ClArray.ChunkBySize.allTests + Common.ClArray.Blit.tests + Common.ClArray.Concat.tests + Common.ClArray.Fill.tests + Common.ClArray.Pairwise.tests + Common.ClArray.UpperBound.tests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.allTests ] + + testList + "Common" + [ Common.Scatter.allTests + Common.Gather.allTests + Common.Merge.tests + clArrayTests + sortTests + reduceTests + scanTests ] |> testSequenced - |> runTestsWithCLIArgs [] argv + +let vectorTests = + testList + "Vector" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.allTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests + Vector.Merge.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced + +let deviceTests = + testList + "Device" + [ matrixTests + commonTests + vectorTests + algorithmsTests ] + |> testSequenced + +let hostTests = + testList + "Host" + [ Host.Matrix.FromArray2D.tests + Host.Matrix.Convert.tests + Host.IO.MtxReader.test ] + |> testSequenced + +[] +let allTests = + testList "All" [ deviceTests; hostTests ] + |> testSequenced + +[] +let main argv = allTests |> runTestsWithCLIArgs [] argv From 35e5e29063f70de1e25a9c32542c37e63c4b369c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 4 May 2023 21:53:18 +0300 Subject: [PATCH 126/143] add: ClArray.set, ClArray.item --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 56 +++++++++ .../Backend/Common/ClArray/Item.fs | 46 +++++++ .../Backend/Common/ClArray/Set.fs | 44 +++++++ tests/GraphBLAS-sharp.Tests/Generators.fs | 115 ++++++++++++++++++ .../GraphBLAS-sharp.Tests.fsproj | 2 + tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- 6 files changed, 266 insertions(+), 1 deletion(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index fa8a8997..37e2860a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -732,3 +732,59 @@ module ClArray = let upperBound<'a when 'a: comparison> clContext = bound<'a, int> Search.Bin.lowerBound clContext + + let item<'a> (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) index (array: ClArray<'a>) (result: ClCell<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + result.Value <- array.[index] @> + + let program = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (index: int) (array: ClArray<'a>) -> + + if index < 0 || index >= array.Length then + failwith "Index out of range" + + let result = + clContext.CreateClCell Unchecked.defaultof<'a> + + let kernel = program.GetKernel() + + let ndRange = Range1D.CreateValid(1, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange index array result)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + result + + let set<'a> (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) index (array: ClArray<'a>) (value: ClCell<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + array.[index] <- value.Value @> + + let program = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) (index: int) (value: 'a) -> + + if index < 0 || index >= array.Length then + failwith "Index out of range" + + let value = + clContext.CreateClCell value + + let kernel = program.GetKernel() + + let ndRange = Range1D.CreateValid(1, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange index array value)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs new file mode 100644 index 00000000..cbacfd9f --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs @@ -0,0 +1,46 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Item + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = { Utils.defaultConfig with arbitrary = [ typeof ] } + +let makeTest<'a when 'a: equality> testFun (array: 'a [], position) = + + if array.Length > 0 then + + let clArray = context.CreateClArray array + + let result: ClCell<'a> = testFun processor position clArray + + clArray.Free processor + let actual = result.ToHost processor + + let expected = Array.item position array + + "Results must be the same" + |> Expect.equal actual expected + +let createTest<'a when 'a: equality> = + ClArray.item context Utils.defaultWorkGroupSize + |> makeTest<'a> + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest + + if Utils.isFloat64Available context.ClDevice then + createTest + + createTest + createTest ] + |> testList "Item" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs new file mode 100644 index 00000000..48055e2f --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs @@ -0,0 +1,44 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Set + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = { Utils.defaultConfig with arbitrary = [typeof]} + +let makeTest<'a when 'a : equality> testFun (array: 'a [], position, value: 'a) = + + if array.Length > 0 then + + let clArray = context.CreateClArray array + + testFun processor clArray position value + + let actual = clArray.ToHostAndFree processor + Array.set array position value + + "Results must be the same" + |> Utils.compareArrays (=) actual array + +let createTest<'a when 'a : equality> = + ClArray.set context Utils.defaultWorkGroupSize + |> makeTest<'a> + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest + + if Utils.isFloat64Available context.ClDevice then + createTest + + createTest + createTest ] + |> testList "Set" + diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 34969380..a3ca983e 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -1278,6 +1278,121 @@ module Generators = arrayAndChunkPosition <| Arb.generate |> Arb.fromGen + module ClArray = + type Set() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! size = Gen.sized <| fun size -> Gen.choose (1, size + 1) + + let! array = Gen.arrayOfLength size valuesGenerator + + let! position = Gen.choose (0, array.Length - 1) + + let! value = valuesGenerator + + return (array, position, value) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + type Item() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! size = Gen.sized <| fun size -> Gen.choose (1, size + 1) + + let! array = Gen.arrayOfLength size valuesGenerator + + let! position = Gen.choose (0, array.Length - 1) + + return (array, position) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + module Matrix = type Sub() = static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index c0cb07dc..46ecc5ad 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -30,6 +30,8 @@ + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 0e5a065a..f6359ee4 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -49,7 +49,9 @@ let commonTests = Common.ClArray.Concat.tests Common.ClArray.Fill.tests Common.ClArray.Pairwise.tests - Common.ClArray.UpperBound.tests ] + Common.ClArray.UpperBound.tests + Common.ClArray.Set.tests + Common.ClArray.Item.tests ] let sortTests = testList From 627e8c5f586608cf599a189fcef60f48d04af801 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 4 May 2023 22:03:17 +0300 Subject: [PATCH 127/143] fix: SpGeMM, last item in pointers --- src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index a43e862c..97b59bc0 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -345,19 +345,24 @@ module Expand = let upperBound = ClArray.upperBoundAndValue clContext workGroupSize + let set = ClArray.set clContext workGroupSize + let subMatrix = CSR.Matrix.subRows clContext workGroupSize let runCOO = runCOO opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> // extract segment lengths by left matrix rows pointers let segmentPointersByLeftMatrixRows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) gather processor leftMatrix.RowPointers segmentLengths segmentPointersByLeftMatrixRows + // set last element to one step length + set processor segmentPointersByLeftMatrixRows (leftMatrix.RowPointers.Length - 1) generalLength + // curring let upperBound = upperBound processor segmentPointersByLeftMatrixRows @@ -422,10 +427,10 @@ module Expand = let rightMatrixRowsNNZ = getNNZInRows processor DeviceOnly rightMatrix - let length, segmentLengths = + let generalLength, segmentLengths = getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ - if length < maxAllocSize then + if generalLength < maxAllocSize then segmentLengths.Free processor runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix @@ -435,6 +440,7 @@ module Expand = processor allocationMode maxAllocSize + generalLength leftMatrix segmentLengths rightMatrixRowsNNZ From 06be7e7bc2558297806e5790258cb909728a376c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 4 May 2023 22:07:51 +0300 Subject: [PATCH 128/143] refactor: Naming, Generators --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 3 +-- .../Backend/Common/ClArray/Item.fs | 6 ++++-- .../Backend/Common/ClArray/Set.fs | 11 ++++++----- tests/GraphBLAS-sharp.Tests/Generators.fs | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 2 +- .../Host/Matrix/{FromaArray2D.fs => FromArray2D.fs} | 0 6 files changed, 13 insertions(+), 11 deletions(-) rename tests/GraphBLAS-sharp.Tests/Host/Matrix/{FromaArray2D.fs => FromArray2D.fs} (100%) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 37e2860a..33a378a3 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -779,8 +779,7 @@ module ClArray = if index < 0 || index >= array.Length then failwith "Index out of range" - let value = - clContext.CreateClCell value + let value = clContext.CreateClCell value let kernel = program.GetKernel() diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs index cbacfd9f..352f2517 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs @@ -12,7 +12,9 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let config = { Utils.defaultConfig with arbitrary = [ typeof ] } +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } let makeTest<'a when 'a: equality> testFun (array: 'a [], position) = @@ -39,7 +41,7 @@ let tests = [ createTest if Utils.isFloat64Available context.ClDevice then - createTest + createTest createTest createTest ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs index 48055e2f..a393b499 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs @@ -11,9 +11,11 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let config = { Utils.defaultConfig with arbitrary = [typeof]} +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } -let makeTest<'a when 'a : equality> testFun (array: 'a [], position, value: 'a) = +let makeTest<'a when 'a: equality> testFun (array: 'a [], position, value: 'a) = if array.Length > 0 then @@ -27,7 +29,7 @@ let makeTest<'a when 'a : equality> testFun (array: 'a [], position, value: 'a) "Results must be the same" |> Utils.compareArrays (=) actual array -let createTest<'a when 'a : equality> = +let createTest<'a when 'a: equality> = ClArray.set context Utils.defaultWorkGroupSize |> makeTest<'a> |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -36,9 +38,8 @@ let tests = [ createTest if Utils.isFloat64Available context.ClDevice then - createTest + createTest createTest createTest ] |> testList "Set" - diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index a3ca983e..5f4c2cbb 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -37,7 +37,7 @@ module Generators = let genericSparseGenerator zero valuesGen handler = let maxSparsity = 100 - let sparsityGen = Gen.choose (1, 10) + let sparsityGen = Gen.choose (1, maxSparsity) let genWithSparsity sparseValuesGenProvider = gen { diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 46ecc5ad..c3f81416 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -62,7 +62,7 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromArray2D.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs rename to tests/GraphBLAS-sharp.Tests/Host/Matrix/FromArray2D.fs From 9482cab56e42c88c82eb94f7791bae6e83f77f1f Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 5 May 2023 00:13:02 +0300 Subject: [PATCH 129/143] fix: allocSize compute in spgemm --- .../Matrix/SpGeMM/Expand.fs | 55 +++++++++++-------- 1 file changed, 32 insertions(+), 23 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index 97b59bc0..d2ec690c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -264,7 +264,7 @@ module Expand = if length = 0 then segmentPointers.Free processor - None + length, None else // expand let leftMatrixValues, rightMatrixValues, columns, rows = @@ -281,26 +281,28 @@ module Expand = columns.Free processor rows.Free processor - mulResult - |> Option.bind - (fun (resultValues, resultColumns, resultRows) -> - // sort - let sortedValues, sortedColumns, sortedRows = - sort processor resultValues resultColumns resultRows + let result = + mulResult + |> Option.bind + (fun (resultValues, resultColumns, resultRows) -> + // sort + let sortedValues, sortedColumns, sortedRows = + sort processor resultValues resultColumns resultRows - resultValues.Free processor - resultColumns.Free processor - resultRows.Free processor + resultValues.Free processor + resultColumns.Free processor + resultRows.Free processor - // addition - let reduceResult = - reduce processor allocationMode sortedValues sortedColumns sortedRows + // addition + let reduceResult = + reduce processor allocationMode sortedValues sortedColumns sortedRows - sortedValues.Free processor - sortedColumns.Free processor - sortedRows.Free processor + sortedValues.Free processor + sortedColumns.Free processor + sortedRows.Free processor - reduceResult) + reduceResult) + length, result let runOneStep opAdd opMul (clContext: ClContext) workGroupSize = @@ -323,7 +325,7 @@ module Expand = Columns = leftMatrix.Columns Values = leftMatrix.Values } - let result = + let _, result = runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix leftMatrixCOO rows.Free processor @@ -343,7 +345,7 @@ module Expand = let gather = Gather.run clContext workGroupSize let upperBound = - ClArray.upperBoundAndValue clContext workGroupSize + ClArray.upperBound clContext workGroupSize let set = ClArray.set clContext workGroupSize @@ -378,9 +380,13 @@ module Expand = clContext.CreateClCell(workOffset + maxAllocSize: int) // find largest row that fit into maxAllocSize - let endRow, value = + let upperBound = (upperBound currentBound).ToHostAndFree processor + let endRow = upperBound - 2 + + currentBound.Free processor + // TODO(handle largest rows) // (we can split row, multiply and merge them but merge path needed) if endRow = beginRow then @@ -389,12 +395,15 @@ module Expand = // extract matrix TODO(Transfer overhead) let subMatrix = subMatrix beginRow (endRow - beginRow) leftMatrix + // compute sub result - let result = runCOO subMatrix + let length, result = runCOO subMatrix + // increase workOffset according to previous expand + let workOffset = workOffset + length match result with - | Some result -> helper endRow value <| result :: previousResult - | None -> helper endRow value previousResult + | Some result -> helper endRow workOffset <| result :: previousResult + | None -> helper endRow workOffset previousResult else previousResult From e647418371c41e9d7e233b04af84ddf5b951f81f Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 5 May 2023 00:13:54 +0300 Subject: [PATCH 130/143] refactor: formatting --- src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs index d2ec690c..92eba752 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -302,6 +302,7 @@ module Expand = sortedRows.Free processor reduceResult) + length, result let runOneStep opAdd opMul (clContext: ClContext) workGroupSize = @@ -402,7 +403,9 @@ module Expand = let workOffset = workOffset + length match result with - | Some result -> helper endRow workOffset <| result :: previousResult + | Some result -> + helper endRow workOffset + <| result :: previousResult | None -> helper endRow workOffset previousResult else previousResult From e52847cfc8e24a8f0bf13a41dcbb84f6c95b48db Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 5 May 2023 14:45:00 +0300 Subject: [PATCH 131/143] refactor: sparsity generators --- tests/GraphBLAS-sharp.Tests/Generators.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 5f4c2cbb..38d3e388 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -36,7 +36,8 @@ module Generators = } let genericSparseGenerator zero valuesGen handler = - let maxSparsity = 100 + let maxSparsity = 10 + let upperBound = 100 let sparsityGen = Gen.choose (1, maxSparsity) let genWithSparsity sparseValuesGenProvider = @@ -55,7 +56,7 @@ module Generators = genWithSparsity <| fun sparsity -> [ (sparsity, valuesGen) - (maxSparsity - sparsity, Gen.constant zero) ] + (upperBound - sparsity, Gen.constant zero) ] |> Gen.frequency |> handler From 32b27ba66c60e5328670e4e78e677ae392679941 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Tue, 9 May 2023 16:49:58 +0300 Subject: [PATCH 132/143] add: allocation first kronecker --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 30 ++ .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Matrix/CSR/Kronecker.fs | 488 ++++++++++++++++++ src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs | 111 +++- .../Matrix/CSR/Matrix.fs | 41 ++ src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 40 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 11 + .../Quotes/Arithmetic.fs | 56 +- .../Backend/Matrix/Kronecker.fs | 104 ++++ .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 15 + tests/GraphBLAS-sharp.Tests/Program.fs | 209 ++++---- 12 files changed, 998 insertions(+), 109 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 33a378a3..5f98d708 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -160,6 +160,36 @@ module ClArray = result + let mapWithValue<'a, 'b, 'c> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c>) = + + let map = + <@ fun (ndRange: Range1D) lenght (value: ClCell<'a>) (inputArray: ClArray<'b>) (result: ClArray<'c>) -> + + let gid = ndRange.GlobalID0 + + if gid < lenght then + result.[gid] <- (%op) value.Value inputArray.[gid] @> + + let kernel = clContext.Compile map + + fun (processor: MailboxProcessor<_>) allocationMode (value: ClCell<'a>) (inputArray: ClArray<'b>) -> + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + + let ndRange = + Range1D.CreateValid(inputArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length value inputArray result) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + result + let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = let kernel = diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 82e534fc..50b5339b 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -54,6 +54,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs new file mode 100644 index 00000000..af081803 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs @@ -0,0 +1,488 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.CSR + +open FSharp.Quotations.Evaluator +open Microsoft.FSharp.Quotations +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Matrix.COO +open GraphBLAS.FSharp.Backend.Matrix.CSR +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +module internal Kronecker = + let private getBitmap (clContext: ClContext) workGroupSize op = + + let getBitmap (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) (prevSum: ClCell) (operand: ClCell<'a>) valuesLength numberOfZeros (values: ClArray<'b>) (resultBitmap: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + + match (%op) (Some operand.Value) None with + | Some _ -> resultBitmap.[0] <- prevSum.Value + numberOfZeros + | _ -> resultBitmap.[0] <- prevSum.Value + + else if (gid - 1) < valuesLength then + + match (%op) (Some operand.Value) (Some values.[gid - 1]) with + | Some _ -> resultBitmap.[gid] <- 1 + | _ -> resultBitmap.[gid] <- 0 @> + + let getBitmap = clContext.Compile <| getBitmap op + + fun (processor: MailboxProcessor<_>) (prevSum: ClCell) (operand: ClCell<'a>) (matrixRight: ClMatrix.CSR<'b>) (bitmap: ClArray) -> + + let resultLength = matrixRight.NNZ + 1 + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let getBitmap = getBitmap.GetKernel() + + let numberOfZeros = + matrixRight.ColumnCount * matrixRight.RowCount - matrixRight.NNZ + + processor.Post( + Msg.MsgSetArguments + (fun () -> + getBitmap.KernelFunc + ndRange + prevSum + operand + matrixRight.NNZ + numberOfZeros + matrixRight.Values + bitmap) + ) + + processor.Post(Msg.CreateRunMsg<_, _> getBitmap) + + let private getAllocationSize (clContext: ClContext) workGroupSize op = + + let getBitmap = getBitmap clContext workGroupSize op + + let sum = + Reduce.sum <@ fun x y -> x + y @> 0 clContext workGroupSize + + let item = ClArray.item clContext workGroupSize + + let opOnHost = QuotationEvaluator.Evaluate op + + fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + + let nnz = + match opOnHost None None with + | Some _ -> + let leftZeroCount = + matrixLeft.RowCount * matrixLeft.ColumnCount + - matrixLeft.NNZ + + let rightZeroCount = + matrixRight.RowCount * matrixRight.ColumnCount + - matrixRight.NNZ + + leftZeroCount * rightZeroCount + | _ -> 0 + |> clContext.CreateClCell + + let bitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, matrixRight.NNZ + 1) + + let nnz = + { 0 .. matrixLeft.NNZ - 1 } + |> Seq.fold + (fun acc index -> + let value = item queue index matrixLeft.Values + + getBitmap queue acc value matrixRight bitmap + + let nnz = sum queue bitmap + + acc.Free queue + value.Free queue + + nnz) + nnz + + nnz.ToHostAndFree queue + + let private preparePositions<'a, 'b, 'c when 'b: struct> (clContext: ClContext) workGroupSize op = + + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) (operand: ClCell<'a>) rowCount columnCount (values: ClArray<'b>) (rowPointers: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) -> + + let gid = ndRange.GlobalID0 + + if gid < rowCount * columnCount then + + let columnIndex = gid % columnCount + let rowIndex = gid / columnCount + + let firstIndex = rowPointers.[rowIndex] + let lastIndex = rowPointers.[rowIndex + 1] - 1 + + let value = + (%Search.Bin.inRange) firstIndex lastIndex columnIndex columns values + + match (%op) (Some operand.Value) value with + | Some resultValue -> + resultValues.[gid] <- resultValue + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> + + let kernel = clContext.Compile <| preparePositions op + + fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrix: ClMatrix.CSR<'b>) (resultDenseMatrix: ClArray<'c>) (resultBitmap: ClArray) -> + + let resultLength = matrix.RowCount * matrix.ColumnCount + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + operand + matrix.RowCount + matrix.ColumnCount + matrix.Values + matrix.RowPointers + matrix.Columns + resultBitmap + resultDenseMatrix) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + let setPositions<'c when 'c: struct> (clContext: ClContext) workGroupSize = + + let setPositions = + <@ fun (ndRange: Range1D) rowCount columnCount (nnz: ClCell) (rowOffset: ClCell) (columnOffset: ClCell) (startIndex: ClCell) (bitmap: ClArray) (values: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) (resultValues: ClArray<'c>) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + nnz.Value <- nnz.Value + startIndex.Value + + if gid < rowCount * columnCount + && (gid = 0 && bitmap.[gid] = 1 + || gid > 0 && bitmap.[gid - 1] < bitmap.[gid]) then + + let columnIndex = gid % columnCount + let rowIndex = gid / columnCount + + let index = startIndex.Value + bitmap.[gid] - 1 + + resultRows.[index] <- rowIndex + rowOffset.Value + resultColumns.[index] <- columnIndex + columnOffset.Value + resultValues.[index] <- values.[gid] @> + + let kernel = clContext.Compile <| setPositions + + let scan = + PrefixSum.standardIncludeInPlace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) rowCount columnCount (rowOffset: int) (columnOffset: int) (startIndex: ClCell) (resultMatrix: COO<'c>) (values: ClArray<'c>) (bitmap: ClArray) -> + + let sum = scan processor bitmap + + let ndRange = + Range1D.CreateValid(rowCount * columnCount, workGroupSize) + + let kernel = kernel.GetKernel() + + let rowOffset = rowOffset |> clContext.CreateClCell + let columnOffset = columnOffset |> clContext.CreateClCell + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + rowCount + columnCount + sum + rowOffset + columnOffset + startIndex + bitmap + values + resultMatrix.Rows + resultMatrix.Columns + resultMatrix.Values) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + let copyToResult (clContext: ClContext) workGroupSize = + + let copyToResult = + <@ fun (ndRange: Range1D) startIndex sourceLength (rowOffset: ClCell) (columnOffset: ClCell) (sourceRows: ClArray) (sourceColumns: ClArray) (sourceValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) (resultValues: ClArray<'c>) -> + + let gid = ndRange.GlobalID0 + + if gid < sourceLength then + let index = startIndex + gid + + resultRows.[index] <- rowOffset.Value + sourceRows.[gid] + resultColumns.[index] <- columnOffset.Value + sourceColumns.[gid] + resultValues.[index] <- sourceValues.[gid] @> + + let kernel = clContext.Compile <| copyToResult + + fun (processor: MailboxProcessor<_>) startIndex (rowOffset: int) (columnOffset: int) (resultMatrix: COO<'c>) (sourceMatrix: COO<'c>) -> + + let ndRange = Range1D.CreateValid(sourceMatrix.NNZ, workGroupSize) + + let kernel = kernel.GetKernel() + + let rowOffset = rowOffset |> clContext.CreateClCell + let columnOffset = columnOffset |> clContext.CreateClCell + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + startIndex + sourceMatrix.NNZ + rowOffset + columnOffset + resultMatrix.Rows + resultMatrix.Columns + resultMatrix.Values + sourceMatrix.Rows + sourceMatrix.Columns + sourceMatrix.Values) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + let insertZero (clContext: ClContext) workGroupSize = + + let copy = copyToResult clContext workGroupSize + + fun queue (startIndex: int) (zeroCounts: int list array) (matrixZero: COO<'c>) (matrixRight: CSR<'b>) resultMatrix -> + + let rowCount = zeroCounts.Length + + let mutable startIndex = startIndex + + let insertMany row firstColumn count = + let rec insertManyRec iter = + if iter >= count then + () + else + let rowOffset = row * matrixRight.RowCount + + let columnOffset = + (firstColumn + iter) * matrixRight.ColumnCount + + copy queue startIndex rowOffset columnOffset resultMatrix matrixZero + + startIndex <- startIndex + matrixZero.NNZ + + insertManyRec (iter + 1) + + insertManyRec 0 + + let rec insertInRowRec zeroCounts row column = + match zeroCounts with + | [] -> () + | h :: tl -> + insertMany row column h + + insertInRowRec tl row (h + column + 1) + + let rec insertZeroRec row = + if row >= rowCount then + () + else + insertInRowRec zeroCounts.[row] row 0 + + insertZeroRec (row + 1) + + insertZeroRec 0 + + let insertNonZero (clContext: ClContext) workGroupSize op = + + let item = ClArray.item clContext workGroupSize + + let preparePositions = + preparePositions clContext workGroupSize op + + let setPositions = setPositions clContext workGroupSize + + fun queue (rowsEdges: (int * int) array) (matrixRight: CSR<'b>) (leftValues: ClArray<'a>) (leftColsHost: int array) (resultMatrix: COO<'c>) -> + + let setPositions = + setPositions queue matrixRight.RowCount matrixRight.ColumnCount + + let rowCount = rowsEdges.Length + + let length = + matrixRight.RowCount * matrixRight.ColumnCount + + let bitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + let mappedMatrix = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) + + let startIndex = clContext.CreateClCell 0 + + let rec insertInRowRec row rightEdge index = + if index > rightEdge then + () + else + let value = item queue index leftValues + let column = leftColsHost.[index] + + let rowOffset = row * matrixRight.RowCount + let columnOffset = column * matrixRight.ColumnCount + + preparePositions queue value matrixRight mappedMatrix bitmap + + value.Free queue + + setPositions rowOffset columnOffset startIndex resultMatrix mappedMatrix bitmap + + insertInRowRec row rightEdge (index + 1) + + let rec insertNonZeroRec row = + if row >= rowCount then + () + else + let leftEdge, rightEdge = rowsEdges.[row] + + insertInRowRec row rightEdge leftEdge + + insertNonZeroRec (row + 1) + + insertNonZeroRec 0 + + bitmap.Free queue + mappedMatrix.Free queue + + startIndex + + let mapAll<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + workGroupSize + (op: Expr<'a option -> 'b option -> 'c option>) + = + + let insertNonZero = insertNonZero clContext workGroupSize op + + let insertZero = insertZero clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (resultNNZ: int) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> + + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultNNZ) + + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultNNZ) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(allocationMode, resultNNZ) + + let resultMatrix = + { Context = clContext + Rows = resultRows + Columns = resultColumns + Values = resultValues + RowCount = matrixLeft.RowCount * matrixRight.RowCount + ColumnCount = matrixLeft.ColumnCount * matrixRight.ColumnCount } + + let leftRowPointers = matrixLeft.RowPointers.ToHost queue + let leftColumns = matrixLeft.Columns.ToHost queue + + let nnzInRows = + leftRowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let rowsEdges = + leftRowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> (fst, snd - 1)) + + let (zeroCounts: int list array) = Array.zeroCreate matrixLeft.RowCount + + { 0 .. matrixLeft.RowCount - 1 } + |> Seq.iter2 + (fun edges i -> + zeroCounts.[i] <- + leftColumns.[fst edges..snd edges] + |> Array.toList + |> List.insertAt 0 -1 + |> List.insertAt (nnzInRows.[i] + 1) matrixLeft.ColumnCount + |> List.pairwise + |> List.map (fun (fstCol, sndCol) -> sndCol - fstCol - 1)) + rowsEdges + + let startIndex = + insertNonZero queue rowsEdges matrixRight matrixLeft.Values leftColumns resultMatrix + + let startIndex = startIndex.ToHostAndFree queue + + match matrixZero with + | Some m -> + insertZero queue startIndex zeroCounts m matrixRight resultMatrix + m.Dispose queue + | _ -> () + + resultMatrix + + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + workGroupSize + (op: Expr<'a option -> 'b option -> 'c option>) + = + + let getSize = + getAllocationSize clContext workGroupSize op + + let mapWithValue = + Map.WithValue.run clContext op workGroupSize + + let mapAll = mapAll clContext workGroupSize op + + let bitonic = + Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + + let matrixZero = + mapWithValue queue allocationMode None matrixRight + + let size = getSize queue matrixLeft matrixRight + + let leftZeroCount = + matrixLeft.ColumnCount * matrixLeft.RowCount + - matrixLeft.NNZ + + let size = + match matrixZero with + | Some m -> size + m.NNZ * leftZeroCount + | _ -> size + + if size = 0 then + None + else + let result = + mapAll queue allocationMode size matrixZero matrixLeft matrixRight + + bitonic queue result.Rows result.Columns result.Values + + result |> Some diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 0ca4148f..2705553d 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -5,8 +5,8 @@ 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.ClCell open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext @@ -112,3 +112,112 @@ module internal Map = Rows = resultRows Columns = resultColumns Values = resultValues } + + module WithValue = + let preparePositions<'a, 'b, 'c when 'b: struct> (clContext: ClContext) workGroupSize op = + + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) (operand: ClCell<'a option>) rowCount columnCount (values: ClArray<'b>) (rowPointers: ClArray) (columns: 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 startIndex = rowPointers.[rowIndex] + let lastIndex = rowPointers.[rowIndex + 1] - 1 + + let value = + (%Search.Bin.inRange) startIndex lastIndex columnIndex columns values + + match (%op) operand.Value 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<_>) (operand: ClCell<'a option>) (matrix: ClMatrix.CSR<'b>) -> + + let resultLength = matrix.RowCount * matrix.ColumnCount + + 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 + operand + matrix.RowCount + matrix.ColumnCount + matrix.Values + matrix.RowPointers + matrix.Columns + resultBitmap + resultValues + resultRows + resultColumns) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + resultBitmap, resultValues, resultRows, resultColumns + + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (op: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let mapWithValue = + preparePositions clContext workGroupSize op + + let setPositions = + Common.setPositionsOption<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) (matrix: ClMatrix.CSR<'b>) -> + let valueClCell = clContext.CreateClCell value + + let bitmap, values, rows, columns = mapWithValue queue valueClCell matrix + + valueClCell.Free queue + + let result = + 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)) + + result + |> Option.map + (fun (resRows, resCols, resValues, _) -> + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = resRows + Columns = resCols + Values = resValues }) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 3078bdbb..22171912 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -53,6 +53,45 @@ module Matrix = rows + let item<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) row column (rowPointers: ClArray) (columns: ClArray) (values: ClArray<'a>) (result: ClCell<'a option>) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + let firstIndex = rowPointers.[row] + let lastIndex = rowPointers.[row + 1] - 1 + + result.Value <- (%Search.Bin.inRange) firstIndex lastIndex column columns values @> + + let program = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (row: int) (column: int) (matrix: ClMatrix.CSR<'a>) -> + + if row < 0 || row >= matrix.RowCount then + failwith "Row out of range" + + if column < 0 || column >= matrix.ColumnCount then + failwith "Column out of range" + + let result = clContext.CreateClCell None + + let kernel = program.GetKernel() + + let ndRange = Range1D.CreateValid(1, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange row column matrix.RowPointers matrix.Columns matrix.Values result) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + result + let subRows (clContext: ClContext) workGroupSize = let kernel = @@ -295,3 +334,5 @@ module Matrix = pointerPairs.Free processor rowsLength + + let kronecker = Kronecker.run diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index 2f59ad03..5588b203 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -4,8 +4,6 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Quotes module internal Common = ///. @@ -42,3 +40,41 @@ module internal Common = valuesScatter processor positions allValues resultValues resultRows, resultColumns, resultValues, resultLength + + ///. + ///Should be a power of 2 and greater than 1. + let setPositionsOption<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let indicesScatter = + Scatter.lastOccurrence clContext workGroupSize + + let valuesScatter = + Scatter.lastOccurrence clContext workGroupSize + + let sum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> + + let resultLength = + (sum processor positions).ToHostAndFree(processor) + + if resultLength = 0 then + None + else + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + indicesScatter processor positions allRows resultRows + + indicesScatter processor positions allColumns resultColumns + + valuesScatter processor positions allValues resultValues + + Some(resultRows, resultColumns, resultValues, resultLength) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 4c23531e..9ab641a4 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -390,6 +390,17 @@ module Matrix = |> ClMatrix.CSR | ClMatrix.LIL _ -> failwith "Not yet implemented" + let kronecker (op: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = + let run = + CSR.Matrix.kronecker clContext workGroupSize op + + fun (queue: MailboxProcessor<_>) allocationFlag (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) -> + match matrix1, matrix2 with + | ClMatrix.CSR m1, ClMatrix.CSR m2 -> + let result = run queue allocationFlag m1 m2 + Option.map ClMatrix.COO result + | _ -> failwith "Matrix formats are not matching" + module SpGeMM = let masked (opAdd: Expr<'c -> 'c -> 'c option>) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 737f196e..642697bc 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -3,6 +3,58 @@ open GraphBLAS.FSharp.Backend.Objects module ArithmeticOperations = + let byteSumOption = + <@ fun (x: byte option) (y: byte option) -> + let mutable res = 0 + + let xInt = + match x with + | Some x -> Some(int x) + | None -> None + + let yInt = + match y with + | Some y -> Some(int y) + | None -> None + + match xInt, yInt with + | Some f, Some s -> res <- f + s + | Some f, None -> res <- f + | None, Some s -> res <- s + | None, None -> () + + let byteRes = byte res + + if byteRes = 0uy then + None + else + Some byteRes @> + + let byteMulOption = + <@ fun (x: byte option) (y: byte option) -> + let mutable res = 0 + + let xInt = + match x with + | Some x -> Some(int x) + | None -> None + + let yInt = + match y with + | Some y -> Some(int y) + | None -> None + + match xInt, yInt with + | Some f, Some s -> res <- f * s + | _ -> () + + let byteRes = byte res + + if byteRes = 0uy then + None + else + Some byteRes @> + let inline mkUnaryOp zero unaryOp = <@ fun x -> let mutable res = zero @@ -73,7 +125,7 @@ module ArithmeticOperations = mkUnaryOp zero <@ fun x -> x + constant @> let intSumOption = mkNumericSum 0 - let byteSumOption = mkNumericSum 0uy + // let byteSumOption = mkNumericSum 0uy let floatSumOption = mkNumericSum 0.0 let float32SumOption = mkNumericSum 0f @@ -102,7 +154,7 @@ module ArithmeticOperations = mkUnaryOp zero <@ fun x -> x * constant @> let intMulOption = mkNumericMul 0 - let byteMulOption = mkNumericMul 0uy + // let byteMulOption = mkNumericMul 0uy let floatMulOption = mkNumericMul 0.0 let float32MulOption = mkNumericMul 0f diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs new file mode 100644 index 00000000..9e99948e --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs @@ -0,0 +1,104 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.Kronecker + +open Expecto +open Expecto.Logging +open Brahma.FSharp +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Tests.TestCases +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions + +let config = + { Utils.defaultConfig with + endSize = 8 + maxTest = 50 } + +let logger = Log.create "kronecker.Tests" + +let workGroupSize = Utils.defaultWorkGroupSize + +let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) = + let leftMatrix = [[false; false] + [false; false] + [true; false]] |> array2D + + let rightMatrix = [[false; false] + [false; true] + [false; false]] |> array2D + + let m1 = + Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero) + + let m2 = + Utils.createMatrixFromArray2D CSR rightMatrix (isEqual zero) + + let expected = + HostPrimitives.array2DKroneckerProduct leftMatrix rightMatrix op + + let expected = + Utils.createMatrixFromArray2D COO expected (isEqual zero) + + let expectedOption = + if expected.NNZ = 0 then + None + else + expected |> Some + + if m1.NNZ > 0 && m2.NNZ > 0 then + let m1 = m1.ToDevice context + let m2 = m2.ToDevice context + + let result = + kroneckerFun processor ClContext.HostInterop m1 m2 + + let actual = + Option.bind (fun (m: ClMatrix<'a>) -> m.ToHost processor |> Some) result + + m1.Dispose processor + m2.Dispose processor + + match result with + | Some m -> m.Dispose processor + | _ -> () + + // Check result + "Matrices should be equal" + |> Expect.equal actual expectedOption + +let createGeneralTest (context: ClContext) (processor: MailboxProcessor) (zero: 'a) isEqual op opQ testName = + + let kronecker = + Matrix.kronecker opQ context workGroupSize + + makeTest context processor zero isEqual op kronecker + |> testPropertyWithConfig config $"test on %A{typeof<'a>} %s{testName}" + +let generalTests (testContext: TestContext) = + [ let context = testContext.ClContext + let queue = testContext.Queue + queue.Error.Add(fun e -> failwithf "%A" e) + + // createGeneralTest context queue false (=) (&&) ArithmeticOperations.boolMulOption "mul" + createGeneralTest context queue false (=) (||) ArithmeticOperations.boolSumOption "sum" + // + // createGeneralTest context queue 0 (=) (*) ArithmeticOperations.intMulOption "mul" + // createGeneralTest context queue 0 (=) (+) ArithmeticOperations.intSumOption "sum" + // + // createGeneralTest context queue 0uy (=) (*) ArithmeticOperations.byteMulOption "mul" + // createGeneralTest context queue 0uy (=) (+) ArithmeticOperations.byteSumOption "sum" + + // createGeneralTest context queue 0.0f Utils.float32IsEqual (*) ArithmeticOperations.float32MulOption "mul" + // createGeneralTest context? queue 0.0f Utils.float32IsEqual (+) ArithmeticOperations.float32SumOption "sum" + + // if Utils.isFloat64Available context.ClDevice then + // createGeneralTest context queue 0.0 Utils.floatIsEqual (*) ArithmeticOperations.floatMulOption "mul" + // createGeneralTest context queue 0.0 Utils.floatIsEqual (+) ArithmeticOperations.floatSumOption "sum" + ] + +let tests = + gpuTests "Backend.Matrix.kronecker tests" generalTests diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index c3f81416..d0b800e7 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -53,6 +53,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index e0e55b97..1811c40b 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -324,6 +324,21 @@ module HostPrimitives = |> Array.map (fun (_, array) -> Array.map snd array |> scan |> fst) |> Array.concat + let array2DKroneckerProduct leftMatrix rightMatrix op = + Array2D.init + <| (Array2D.length1 leftMatrix) + * (Array2D.length1 rightMatrix) + <| (Array2D.length2 leftMatrix) + * (Array2D.length2 rightMatrix) + <| fun i j -> + let leftElement = + leftMatrix.[i / (Array2D.length1 rightMatrix), j / (Array2D.length2 rightMatrix)] + + let rightElement = + rightMatrix.[i % (Array2D.length1 rightMatrix), j % (Array2D.length2 rightMatrix)] + + op leftElement rightElement + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f6359ee4..93687bb5 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,113 +2,114 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -let matrixTests = - testList - "Matrix" - [ Matrix.Convert.tests - Matrix.Map2.allTests - Matrix.Map.allTests - Matrix.Merge.allTests - Matrix.Transpose.tests - Matrix.RowsLengths.tests - Matrix.ByRows.tests - Matrix.ExpandRows.tests - Matrix.SubRows.tests - - Matrix.SpGeMM.Expand.generalTests - Matrix.SpGeMM.Masked.tests ] - |> testSequenced - -let commonTests = - let scanTests = - testList - "Scan" - [ Common.Scan.ByKey.sequentialSegmentsTests - Common.Scan.PrefixSum.tests ] - - let reduceTests = - testList - "Reduce" - [ Common.Reduce.ByKey.allTests - Common.Reduce.Reduce.tests - Common.Reduce.Sum.tests ] - - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.allTests - Common.ClArray.ChunkBySize.allTests - Common.ClArray.Blit.tests - Common.ClArray.Concat.tests - Common.ClArray.Fill.tests - Common.ClArray.Pairwise.tests - Common.ClArray.UpperBound.tests - Common.ClArray.Set.tests - Common.ClArray.Item.tests ] - - let sortTests = - testList - "Sort" - [ Common.Sort.Bitonic.tests - Common.Sort.Radix.allTests ] - - testList - "Common" - [ Common.Scatter.allTests - Common.Gather.allTests - Common.Merge.tests - clArrayTests - sortTests - reduceTests - scanTests ] - |> testSequenced - -let vectorTests = - testList - "Vector" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.allTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests - Vector.Merge.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced - -let deviceTests = - testList - "Device" - [ matrixTests - commonTests - vectorTests - algorithmsTests ] - |> testSequenced - -let hostTests = - testList - "Host" - [ Host.Matrix.FromArray2D.tests - Host.Matrix.Convert.tests - Host.IO.MtxReader.test ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix" +// [ Matrix.Convert.tests +// Matrix.Map2.allTests +// Matrix.Map.allTests +// Matrix.Merge.allTests +// Matrix.Transpose.tests +// Matrix.RowsLengths.tests +// Matrix.ByRows.tests +// Matrix.ExpandRows.tests +// Matrix.SubRows.tests +// Matrix.Kronecker.tests +// +// Matrix.SpGeMM.Expand.generalTests +// Matrix.SpGeMM.Masked.tests ] +// |> testSequenced +// +// let commonTests = +// let scanTests = +// testList +// "Scan" +// [ Common.Scan.ByKey.sequentialSegmentsTests +// Common.Scan.PrefixSum.tests ] +// +// let reduceTests = +// testList +// "Reduce" +// [ Common.Reduce.ByKey.allTests +// Common.Reduce.Reduce.tests +// Common.Reduce.Sum.tests ] +// +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.allTests +// Common.ClArray.ChunkBySize.allTests +// Common.ClArray.Blit.tests +// Common.ClArray.Concat.tests +// Common.ClArray.Fill.tests +// Common.ClArray.Pairwise.tests +// Common.ClArray.UpperBound.tests +// Common.ClArray.Set.tests +// Common.ClArray.Item.tests ] +// +// let sortTests = +// testList +// "Sort" +// [ Common.Sort.Bitonic.tests +// Common.Sort.Radix.allTests ] +// +// testList +// "Common" +// [ Common.Scatter.allTests +// Common.Gather.allTests +// Common.Merge.tests +// clArrayTests +// sortTests +// reduceTests +// scanTests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.allTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests +// Vector.Merge.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced +// +// let deviceTests = +// testList +// "Device" +// [ matrixTests +// commonTests +// vectorTests +// algorithmsTests ] +// |> testSequenced +// +// let hostTests = +// testList +// "Host" +// [ Host.Matrix.FromArray2D.tests +// Host.Matrix.Convert.tests +// Host.IO.MtxReader.test ] +// |> testSequenced [] let allTests = - testList "All" [ deviceTests; hostTests ] + testList "All" [ Matrix.Kronecker.tests ] |> testSequenced [] From ab946ea8de744bb2f164edf5cb3c6627dfe38c0f Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Tue, 9 May 2023 20:52:09 +0300 Subject: [PATCH 133/143] fix: kronecker --- .../Matrix/CSR/Kronecker.fs | 46 +++++++++++-------- .../Backend/Matrix/Kronecker.fs | 41 +++++++---------- 2 files changed, 42 insertions(+), 45 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs index af081803..97413edc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs @@ -1,6 +1,7 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR open FSharp.Quotations.Evaluator +open FSharpx.Collections open Microsoft.FSharp.Quotations open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes @@ -166,13 +167,10 @@ module internal Kronecker = let setPositions<'c when 'c: struct> (clContext: ClContext) workGroupSize = let setPositions = - <@ fun (ndRange: Range1D) rowCount columnCount (nnz: ClCell) (rowOffset: ClCell) (columnOffset: ClCell) (startIndex: ClCell) (bitmap: ClArray) (values: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) (resultValues: ClArray<'c>) -> + <@ fun (ndRange: Range1D) rowCount columnCount startIndex (nnz: ClCell) (rowOffset: ClCell) (columnOffset: ClCell) (bitmap: ClArray) (values: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) (resultValues: ClArray<'c>) -> let gid = ndRange.GlobalID0 - if gid = 0 then - nnz.Value <- nnz.Value + startIndex.Value - if gid < rowCount * columnCount && (gid = 0 && bitmap.[gid] = 1 || gid > 0 && bitmap.[gid - 1] < bitmap.[gid]) then @@ -180,7 +178,7 @@ module internal Kronecker = let columnIndex = gid % columnCount let rowIndex = gid / columnCount - let index = startIndex.Value + bitmap.[gid] - 1 + let index = startIndex + bitmap.[gid] - 1 resultRows.[index] <- rowIndex + rowOffset.Value resultColumns.[index] <- columnIndex + columnOffset.Value @@ -191,7 +189,7 @@ module internal Kronecker = let scan = PrefixSum.standardIncludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) rowCount columnCount (rowOffset: int) (columnOffset: int) (startIndex: ClCell) (resultMatrix: COO<'c>) (values: ClArray<'c>) (bitmap: ClArray) -> + fun (processor: MailboxProcessor<_>) rowCount columnCount (rowOffset: int) (columnOffset: int) (startIndex: int) (resultMatrix: COO<'c>) (values: ClArray<'c>) (bitmap: ClArray) -> let sum = scan processor bitmap @@ -210,10 +208,10 @@ module internal Kronecker = ndRange rowCount columnCount + startIndex sum rowOffset columnOffset - startIndex bitmap values resultMatrix.Rows @@ -223,6 +221,8 @@ module internal Kronecker = processor.Post(Msg.CreateRunMsg<_, _> kernel) + (sum.ToHostAndFree processor) + startIndex + let copyToResult (clContext: ClContext) workGroupSize = let copyToResult = @@ -257,12 +257,12 @@ module internal Kronecker = sourceMatrix.NNZ rowOffset columnOffset - resultMatrix.Rows - resultMatrix.Columns - resultMatrix.Values sourceMatrix.Rows sourceMatrix.Columns - sourceMatrix.Values) + sourceMatrix.Values + resultMatrix.Rows + resultMatrix.Columns + resultMatrix.Values) ) processor.Post(Msg.CreateRunMsg<_, _> kernel) @@ -271,7 +271,7 @@ module internal Kronecker = let copy = copyToResult clContext workGroupSize - fun queue (startIndex: int) (zeroCounts: int list array) (matrixZero: COO<'c>) (matrixRight: CSR<'b>) resultMatrix -> + fun queue startIndex (zeroCounts: int list array) (matrixZero: COO<'c>) resultMatrix -> let rowCount = zeroCounts.Length @@ -282,10 +282,10 @@ module internal Kronecker = if iter >= count then () else - let rowOffset = row * matrixRight.RowCount + let rowOffset = row * matrixZero.RowCount let columnOffset = - (firstColumn + iter) * matrixRight.ColumnCount + (firstColumn + iter) * matrixZero.ColumnCount copy queue startIndex rowOffset columnOffset resultMatrix matrixZero @@ -338,7 +338,7 @@ module internal Kronecker = let mappedMatrix = clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length) - let startIndex = clContext.CreateClCell 0 + let mutable startIndex = 0 let rec insertInRowRec row rightEdge index = if index > rightEdge then @@ -354,7 +354,12 @@ module internal Kronecker = value.Free queue - setPositions rowOffset columnOffset startIndex resultMatrix mappedMatrix bitmap + startIndex <- + setPositions rowOffset columnOffset startIndex resultMatrix mappedMatrix bitmap + // printfn $"resultMatrix.Values: %A{resultMatrix.Values.ToHost queue}" + // printfn $"resultMatrix.Rows: %A{resultMatrix.Rows.ToHost queue}" + // printfn $"resultMatrix.Columns: %A{resultMatrix.Columns.ToHost queue}" + // printfn $"startIndex: %A{startIndex.ToHost queue}" insertInRowRec row rightEdge (index + 1) @@ -434,12 +439,9 @@ module internal Kronecker = let startIndex = insertNonZero queue rowsEdges matrixRight matrixLeft.Values leftColumns resultMatrix - let startIndex = startIndex.ToHostAndFree queue - match matrixZero with | Some m -> - insertZero queue startIndex zeroCounts m matrixRight resultMatrix - m.Dispose queue + insertZero queue startIndex zeroCounts m resultMatrix | _ -> () resultMatrix @@ -483,6 +485,10 @@ module internal Kronecker = let result = mapAll queue allocationMode size matrixZero matrixLeft matrixRight + match matrixZero with + | Some m -> m.Dispose queue + | _ -> () + bitonic queue result.Rows result.Columns result.Values result |> Some diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs index 9e99948e..f6c4ef37 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs @@ -15,22 +15,14 @@ open GraphBLAS.FSharp.Objects.MatrixExtensions let config = { Utils.defaultConfig with - endSize = 8 - maxTest = 50 } + endSize = 100 + maxTest = 20 } let logger = Log.create "kronecker.Tests" let workGroupSize = Utils.defaultWorkGroupSize let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) = - let leftMatrix = [[false; false] - [false; false] - [true; false]] |> array2D - - let rightMatrix = [[false; false] - [false; true] - [false; false]] |> array2D - let m1 = Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero) @@ -83,22 +75,21 @@ let generalTests (testContext: TestContext) = let queue = testContext.Queue queue.Error.Add(fun e -> failwithf "%A" e) - // createGeneralTest context queue false (=) (&&) ArithmeticOperations.boolMulOption "mul" + createGeneralTest context queue false (=) (&&) ArithmeticOperations.boolMulOption "mul" createGeneralTest context queue false (=) (||) ArithmeticOperations.boolSumOption "sum" - // - // createGeneralTest context queue 0 (=) (*) ArithmeticOperations.intMulOption "mul" - // createGeneralTest context queue 0 (=) (+) ArithmeticOperations.intSumOption "sum" - // - // createGeneralTest context queue 0uy (=) (*) ArithmeticOperations.byteMulOption "mul" - // createGeneralTest context queue 0uy (=) (+) ArithmeticOperations.byteSumOption "sum" - - // createGeneralTest context queue 0.0f Utils.float32IsEqual (*) ArithmeticOperations.float32MulOption "mul" - // createGeneralTest context? queue 0.0f Utils.float32IsEqual (+) ArithmeticOperations.float32SumOption "sum" - - // if Utils.isFloat64Available context.ClDevice then - // createGeneralTest context queue 0.0 Utils.floatIsEqual (*) ArithmeticOperations.floatMulOption "mul" - // createGeneralTest context queue 0.0 Utils.floatIsEqual (+) ArithmeticOperations.floatSumOption "sum" - ] + + createGeneralTest context queue 0 (=) (*) ArithmeticOperations.intMulOption "mul" + createGeneralTest context queue 0 (=) (+) ArithmeticOperations.intSumOption "sum" + + createGeneralTest context queue 0uy (=) (*) ArithmeticOperations.byteMulOption "mul" + createGeneralTest context queue 0uy (=) (+) ArithmeticOperations.byteSumOption "sum" + + createGeneralTest context queue 0.0f Utils.float32IsEqual (*) ArithmeticOperations.float32MulOption "mul" + createGeneralTest context queue 0.0f Utils.float32IsEqual (+) ArithmeticOperations.float32SumOption "sum" + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest context queue 0.0 Utils.floatIsEqual (*) ArithmeticOperations.floatMulOption "mul" + createGeneralTest context queue 0.0 Utils.floatIsEqual (+) ArithmeticOperations.floatSumOption "sum" ] let tests = gpuTests "Backend.Matrix.kronecker tests" generalTests From fc55f852e4b9a4f8872fb87629172fe668e48fa6 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Tue, 9 May 2023 22:55:04 +0300 Subject: [PATCH 134/143] perf: kronecker --- .../Matrix/CSR/Kronecker.fs | 150 +++++++----------- .../Backend/Matrix/Kronecker.fs | 2 +- tests/GraphBLAS-sharp.Tests/Program.fs | 5 + 3 files changed, 60 insertions(+), 97 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs index 97413edc..2cf90fca 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs @@ -15,66 +15,63 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module internal Kronecker = - let private getBitmap (clContext: ClContext) workGroupSize op = + let private updateBitmap (clContext: ClContext) workGroupSize op = - let getBitmap (op: Expr<'a option -> 'b option -> 'c option>) = - <@ fun (ndRange: Range1D) (prevSum: ClCell) (operand: ClCell<'a>) valuesLength numberOfZeros (values: ClArray<'b>) (resultBitmap: ClArray) -> + let updateBitmap (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) (operand: ClCell<'a>) valuesLength zeroCount (values: ClArray<'b>) (resultBitmap: ClArray) -> let gid = ndRange.GlobalID0 if gid = 0 then match (%op) (Some operand.Value) None with - | Some _ -> resultBitmap.[0] <- prevSum.Value + numberOfZeros - | _ -> resultBitmap.[0] <- prevSum.Value + | Some _ -> resultBitmap.[0] <- resultBitmap.[0] + zeroCount + | _ -> () else if (gid - 1) < valuesLength then match (%op) (Some operand.Value) (Some values.[gid - 1]) with - | Some _ -> resultBitmap.[gid] <- 1 - | _ -> resultBitmap.[gid] <- 0 @> + | Some _ -> resultBitmap.[gid] <- resultBitmap.[gid] + 1 + | _ -> () @> - let getBitmap = clContext.Compile <| getBitmap op + let updateBitmap = clContext.Compile <| updateBitmap op - fun (processor: MailboxProcessor<_>) (prevSum: ClCell) (operand: ClCell<'a>) (matrixRight: ClMatrix.CSR<'b>) (bitmap: ClArray) -> + fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrixRight: ClMatrix.CSR<'b>) (bitmap: ClArray) -> let resultLength = matrixRight.NNZ + 1 let ndRange = Range1D.CreateValid(resultLength, workGroupSize) - let getBitmap = getBitmap.GetKernel() + let updateBitmap = updateBitmap.GetKernel() let numberOfZeros = - matrixRight.ColumnCount * matrixRight.RowCount - matrixRight.NNZ + matrixRight.ColumnCount * matrixRight.RowCount + - matrixRight.NNZ processor.Post( Msg.MsgSetArguments (fun () -> - getBitmap.KernelFunc - ndRange - prevSum - operand - matrixRight.NNZ - numberOfZeros - matrixRight.Values - bitmap) + updateBitmap.KernelFunc ndRange operand matrixRight.NNZ numberOfZeros matrixRight.Values bitmap) ) - processor.Post(Msg.CreateRunMsg<_, _> getBitmap) + processor.Post(Msg.CreateRunMsg<_, _> updateBitmap) let private getAllocationSize (clContext: ClContext) workGroupSize op = - let getBitmap = getBitmap clContext workGroupSize op + let updateBitmap = updateBitmap clContext workGroupSize op let sum = Reduce.sum <@ fun x y -> x + y @> 0 clContext workGroupSize let item = ClArray.item clContext workGroupSize + let createClArray = + ClArray.zeroCreate clContext workGroupSize + let opOnHost = QuotationEvaluator.Evaluate op - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + fun (queue: MailboxProcessor<_>) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let nnz = match opOnHost None None with @@ -89,28 +86,30 @@ module internal Kronecker = leftZeroCount * rightZeroCount | _ -> 0 - |> clContext.CreateClCell let bitmap = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, matrixRight.NNZ + 1) + createClArray queue DeviceOnly (matrixRight.NNZ + 1) - let nnz = - { 0 .. matrixLeft.NNZ - 1 } - |> Seq.fold - (fun acc index -> - let value = item queue index matrixLeft.Values + for index in 0 .. matrixLeft.NNZ - 1 do + let value = item queue index matrixLeft.Values - getBitmap queue acc value matrixRight bitmap + updateBitmap queue value matrixRight bitmap - let nnz = sum queue bitmap + value.Free queue - acc.Free queue - value.Free queue + let bitmapSum = sum queue bitmap - nnz) - nnz + bitmap.Free queue + + let leftZeroCount = + matrixLeft.ColumnCount * matrixLeft.RowCount + - matrixLeft.NNZ - nnz.ToHostAndFree queue + match matrixZero with + | Some m -> m.NNZ * leftZeroCount + | _ -> 0 + + nnz + + bitmapSum.ToHostAndFree queue let private preparePositions<'a, 'b, 'c when 'b: struct> (clContext: ClContext) workGroupSize op = @@ -241,7 +240,8 @@ module internal Kronecker = fun (processor: MailboxProcessor<_>) startIndex (rowOffset: int) (columnOffset: int) (resultMatrix: COO<'c>) (sourceMatrix: COO<'c>) -> - let ndRange = Range1D.CreateValid(sourceMatrix.NNZ, workGroupSize) + let ndRange = + Range1D.CreateValid(sourceMatrix.NNZ, workGroupSize) let kernel = kernel.GetKernel() @@ -278,22 +278,15 @@ module internal Kronecker = let mutable startIndex = startIndex let insertMany row firstColumn count = - let rec insertManyRec iter = - if iter >= count then - () - else - let rowOffset = row * matrixZero.RowCount + for i in 0 .. count - 1 do + let rowOffset = row * matrixZero.RowCount - let columnOffset = - (firstColumn + iter) * matrixZero.ColumnCount + let columnOffset = + (firstColumn + i) * matrixZero.ColumnCount - copy queue startIndex rowOffset columnOffset resultMatrix matrixZero + copy queue startIndex rowOffset columnOffset resultMatrix matrixZero - startIndex <- startIndex + matrixZero.NNZ - - insertManyRec (iter + 1) - - insertManyRec 0 + startIndex <- startIndex + matrixZero.NNZ let rec insertInRowRec zeroCounts row column = match zeroCounts with @@ -303,15 +296,8 @@ module internal Kronecker = insertInRowRec tl row (h + column + 1) - let rec insertZeroRec row = - if row >= rowCount then - () - else - insertInRowRec zeroCounts.[row] row 0 - - insertZeroRec (row + 1) - - insertZeroRec 0 + for row in 0 .. rowCount - 1 do + insertInRowRec zeroCounts.[row] row 0 let insertNonZero (clContext: ClContext) workGroupSize op = @@ -340,12 +326,12 @@ module internal Kronecker = let mutable startIndex = 0 - let rec insertInRowRec row rightEdge index = - if index > rightEdge then - () - else - let value = item queue index leftValues - let column = leftColsHost.[index] + for row in 0 .. rowCount - 1 do + let leftEdge, rightEdge = rowsEdges.[row] + + for i in leftEdge .. rightEdge do + let value = item queue i leftValues + let column = leftColsHost.[i] let rowOffset = row * matrixRight.RowCount let columnOffset = column * matrixRight.ColumnCount @@ -354,26 +340,7 @@ module internal Kronecker = value.Free queue - startIndex <- - setPositions rowOffset columnOffset startIndex resultMatrix mappedMatrix bitmap - // printfn $"resultMatrix.Values: %A{resultMatrix.Values.ToHost queue}" - // printfn $"resultMatrix.Rows: %A{resultMatrix.Rows.ToHost queue}" - // printfn $"resultMatrix.Columns: %A{resultMatrix.Columns.ToHost queue}" - // printfn $"startIndex: %A{startIndex.ToHost queue}" - - insertInRowRec row rightEdge (index + 1) - - let rec insertNonZeroRec row = - if row >= rowCount then - () - else - let leftEdge, rightEdge = rowsEdges.[row] - - insertInRowRec row rightEdge leftEdge - - insertNonZeroRec (row + 1) - - insertNonZeroRec 0 + startIndex <- setPositions rowOffset columnOffset startIndex resultMatrix mappedMatrix bitmap bitmap.Free queue mappedMatrix.Free queue @@ -440,8 +407,7 @@ module internal Kronecker = insertNonZero queue rowsEdges matrixRight matrixLeft.Values leftColumns resultMatrix match matrixZero with - | Some m -> - insertZero queue startIndex zeroCounts m resultMatrix + | Some m -> insertZero queue startIndex zeroCounts m resultMatrix | _ -> () resultMatrix @@ -468,16 +434,8 @@ module internal Kronecker = let matrixZero = mapWithValue queue allocationMode None matrixRight - let size = getSize queue matrixLeft matrixRight - - let leftZeroCount = - matrixLeft.ColumnCount * matrixLeft.RowCount - - matrixLeft.NNZ - let size = - match matrixZero with - | Some m -> size + m.NNZ * leftZeroCount - | _ -> size + getSize queue matrixZero matrixLeft matrixRight if size = 0 then None diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs index f6c4ef37..399db3db 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs @@ -15,7 +15,7 @@ open GraphBLAS.FSharp.Objects.MatrixExtensions let config = { Utils.defaultConfig with - endSize = 100 + endSize = 30 maxTest = 20 } let logger = Log.create "kronecker.Tests" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 93687bb5..78f1caca 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -106,6 +106,11 @@ open GraphBLAS.FSharp.Tests // Host.Matrix.Convert.tests // Host.IO.MtxReader.test ] // |> testSequenced +// +// [] +// let allTests = +// testList "All" [ deviceTests; hostTests ] +// |> testSequenced [] let allTests = From 290716743f4a8995943165aa1ee2380f8ffd40a5 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Tue, 9 May 2023 22:59:30 +0300 Subject: [PATCH 135/143] refactor: kronecker --- .../Matrix/CSR/Kronecker.fs | 30 +-- .../Backend/Matrix/Kronecker.fs | 2 +- tests/GraphBLAS-sharp.Tests/Program.fs | 215 +++++++++--------- 3 files changed, 123 insertions(+), 124 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs index 2cf90fca..0e222895 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs @@ -6,7 +6,6 @@ open Microsoft.FSharp.Quotations open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Matrix.COO open GraphBLAS.FSharp.Backend.Matrix.CSR open GraphBLAS.FSharp.Backend.Objects.ClCell @@ -24,19 +23,25 @@ module internal Kronecker = if gid = 0 then + let item = resultBitmap.[0] + let newItem = item + zeroCount + match (%op) (Some operand.Value) None with - | Some _ -> resultBitmap.[0] <- resultBitmap.[0] + zeroCount + | Some _ -> resultBitmap.[0] <- newItem | _ -> () else if (gid - 1) < valuesLength then + let item = resultBitmap.[gid] + let newItem = item + 1 + match (%op) (Some operand.Value) (Some values.[gid - 1]) with - | Some _ -> resultBitmap.[gid] <- resultBitmap.[gid] + 1 + | Some _ -> resultBitmap.[gid] <- newItem | _ -> () @> let updateBitmap = clContext.Compile <| updateBitmap op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrixRight: ClMatrix.CSR<'b>) (bitmap: ClArray) -> + fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrixRight: CSR<'b>) (bitmap: ClArray) -> let resultLength = matrixRight.NNZ + 1 @@ -137,7 +142,7 @@ module internal Kronecker = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrix: ClMatrix.CSR<'b>) (resultDenseMatrix: ClArray<'c>) (resultBitmap: ClArray) -> + fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrix: CSR<'b>) (resultDenseMatrix: ClArray<'c>) (resultBitmap: ClArray) -> let resultLength = matrix.RowCount * matrix.ColumnCount @@ -163,10 +168,10 @@ module internal Kronecker = processor.Post(Msg.CreateRunMsg<_, _> kernel) - let setPositions<'c when 'c: struct> (clContext: ClContext) workGroupSize = + let private setPositions<'c when 'c: struct> (clContext: ClContext) workGroupSize = let setPositions = - <@ fun (ndRange: Range1D) rowCount columnCount startIndex (nnz: ClCell) (rowOffset: ClCell) (columnOffset: ClCell) (bitmap: ClArray) (values: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) (resultValues: ClArray<'c>) -> + <@ fun (ndRange: Range1D) rowCount columnCount startIndex (rowOffset: ClCell) (columnOffset: ClCell) (bitmap: ClArray) (values: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) (resultValues: ClArray<'c>) -> let gid = ndRange.GlobalID0 @@ -208,7 +213,6 @@ module internal Kronecker = rowCount columnCount startIndex - sum rowOffset columnOffset bitmap @@ -222,7 +226,7 @@ module internal Kronecker = (sum.ToHostAndFree processor) + startIndex - let copyToResult (clContext: ClContext) workGroupSize = + let private copyToResult (clContext: ClContext) workGroupSize = let copyToResult = <@ fun (ndRange: Range1D) startIndex sourceLength (rowOffset: ClCell) (columnOffset: ClCell) (sourceRows: ClArray) (sourceColumns: ClArray) (sourceValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) (resultValues: ClArray<'c>) -> @@ -267,7 +271,7 @@ module internal Kronecker = processor.Post(Msg.CreateRunMsg<_, _> kernel) - let insertZero (clContext: ClContext) workGroupSize = + let private insertZero (clContext: ClContext) workGroupSize = let copy = copyToResult clContext workGroupSize @@ -299,7 +303,7 @@ module internal Kronecker = for row in 0 .. rowCount - 1 do insertInRowRec zeroCounts.[row] row 0 - let insertNonZero (clContext: ClContext) workGroupSize op = + let private insertNonZero (clContext: ClContext) workGroupSize op = let item = ClArray.item clContext workGroupSize @@ -347,7 +351,7 @@ module internal Kronecker = startIndex - let mapAll<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + let private mapAll<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) workGroupSize (op: Expr<'a option -> 'b option -> 'c option>) @@ -429,7 +433,7 @@ module internal Kronecker = let bitonic = Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let matrixZero = mapWithValue queue allocationMode None matrixRight diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs index 399db3db..f6c4ef37 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs @@ -15,7 +15,7 @@ open GraphBLAS.FSharp.Objects.MatrixExtensions let config = { Utils.defaultConfig with - endSize = 30 + endSize = 100 maxTest = 20 } let logger = Log.create "kronecker.Tests" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 78f1caca..9049b03e 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -2,119 +2,114 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Tests -// let matrixTests = -// testList -// "Matrix" -// [ Matrix.Convert.tests -// Matrix.Map2.allTests -// Matrix.Map.allTests -// Matrix.Merge.allTests -// Matrix.Transpose.tests -// Matrix.RowsLengths.tests -// Matrix.ByRows.tests -// Matrix.ExpandRows.tests -// Matrix.SubRows.tests -// Matrix.Kronecker.tests -// -// Matrix.SpGeMM.Expand.generalTests -// Matrix.SpGeMM.Masked.tests ] -// |> testSequenced -// -// let commonTests = -// let scanTests = -// testList -// "Scan" -// [ Common.Scan.ByKey.sequentialSegmentsTests -// Common.Scan.PrefixSum.tests ] -// -// let reduceTests = -// testList -// "Reduce" -// [ Common.Reduce.ByKey.allTests -// Common.Reduce.Reduce.tests -// Common.Reduce.Sum.tests ] -// -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.allTests -// Common.ClArray.ChunkBySize.allTests -// Common.ClArray.Blit.tests -// Common.ClArray.Concat.tests -// Common.ClArray.Fill.tests -// Common.ClArray.Pairwise.tests -// Common.ClArray.UpperBound.tests -// Common.ClArray.Set.tests -// Common.ClArray.Item.tests ] -// -// let sortTests = -// testList -// "Sort" -// [ Common.Sort.Bitonic.tests -// Common.Sort.Radix.allTests ] -// -// testList -// "Common" -// [ Common.Scatter.allTests -// Common.Gather.allTests -// Common.Merge.tests -// clArrayTests -// sortTests -// reduceTests -// scanTests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.allTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests -// Vector.Merge.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced -// -// let deviceTests = -// testList -// "Device" -// [ matrixTests -// commonTests -// vectorTests -// algorithmsTests ] -// |> testSequenced -// -// let hostTests = -// testList -// "Host" -// [ Host.Matrix.FromArray2D.tests -// Host.Matrix.Convert.tests -// Host.IO.MtxReader.test ] -// |> testSequenced -// -// [] -// let allTests = -// testList "All" [ deviceTests; hostTests ] -// |> testSequenced +let matrixTests = + testList + "Matrix" + [ Matrix.Convert.tests + Matrix.Map2.allTests + Matrix.Map.allTests + Matrix.Merge.allTests + Matrix.Transpose.tests + Matrix.RowsLengths.tests + Matrix.ByRows.tests + Matrix.ExpandRows.tests + Matrix.SubRows.tests + Matrix.Kronecker.tests + + Matrix.SpGeMM.Expand.generalTests + Matrix.SpGeMM.Masked.tests ] + |> testSequenced + +let commonTests = + let scanTests = + testList + "Scan" + [ Common.Scan.ByKey.sequentialSegmentsTests + Common.Scan.PrefixSum.tests ] + + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.allTests + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] + + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.allTests + Common.ClArray.ChunkBySize.allTests + Common.ClArray.Blit.tests + Common.ClArray.Concat.tests + Common.ClArray.Fill.tests + Common.ClArray.Pairwise.tests + Common.ClArray.UpperBound.tests + Common.ClArray.Set.tests + Common.ClArray.Item.tests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.allTests ] + + testList + "Common" + [ Common.Scatter.allTests + Common.Gather.allTests + Common.Merge.tests + clArrayTests + sortTests + reduceTests + scanTests ] + |> testSequenced + +let vectorTests = + testList + "Vector" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.allTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests + Vector.Merge.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced + +let deviceTests = + testList + "Device" + [ matrixTests + commonTests + vectorTests + algorithmsTests ] + |> testSequenced + +let hostTests = + testList + "Host" + [ Host.Matrix.FromArray2D.tests + Host.Matrix.Convert.tests + Host.IO.MtxReader.test ] + |> testSequenced [] let allTests = - testList "All" [ Matrix.Kronecker.tests ] + testList "All" [ deviceTests; hostTests ] |> testSequenced [] From 2a40ca3e107b98335321310d08c74a606a8931b7 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Tue, 9 May 2023 23:15:13 +0300 Subject: [PATCH 136/143] add: vector.mapWithValue --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 6 +- .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Vector/Sparse/Common.fs | 63 +++++++++ .../Vector/Sparse/Map.fs | 129 ++++++++++++++++++ .../Vector/Sparse/Vector.fs | 7 +- 5 files changed, 202 insertions(+), 4 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 5f98d708..d048c650 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -172,18 +172,20 @@ module ClArray = let kernel = clContext.Compile map - fun (processor: MailboxProcessor<_>) allocationMode (value: ClCell<'a>) (inputArray: ClArray<'b>) -> + fun (processor: MailboxProcessor<_>) allocationMode (value: 'a) (inputArray: ClArray<'b>) -> let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + let valueClCell = value |> clContext.CreateClCell + let ndRange = Range1D.CreateValid(inputArray.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length value inputArray result) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length valueClCell inputArray result) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 50b5339b..4709660f 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -43,6 +43,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs index 93b809c1..f6e07aff 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs @@ -2,6 +2,7 @@ namespace GraphBLAS.FSharp.Backend.Vector.Sparse open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ClVector open Microsoft.FSharp.Control open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell @@ -34,3 +35,65 @@ module internal Common = indicesScatter processor positions allIndices resultIndices resultValues, resultIndices + + let setPositionsOption<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let sum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + let valuesScatter = + Scatter.lastOccurrence clContext workGroupSize + + let indicesScatter = + Scatter.lastOccurrence clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> + + let resultLength = + (sum processor positions).ToHostAndFree(processor) + + if resultLength = 0 then + None + else + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(allocationMode, resultLength) + + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + valuesScatter processor positions allValues resultValues + + indicesScatter processor positions allIndices resultIndices + + (resultValues, resultIndices) |> Some + + let concat (clContext: ClContext) workGroupSize = + + let concatValues = ClArray.concat clContext workGroupSize + + let concatIndices = ClArray.concat clContext workGroupSize + + let mapIndices = + ClArray.mapWithValue clContext workGroupSize <@ fun x y -> x + y @> + + fun (processor: MailboxProcessor<_>) allocationMode (vectors: Sparse<'a> seq) -> + + let vectorIndices, _ = + (0, vectors) + ||> Seq.mapFold + (fun offset vector -> + let newIndices = + mapIndices processor allocationMode offset vector.Indices + + newIndices, offset + vector.Size) + + let vectorValues = + vectors |> Seq.map (fun vector -> vector.Values) + + let resultIndices = + concatIndices processor allocationMode vectorIndices + + let resultValues = + concatValues processor allocationMode vectorValues + + resultIndices, resultValues diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs new file mode 100644 index 00000000..0248392a --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -0,0 +1,129 @@ +namespace GraphBLAS.FSharp.Backend.Vector.Sparse + +open FSharp.Quotations.Evaluator +open Microsoft.FSharp.Quotations +open Brahma.FSharp +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Vector.Sparse +open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Common.ClArray +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ClContext + +module Map = + module WithValueOption = + let preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = + + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) (operand: ClCell<'a option>) size valuesLength (indices: ClArray) (values: ClArray<'b>) (resultIndices: ClArray) (resultValues: ClArray<'c>) (resultBitmap: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < size then + + let value = + (%Search.Bin.byKey) valuesLength gid indices values + + match (%op) operand.Value value with + | Some resultValue -> + resultValues.[gid] <- resultValue + resultIndices.[gid] <- gid + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> + + let kernel = + clContext.Compile <| preparePositions opAdd + + fun (processor: MailboxProcessor<_>) (value: ClCell<'a option>) (vector: Sparse<'b>) -> + + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) + + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vector.Size) + + let ndRange = + Range1D.CreateValid(vector.Size, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + value + vector.Size + vector.Values.Length + vector.Indices + vector.Values + resultIndices + resultValues + resultBitmap) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + resultIndices, resultValues, resultBitmap + + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + workGroupSize + (op: Expr<'a option -> 'b option -> 'c option>) + = + + let map = + preparePositions op clContext workGroupSize + + let opOnHost = op |> QuotationEvaluator.Evaluate + + let setPositions = + Common.setPositionsOption<'c> clContext workGroupSize + + let create = create clContext workGroupSize + + let init = + init <@ fun x -> x @> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) size -> + function + | Some vector -> + let valueClCell = clContext.CreateClCell value + + let indices, values, bitmap = map queue valueClCell vector + + valueClCell.Free queue + + let result = + setPositions queue allocationMode values indices bitmap + + queue.Post(Msg.CreateFreeMsg<_>(indices)) + queue.Post(Msg.CreateFreeMsg<_>(values)) + queue.Post(Msg.CreateFreeMsg<_>(bitmap)) + + result + |> Option.bind + (fun (resultValues, resultIndices) -> + { Context = clContext + Size = size + Indices = resultIndices + Values = resultValues } + |> Some) + | None -> + opOnHost value None + |> Option.bind + (fun resultValue -> + let resultValues = + create queue allocationMode size resultValue + + let resultIndices = init queue allocationMode size + + { Context = clContext + Size = size + Indices = resultIndices + Values = resultValues } + |> Some) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index deaab095..5b3594ae 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -1,12 +1,13 @@ namespace GraphBLAS.FSharp.Backend.Vector.Sparse open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Vector.Sparse module Vector = let copy (clContext: ClContext) workGroupSize = @@ -20,6 +21,8 @@ module Vector = Values = copyData processor allocationMode vector.Values Size = vector.Size } + let mapWithValue = Map.WithValueOption.run + let map2 = Map2.run let map2AtLeastOne opAdd (clContext: ClContext) workGroupSize allocationMode = From 10302da69fdad990d0da7f264da26d039d93234b Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Thu, 11 May 2023 12:26:15 +0300 Subject: [PATCH 137/143] refactor: kronecker --- src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs | 2 +- src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs index 0e222895..6ced2461 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs @@ -30,7 +30,7 @@ module internal Kronecker = | Some _ -> resultBitmap.[0] <- newItem | _ -> () - else if (gid - 1) < valuesLength then + elif (gid - 1) < valuesLength then let item = resultBitmap.[gid] let newItem = item + 1 diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs index 0248392a..8ee06c50 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -86,8 +86,7 @@ module Map = let create = create clContext workGroupSize - let init = - init <@ fun x -> x @> clContext workGroupSize + let init = init <@ id @> clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) size -> function From 7522725d23e77848e99c7b491050afeb9e9436f2 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Thu, 11 May 2023 14:11:02 +0300 Subject: [PATCH 138/143] refactor --- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 9ab641a4..cd754379 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -399,7 +399,7 @@ module Matrix = | ClMatrix.CSR m1, ClMatrix.CSR m2 -> let result = run queue allocationFlag m1 m2 Option.map ClMatrix.COO result - | _ -> failwith "Matrix formats are not matching" + | _ -> failwith "Both matrices should be in CSR format." module SpGeMM = let masked From 8ca161d33d70a9ab79114c59804e7986f6d9d813 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Fri, 12 May 2023 20:24:48 +0300 Subject: [PATCH 139/143] refactor: kronecker, tests, sparse.map --- .../Matrix/CSR/Kronecker.fs | 17 ++++---- src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs | 9 ++-- .../Vector/Sparse/Common.fs | 15 ++++--- .../Vector/Sparse/Map.fs | 28 +++++------- .../Backend/Matrix/Kronecker.fs | 43 +++++++++---------- .../GraphBLAS-sharp.Tests.fsproj | 2 +- 6 files changed, 54 insertions(+), 60 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs index 6ced2461..10151f41 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs @@ -1,8 +1,8 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR -open FSharp.Quotations.Evaluator open FSharpx.Collections open Microsoft.FSharp.Quotations +open FSharp.Quotations.Evaluator.QuotationEvaluationExtensions open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Common @@ -74,7 +74,7 @@ module internal Kronecker = let createClArray = ClArray.zeroCreate clContext workGroupSize - let opOnHost = QuotationEvaluator.Evaluate op + let opOnHost = op.Evaluate() fun (queue: MailboxProcessor<_>) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> @@ -410,9 +410,8 @@ module internal Kronecker = let startIndex = insertNonZero queue rowsEdges matrixRight matrixLeft.Values leftColumns resultMatrix - match matrixZero with - | Some m -> insertZero queue startIndex zeroCounts m resultMatrix - | _ -> () + matrixZero + |> Option.iter (fun m -> insertZero queue startIndex zeroCounts m resultMatrix) resultMatrix @@ -442,14 +441,16 @@ module internal Kronecker = getSize queue matrixZero matrixLeft matrixRight if size = 0 then + matrixZero + |> Option.iter (fun m -> m.Dispose queue) + None else let result = mapAll queue allocationMode size matrixZero matrixLeft matrixRight - match matrixZero with - | Some m -> m.Dispose queue - | _ -> () + matrixZero + |> Option.iter (fun m -> m.Dispose queue) bitonic queue result.Rows result.Columns result.Values diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 2705553d..7579e5d6 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -9,6 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module internal Map = let preparePositions<'a, 'b> op (clContext: ClContext) workGroupSize = @@ -101,10 +102,10 @@ module internal Map = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free queue + values.Free queue + rows.Free queue + columns.Free queue { Context = clContext RowCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs index f6e07aff..cb6a8971 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs @@ -79,13 +79,14 @@ module internal Common = fun (processor: MailboxProcessor<_>) allocationMode (vectors: Sparse<'a> seq) -> let vectorIndices, _ = - (0, vectors) - ||> Seq.mapFold - (fun offset vector -> - let newIndices = - mapIndices processor allocationMode offset vector.Indices - - newIndices, offset + vector.Size) + vectors + |> Seq.mapFold + (fun offset vector -> + let newIndices = + mapIndices processor allocationMode offset vector.Indices + + newIndices, offset + vector.Size) + 0 let vectorValues = vectors |> Seq.map (fun vector -> vector.Values) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs index 8ee06c50..3d804101 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -1,6 +1,6 @@ namespace GraphBLAS.FSharp.Backend.Vector.Sparse -open FSharp.Quotations.Evaluator +open FSharp.Quotations.Evaluator.QuotationEvaluationExtensions open Microsoft.FSharp.Quotations open Brahma.FSharp open GraphBLAS.FSharp.Backend @@ -10,6 +10,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Common.ClArray open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Map = module WithValueOption = @@ -79,7 +80,7 @@ module Map = let map = preparePositions op clContext workGroupSize - let opOnHost = op |> QuotationEvaluator.Evaluate + let opOnHost = op.Evaluate() let setPositions = Common.setPositionsOption<'c> clContext workGroupSize @@ -100,29 +101,22 @@ module Map = let result = setPositions queue allocationMode values indices bitmap - queue.Post(Msg.CreateFreeMsg<_>(indices)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) + indices.Free queue + values.Free queue + bitmap.Free queue result - |> Option.bind + |> Option.map (fun (resultValues, resultIndices) -> { Context = clContext Size = size Indices = resultIndices - Values = resultValues } - |> Some) + Values = resultValues }) | None -> opOnHost value None - |> Option.bind + |> Option.map (fun resultValue -> - let resultValues = - create queue allocationMode size resultValue - - let resultIndices = init queue allocationMode size - { Context = clContext Size = size - Indices = resultIndices - Values = resultValues } - |> Some) + Indices = init queue allocationMode size + Values = create queue allocationMode size resultValue }) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs index f6c4ef37..add171ee 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs @@ -2,7 +2,6 @@ open Expecto open Expecto.Logging -open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp.Tests.TestCases @@ -22,7 +21,10 @@ let logger = Log.create "kronecker.Tests" let workGroupSize = Utils.defaultWorkGroupSize -let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) = +let makeTest testContext zero isEqual op kroneckerFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) = + let context = testContext.ClContext + let processor = testContext.Queue + let m1 = Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero) @@ -49,7 +51,7 @@ let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,], kroneckerFun processor ClContext.HostInterop m1 m2 let actual = - Option.bind (fun (m: ClMatrix<'a>) -> m.ToHost processor |> Some) result + Option.map (fun (m: ClMatrix<'a>) -> m.ToHost processor) result m1.Dispose processor m2.Dispose processor @@ -62,34 +64,29 @@ let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,], "Matrices should be equal" |> Expect.equal actual expectedOption -let createGeneralTest (context: ClContext) (processor: MailboxProcessor) (zero: 'a) isEqual op opQ testName = - - let kronecker = - Matrix.kronecker opQ context workGroupSize - - makeTest context processor zero isEqual op kronecker +let createGeneralTest testContext (zero: 'a) isEqual op opQ testName = + Matrix.kronecker opQ testContext.ClContext workGroupSize + |> makeTest testContext zero isEqual op |> testPropertyWithConfig config $"test on %A{typeof<'a>} %s{testName}" let generalTests (testContext: TestContext) = - [ let context = testContext.ClContext - let queue = testContext.Queue - queue.Error.Add(fun e -> failwithf "%A" e) + [ testContext.Queue.Error.Add(fun e -> failwithf "%A" e) - createGeneralTest context queue false (=) (&&) ArithmeticOperations.boolMulOption "mul" - createGeneralTest context queue false (=) (||) ArithmeticOperations.boolSumOption "sum" + createGeneralTest testContext false (=) (&&) ArithmeticOperations.boolMulOption "mul" + createGeneralTest testContext false (=) (||) ArithmeticOperations.boolSumOption "sum" - createGeneralTest context queue 0 (=) (*) ArithmeticOperations.intMulOption "mul" - createGeneralTest context queue 0 (=) (+) ArithmeticOperations.intSumOption "sum" + createGeneralTest testContext 0 (=) (*) ArithmeticOperations.intMulOption "mul" + createGeneralTest testContext 0 (=) (+) ArithmeticOperations.intSumOption "sum" - createGeneralTest context queue 0uy (=) (*) ArithmeticOperations.byteMulOption "mul" - createGeneralTest context queue 0uy (=) (+) ArithmeticOperations.byteSumOption "sum" + createGeneralTest testContext 0uy (=) (*) ArithmeticOperations.byteMulOption "mul" + createGeneralTest testContext 0uy (=) (+) ArithmeticOperations.byteSumOption "sum" - createGeneralTest context queue 0.0f Utils.float32IsEqual (*) ArithmeticOperations.float32MulOption "mul" - createGeneralTest context queue 0.0f Utils.float32IsEqual (+) ArithmeticOperations.float32SumOption "sum" + createGeneralTest testContext 0.0f Utils.float32IsEqual (*) ArithmeticOperations.float32MulOption "mul" + createGeneralTest testContext 0.0f Utils.float32IsEqual (+) ArithmeticOperations.float32SumOption "sum" - if Utils.isFloat64Available context.ClDevice then - createGeneralTest context queue 0.0 Utils.floatIsEqual (*) ArithmeticOperations.floatMulOption "mul" - createGeneralTest context queue 0.0 Utils.floatIsEqual (+) ArithmeticOperations.floatSumOption "sum" ] + if Utils.isFloat64Available testContext.ClContext.ClDevice then + createGeneralTest testContext 0.0 Utils.floatIsEqual (*) ArithmeticOperations.floatMulOption "mul" + createGeneralTest testContext 0.0 Utils.floatIsEqual (+) ArithmeticOperations.floatSumOption "sum" ] let tests = gpuTests "Backend.Matrix.kronecker tests" generalTests diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index d0b800e7..75a4f492 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -53,7 +53,7 @@ - + From 61447f096dbde9d93a9a8a701c358d4b68325198 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Fri, 12 May 2023 20:41:11 +0300 Subject: [PATCH 140/143] refactor: remove commented code --- .../Quotes/Arithmetic.fs | 105 +++++++++--------- 1 file changed, 52 insertions(+), 53 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 642697bc..18180132 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -3,58 +3,6 @@ open GraphBLAS.FSharp.Backend.Objects module ArithmeticOperations = - let byteSumOption = - <@ fun (x: byte option) (y: byte option) -> - let mutable res = 0 - - let xInt = - match x with - | Some x -> Some(int x) - | None -> None - - let yInt = - match y with - | Some y -> Some(int y) - | None -> None - - match xInt, yInt with - | Some f, Some s -> res <- f + s - | Some f, None -> res <- f - | None, Some s -> res <- s - | None, None -> () - - let byteRes = byte res - - if byteRes = 0uy then - None - else - Some byteRes @> - - let byteMulOption = - <@ fun (x: byte option) (y: byte option) -> - let mutable res = 0 - - let xInt = - match x with - | Some x -> Some(int x) - | None -> None - - let yInt = - match y with - | Some y -> Some(int y) - | None -> None - - match xInt, yInt with - | Some f, Some s -> res <- f * s - | _ -> () - - let byteRes = byte res - - if byteRes = 0uy then - None - else - Some byteRes @> - let inline mkUnaryOp zero unaryOp = <@ fun x -> let mutable res = zero @@ -108,6 +56,33 @@ module ArithmeticOperations = if res = zero then None else Some res @> + let byteSumOption = + <@ fun (x: byte option) (y: byte option) -> + let mutable res = 0 + + let xInt = + match x with + | Some x -> Some(int x) + | None -> None + + let yInt = + match y with + | Some y -> Some(int y) + | None -> None + + match xInt, yInt with + | Some f, Some s -> res <- f + s + | Some f, None -> res <- f + | None, Some s -> res <- s + | None, None -> () + + let byteRes = byte res + + if byteRes = 0uy then + None + else + Some byteRes @> + let boolSumOption = <@ fun (x: bool option) (y: bool option) -> let mutable res = false @@ -137,6 +112,31 @@ module ArithmeticOperations = let floatSumAtLeastOne = mkNumericSumAtLeastOne 0.0 let float32SumAtLeastOne = mkNumericSumAtLeastOne 0f + let byteMulOption = + <@ fun (x: byte option) (y: byte option) -> + let mutable res = 0 + + let xInt = + match x with + | Some x -> Some(int x) + | None -> None + + let yInt = + match y with + | Some y -> Some(int y) + | None -> None + + match xInt, yInt with + | Some f, Some s -> res <- f * s + | _ -> () + + let byteRes = byte res + + if byteRes = 0uy then + None + else + Some byteRes @> + let boolMulOption = <@ fun (x: bool option) (y: bool option) -> let mutable res = false @@ -154,7 +154,6 @@ module ArithmeticOperations = mkUnaryOp zero <@ fun x -> x * constant @> let intMulOption = mkNumericMul 0 - // let byteMulOption = mkNumericMul 0uy let floatMulOption = mkNumericMul 0.0 let float32MulOption = mkNumericMul 0f From 3cbc08864dde22f900ec57f0db0dd01d500f1af1 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Fri, 12 May 2023 20:54:14 +0300 Subject: [PATCH 141/143] refactor: add clarifying comments --- src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 18180132..594443fd 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -60,6 +60,7 @@ module ArithmeticOperations = <@ fun (x: byte option) (y: byte option) -> let mutable res = 0 + // Converted to int because of Quotations Evaluator issue. let xInt = match x with | Some x -> Some(int x) @@ -116,6 +117,7 @@ module ArithmeticOperations = <@ fun (x: byte option) (y: byte option) -> let mutable res = 0 + // Converted to int because of Quotations Evaluator issue. let xInt = match x with | Some x -> Some(int x) From a420aab57cf5f0b932624a09023265035bb9b15a Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Fri, 12 May 2023 22:39:03 +0300 Subject: [PATCH 142/143] refactor: kronecker --- src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 7579e5d6..a6c2b077 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -208,10 +208,10 @@ module internal Map = let result = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free queue + values.Free queue + rows.Free queue + columns.Free queue result |> Option.map From 372aa56eab3f5e6ca7a912fed0dcbd11a1359355 Mon Sep 17 00:00:00 2001 From: artemiipatov Date: Tue, 16 May 2023 13:22:51 +0300 Subject: [PATCH 143/143] refactor: remove commented code --- src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 594443fd..f7d51a89 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -101,7 +101,6 @@ module ArithmeticOperations = mkUnaryOp zero <@ fun x -> x + constant @> let intSumOption = mkNumericSum 0 - // let byteSumOption = mkNumericSum 0uy let floatSumOption = mkNumericSum 0.0 let float32SumOption = mkNumericSum 0f