Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 34 additions & 18 deletions src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs
Original file line number Diff line number Diff line change
Expand Up @@ -81,8 +81,7 @@ module CSRMatrix =

let eWiseAdd (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize =

let toCOOInplaceLeft = toCOOInplace clContext workGroupSize
let toCOOInplaceRight = toCOOInplace clContext workGroupSize
let prepareRows = prepareRows clContext workGroupSize

let eWiseCOO =
COOMatrix.eWiseAdd clContext opAdd workGroupSize
Expand All @@ -91,24 +90,32 @@ module CSRMatrix =
COOMatrix.toCSRInplace clContext workGroupSize

fun (processor: MailboxProcessor<_>) (m1: CSRMatrix<'a>) (m2: CSRMatrix<'b>) ->

let m1COO = toCOOInplaceLeft processor m1
let m2COO = toCOOInplaceRight processor m2
let m1COO =
{ Context = clContext
RowCount = m1.RowCount
ColumnCount = m1.ColumnCount
Rows = prepareRows processor m1.RowPointers m1.Values.Length m1.RowCount
Columns = m1.Columns
Values = m1.Values }

let m2COO =
{ Context = clContext
RowCount = m2.RowCount
ColumnCount = m2.ColumnCount
Rows = prepareRows processor m2.RowPointers m2.Values.Length m2.RowCount
Columns = m2.Columns
Values = m2.Values }

let m3COO = eWiseCOO processor m1COO m2COO

processor.Post(Msg.CreateFreeMsg(m1COO.Rows))
processor.Post(Msg.CreateFreeMsg(m2COO.Rows))

let m3 = toCSRInplace processor m3COO
processor.Post(Msg.CreateFreeMsg(m3COO.Rows))

m3
toCSRInplace processor m3COO

let eWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr<AtLeastOne<'a, 'b> -> 'c option>) workGroupSize =

let toCOOInplaceLeft = toCOOInplace clContext workGroupSize
let toCOOInplaceRight = toCOOInplace clContext workGroupSize
let prepareRows = prepareRows clContext workGroupSize

let eWiseCOO =
COOMatrix.eWiseAddAtLeastOne clContext opAdd workGroupSize
Expand All @@ -117,19 +124,28 @@ module CSRMatrix =
COOMatrix.toCSRInplace clContext workGroupSize

fun (processor: MailboxProcessor<_>) (m1: CSRMatrix<'a>) (m2: CSRMatrix<'b>) ->

let m1COO = toCOOInplaceLeft processor m1
let m2COO = toCOOInplaceRight processor m2
let m1COO =
{ Context = clContext
RowCount = m1.RowCount
ColumnCount = m1.ColumnCount
Rows = prepareRows processor m1.RowPointers m1.Values.Length m1.RowCount
Columns = m1.Columns
Values = m1.Values }

let m2COO =
{ Context = clContext
RowCount = m2.RowCount
ColumnCount = m2.ColumnCount
Rows = prepareRows processor m2.RowPointers m2.Values.Length m2.RowCount
Columns = m2.Columns
Values = m2.Values }

let m3COO = eWiseCOO processor m1COO m2COO

processor.Post(Msg.CreateFreeMsg(m1COO.Rows))
processor.Post(Msg.CreateFreeMsg(m2COO.Rows))

let m3 = toCSRInplace processor m3COO
processor.Post(Msg.CreateFreeMsg(m3COO.Rows))

m3
toCSRInplace processor m3COO

let transposeInplace (clContext: ClContext) workGroupSize =

Expand Down
35 changes: 33 additions & 2 deletions src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,11 @@ module Matrix =

MatrixCSR res

/// <summary>
/// Creates a new matrix, represented in CSR format, that is equal to the given one.
/// </summary>
///<param name="clContext">OpenCL context.</param>
///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
let toCSR (clContext: ClContext) workGroupSize =
let toCSR = COOMatrix.toCSR clContext workGroupSize
let copy = copy clContext workGroupSize
Expand All @@ -45,6 +50,12 @@ module Matrix =
| MatrixCOO m -> toCSR processor m |> MatrixCSR
| MatrixCSR _ -> copy processor matrix

/// <summary>
/// Returns the matrix, represented in CSR format, that is equal to the given one.
/// The given matrix should neither be used afterwards nor be disposed.
/// </summary>
///<param name="clContext">OpenCL context.</param>
///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
let toCSRInplace (clContext: ClContext) workGroupSize =
let toCSRInplace =
COOMatrix.toCSRInplace clContext workGroupSize
Expand All @@ -54,6 +65,11 @@ module Matrix =
| MatrixCOO m -> toCSRInplace processor m |> MatrixCSR
| MatrixCSR _ -> matrix

/// <summary>
/// Creates a new matrix, represented in COO format, that is equal to the given one.
/// </summary>
///<param name="clContext">OpenCL context.</param>
///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
let toCOO (clContext: ClContext) workGroupSize =
let toCOO = CSRMatrix.toCOO clContext workGroupSize
let copy = copy clContext workGroupSize
Expand All @@ -63,6 +79,12 @@ module Matrix =
| MatrixCOO _ -> copy processor matrix
| MatrixCSR m -> toCOO processor m |> MatrixCOO

/// <summary>
/// Returns the matrix, represented in COO format, that is equal to the given one.
/// The given matrix should neither be used afterwards nor be disposed.
/// </summary>
///<param name="clContext">OpenCL context.</param>
///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
let toCOOInplace (clContext: ClContext) workGroupSize =
let toCOOInplace =
CSRMatrix.toCOOInplace clContext workGroupSize
Expand Down Expand Up @@ -98,7 +120,12 @@ module Matrix =
| MatrixCSR m1, MatrixCSR m2 -> CSReWiseAdd processor m1 m2 |> MatrixCSR
| _ -> failwith "Matrix formats are not matching"


/// <summary>
/// Transposes the given matrix and returns result. The storage format is preserved.
/// The given matrix should neither be used afterwards nor be disposed.
/// </summary>
///<param name="clContext">OpenCL context.</param>
///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
let transposeInplace (clContext: ClContext) workGroupSize =
let COOtransposeInplace =
COOMatrix.transposeInplace clContext workGroupSize
Expand All @@ -111,7 +138,11 @@ module Matrix =
| MatrixCOO m -> COOtransposeInplace processor m |> MatrixCOO
| MatrixCSR m -> CSRtransposeInplace processor m |> MatrixCSR


/// <summary>
/// Transposes the given matrix and returns result as a new matrix. The storage format is preserved.
/// </summary>
///<param name="clContext">OpenCL context.</param>
///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
let transpose (clContext: ClContext) workGroupSize =
let COOtranspose =
COOMatrix.transpose clContext workGroupSize
Expand Down
2 changes: 1 addition & 1 deletion src/GraphBLAS-sharp/Objects/Matrix.fs
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ namespace GraphBLAS.FSharp
open Brahma.FSharp
open GraphBLAS.FSharp.Backend

type MatrixFromat =
type MatrixFormat =
| CSR
| COO

Expand Down
72 changes: 23 additions & 49 deletions tests/GraphBLAS-sharp.Tests/BackendCommonTests/BitonicSortTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -6,35 +6,19 @@ open Expecto.Logging.Message
open GraphBLAS.FSharp.Backend.Common
open Brahma.FSharp
open GraphBLAS.FSharp.Tests.Utils
open OpenCL.Net

let logger = Log.create "BitonicSort.Tests"

let testContext =
""
|> avaliableContexts
|> Seq.filter
(fun context ->
let mutable e = ErrorCode.Unknown
let device = context.ClContext.ClDevice.Device

let deviceType =
Cl
.GetDeviceInfo(device, DeviceInfo.Type, &e)
.CastTo<DeviceType>()

deviceType = DeviceType.Gpu)
|> Seq.tryHead

let makeTest (context: ClContext) (q: MailboxProcessor<_>) sort (filter: 'a -> bool) (array: ('n * 'n * 'a) []) =
let makeTest (context: ClContext) (q: MailboxProcessor<_>) sort (array: ('n * 'n * 'a) []) =
if array.Length > 0 then
let projection (row: 'n) (col: 'n) (v: 'a) = row, col

let rows, cols, vals =
array
|> Array.distinctBy ((<|||) projection)
|> Array.filter (fun (_, _, v) -> filter v)
|> Array.unzip3
logger.debug (
eventX "Initial size is {size}"
>> setField "size" (sprintf "%A" array.Length)
)

let rows, cols, vals = Array.unzip3 array

use clRows = context.CreateClArray rows
use clCols = context.CreateClArray cols
Expand All @@ -55,56 +39,46 @@ let makeTest (context: ClContext) (q: MailboxProcessor<_>) sort (filter: 'a -> b

rows, cols, vals

logger.debug (
eventX "Actual are {actualRows}, {actualCols}, {actualVals}"
>> setField "actualRows" (sprintf "%A" actualRows)
>> setField "actualCols" (sprintf "%A" actualCols)
>> setField "actualVals" (sprintf "%A" actualVals)
)

let expectedRows, expectedCols, expectedVals =
(rows, cols, vals)
|||> Array.zip3
|> Array.sortBy ((<|||) projection)
|> Array.unzip3

(sprintf "Row arrays should be equal. Actual is \n%A, expected \n%A, input is \n%A" actualRows expectedRows rows)
|> Expect.sequenceEqual actualRows expectedRows
|> compareArrays (=) actualRows expectedRows

(sprintf
"Column arrays should be equal. Actual is \n%A, expected \n%A, input is \n%A"
actualCols
expectedCols
cols)
|> Expect.sequenceEqual actualCols expectedCols
|> compareArrays (=) actualCols expectedCols

(sprintf
"Value arrays should be equal. Actual is \n%A, expected \n%A, input is \n%A"
actualVals
expectedVals
vals)
|> Expect.sequenceEqual actualVals expectedVals
|> compareArrays (=) actualVals expectedVals

let testFixtures<'a when 'a: equality> config wgSize context q filter =
let testFixtures<'a when 'a: equality> config wgSize context q =
let sort: MailboxProcessor<_> -> ClArray<int> -> ClArray<int> -> ClArray<'a> -> unit =
BitonicSort.sortKeyValuesInplace context wgSize

makeTest context q sort filter
makeTest context q sort
|> testPropertyWithConfig config (sprintf "Correctness on %A" typeof<'a>)

let tests =
match testContext with
| Some c ->
let context = c.ClContext
let config = defaultConfig

let wgSize = 128
let q = c.Queue
q.Error.Add(fun e -> failwithf "%A" e)

[ testFixtures<int> config wgSize context q (fun _ -> true)
testFixtures<float> config wgSize context q (System.Double.IsNaN >> not)
testFixtures<byte> config wgSize context q (fun _ -> true)
testFixtures<bool> config wgSize context q (fun _ -> true) ]
| _ -> []
let context = defaultContext.ClContext
let config = { defaultConfig with endSize = 1000000 }

let wgSize = 32
let q = defaultContext.Queue
q.Error.Add(fun e -> failwithf "%A" e)

[ testFixtures<int> config wgSize context q
testFixtures<float> config wgSize context q
testFixtures<byte> config wgSize context q
testFixtures<bool> config wgSize context q ]
|> testList "Backend.Common.BitonicSort tests"
28 changes: 14 additions & 14 deletions tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -12,11 +12,10 @@ open OpenCL.Net

let logger = Log.create "Convert.Tests"

let context = defaultContext.ClContext
let config = defaultConfig
let wgSize = 128
let wgSize = 32

let makeTestCSR q toCOO isZero (array: 'a [,]) =
let makeTestCSR context q toCOO isZero (array: 'a [,]) =
let mtx = createMatrixFromArray2D CSR array isZero

if mtx.NNZCount > 0 then
Expand All @@ -38,7 +37,7 @@ let makeTestCSR q toCOO isZero (array: 'a [,]) =
"Matrices should be equal"
|> Expect.equal actual expected

let makeTestCOO q toCSR isZero (array: 'a [,]) =
let makeTestCOO context q toCSR isZero (array: 'a [,]) =
let mtx = createMatrixFromArray2D COO array isZero

if mtx.NNZCount > 0 then
Expand Down Expand Up @@ -68,49 +67,50 @@ let testFixtures case =
System.Double.IsNaN x
|| abs x < Accuracy.medium.absolute

let q = defaultContext.Queue
let context = case.ClContext.ClContext
let q = case.ClContext.Queue
q.Error.Add(fun e -> failwithf "%A" e)

match case.MatrixCase with
| COO ->
[ let toCSR = Matrix.toCSR context wgSize

makeTestCOO q toCSR ((=) 0)
makeTestCOO context q toCSR ((=) 0)
|> testPropertyWithConfig config (getCorrectnessTestName "int")

let toCSR = Matrix.toCSR context wgSize

makeTestCOO q toCSR filterFloat
makeTestCOO context q toCSR filterFloat
|> testPropertyWithConfig config (getCorrectnessTestName "float")

let toCSR = Matrix.toCSR context wgSize

makeTestCOO q toCSR ((=) 0uy)
makeTestCOO context q toCSR ((=) 0uy)
|> testPropertyWithConfig config (getCorrectnessTestName "byte")

let toCSR = Matrix.toCSR context wgSize

makeTestCOO q toCSR ((=) false)
makeTestCOO context q toCSR ((=) false)
|> testPropertyWithConfig config (getCorrectnessTestName "bool") ]
| CSR ->
[ let toCOO = Matrix.toCOO context wgSize

makeTestCSR q toCOO ((=) 0)
makeTestCSR context q toCOO ((=) 0)
|> testPropertyWithConfig config (getCorrectnessTestName "int")

let toCOO = Matrix.toCOO context wgSize

makeTestCSR q toCOO filterFloat
makeTestCSR context q toCOO filterFloat
|> testPropertyWithConfig config (getCorrectnessTestName "float")

let toCOO = Matrix.toCOO context wgSize

makeTestCSR q toCOO ((=) 0uy)
makeTestCSR context q toCOO ((=) 0uy)
|> testPropertyWithConfig config (getCorrectnessTestName "byte")

let toCOO = Matrix.toCOO context wgSize

makeTestCSR q toCOO ((=) false)
makeTestCSR context q toCOO ((=) false)
|> testPropertyWithConfig config (getCorrectnessTestName "bool") ]

let tests =
Expand All @@ -126,6 +126,6 @@ let tests =
.CastTo<DeviceType>()

deviceType = DeviceType.Gpu)
|> List.distinctBy (fun case -> case.MatrixCase)
|> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.MatrixCase)
|> List.collect testFixtures
|> testList "Convert tests"
Loading