From e74ed9e184f5baef64e7a634ef08f93057f32c08 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Oct 2022 19:03:34 +0300 Subject: [PATCH 01/74] add: Vector, refactor: Utils --- src/GraphBLAS-sharp.Backend/Common/Utils.fs | 8 + .../GraphBLAS-sharp.Backend.fsproj | 1 + src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 188 ++++++++++++++++++ 3 files changed, 197 insertions(+) create mode 100644 src/GraphBLAS-sharp.Backend/Objects/Vector.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Utils.fs b/src/GraphBLAS-sharp.Backend/Common/Utils.fs index a110ff2b..1c70d5b3 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Utils.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Utils.fs @@ -1,6 +1,10 @@ namespace GraphBLAS.FSharp.Backend.Common +open Brahma.FSharp + module internal Utils = + let defaultWorkGroupSize = 32 + let floorToPower2 = fun x -> x ||| (x >>> 1) >> fun x -> x ||| (x >>> 2) @@ -17,3 +21,7 @@ module internal Utils = >> fun x -> x ||| (x >>> 8) >> fun x -> x ||| (x >>> 16) >> fun x -> x + 1 + + let toHost (processor: MailboxProcessor<_>) (src: ClArray<_>) = + let dst = Array.zeroCreate src.Length + processor.PostAndReply(fun ch -> Msg.CreateToHostMsg(src, dst, ch)) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 335f0083..3fe27a5e 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -24,6 +24,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs new file mode 100644 index 00000000..d7a442d3 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -0,0 +1,188 @@ +namespace GraphBLAS.FSharp.Backend + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend + +type VectorFormat = + | COO + | Dense + +type COOVector<'a> = + { Size: int + Indices: int [] + Values: 'a [] } + + override this.ToString() = + [ sprintf "Sparse Vector\n" + sprintf "Size: %i \n" this.Size + sprintf "Indices: %A \n" this.Indices + sprintf "Values: %A \n" this.Values ] + |> String.concat "" + + member this.ToDevice(context: ClContext) = + let indices = context.CreateClArray this.Indices + let values = context.CreateClArray this.Values + + { Context = context + Size = this.Size + Indices = indices + Values = values } + + static member FromTuples(size: int, indices: int [], values: 'a []) = + { Size = size + Indices = indices + Values = values } + + static member FromArray(array: 'a [], isZero: 'a -> bool) = + let (indices, vals) = + array + |> Seq.cast<'a> + |> Seq.mapi (fun idx v -> (idx, v)) + |> Seq.filter (fun (_, v) -> not (isZero v)) + |> Array.ofSeq + |> Array.unzip + + COOVector.FromTuples(array.Length, indices, vals) + +and ClCooVector<'a> = + { Context: ClContext + Size: int + Indices: ClArray + Values: ClArray<'a> } + + member this.ToHost(q: MailboxProcessor<_>) = + let indices = Array.zeroCreate this.Indices.Length + let values = Array.zeroCreate this.Values.Length + + let _ = + q.Post(Msg.CreateToHostMsg(this.Indices, indices)) + + let _ = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, values, ch)) + + { Size = this.Size + Indices = indices + Values = values } + + interface IDeviceMemObject with + member this.Dispose(q) = + q.Post(Msg.CreateFreeMsg<_>(this.Values)) + q.Post(Msg.CreateFreeMsg<_>(this.Indices)) + q.PostAndReply(Msg.MsgNotifyMe) + + member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + +type DenseVector<'a> = + { Size: int + Values: 'a [] } + + override this.ToString() = + [ sprintf "Dense Vector\n" + sprintf "Size: %i \n" this.Size + sprintf "Values: %A \n" this.Values ] + |> String.concat "" + + member this.ToDevice(context: ClContext) = + let values = context.CreateClArray this.Values + + { Context = context + Size = this.Size + Values = values } + + static member FromArray(array: 'a []) = { Size = array.Length; Values = array } + +and ClDenseVector<'a> = + { Context: ClContext + Size: int + Values: ClArray<'a> } + + member this.ToHost(q: MailboxProcessor<_>) = + let values = Array.zeroCreate this.Values.Length + + let _ = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, values, ch)) + + { Size = this.Size; Values = values } + + interface IDeviceMemObject with + member this.Dispose(q) = + q.Post(Msg.CreateFreeMsg<_>(this.Values)) + q.PostAndReply(Msg.MsgNotifyMe) + + member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + +type TuplesVector<'a> = + { Indices: int [] + Values: 'a [] } + + override this.ToString() = + [ sprintf "Tuples Vector\n" + sprintf "Indices: %A \n" this.Indices + sprintf "Values: %A \n" this.Values ] + |> String.concat "" + + member this.ToDevice(context: ClContext) = + let indices = context.CreateClArray this.Indices + let values = context.CreateClArray this.Values + + { Context = context + Indices = indices + Values = values } + + static member FromTuples(indices: int [], values: 'a []) = { Indices = indices; Values = values } + +and ClTuplesVector<'a> = + { Context: ClContext + Indices: ClArray + Values: ClArray<'a> } + + member this.ToHost(q: MailboxProcessor<_>) = + let indices = Array.zeroCreate this.Indices.Length + let values = Array.zeroCreate this.Values.Length + + let _ = + q.Post(Msg.CreateToHostMsg(this.Indices, indices)) + + let _ = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, values, ch)) + + { Indices = indices; Values = values } + + interface IDeviceMemObject with + member this.Dispose(q) = + q.Post(Msg.CreateFreeMsg<_>(this.Values)) + q.Post(Msg.CreateFreeMsg<_>(this.Indices)) + q.PostAndReply(Msg.MsgNotifyMe) + + member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + +type Vector<'a when 'a: struct> = + | VectorCOO of COOVector<'a> + | VectorDense of DenseVector<'a> + member this.Size = + match this with + | VectorCOO vector -> vector.Size + | VectorDense vector -> vector.Size + + member this.ToDevice(context: ClContext) = + match this with + | VectorCOO vector -> ClVectorCOO <| vector.ToDevice(context) + | VectorDense vector -> ClVectorDense <| vector.ToDevice(context) + +and ClVector<'a when 'a: struct> = + | ClVectorCOO of ClCooVector<'a> + | ClVectorDense of ClDenseVector<'a> + member this.Size = + match this with + | ClVectorCOO vector -> vector.Size + | ClVectorDense vector -> vector.Size + + member this.ToHost(q: MailboxProcessor<_>) = + match this with + | ClVectorCOO vector -> VectorCOO <| vector.ToHost(q) + | ClVectorDense vector -> VectorDense <| vector.ToHost(q) + + member this.Dispose(q) = + match this with + | ClVectorCOO vector -> vector.Dispose(q) + | ClVectorDense vector -> vector.Dispose(q) From cfa3920c5769e9b29d4d6e76e109ab27d890900c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Oct 2022 19:17:49 +0300 Subject: [PATCH 02/74] add: zeroCreate, ofList vector funcs --- .../GraphBLAS-sharp.Backend.fsproj | 1 + src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 35 +++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/Vector.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 3fe27a5e..a01477c7 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -25,6 +25,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs new file mode 100644 index 00000000..63f1af09 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -0,0 +1,35 @@ +namespace GraphBLAS.FSharp.Backend + +module Vector = + let zeroCreate<'a when 'a : struct> (format: VectorFormat) (size: int) : Vector<'a> = + match format with + | COO -> + VectorCOO + <| COOVector.FromTuples(size, [||], [||]) + | Dense -> + Array.zeroCreate size + |> DenseVector.FromArray + |> VectorDense + + let ofList (format: VectorFormat) (size: int) (elements: (int * 'a) list) : Vector<'a> = + let (indices, values) = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip + + match format with + | COO -> + VectorCOO + <| COOVector.FromTuples(size, indices, values) + | Dense -> + values + |> DenseVector.FromArray + |> VectorDense + + + + + + + From f7f40c8b8ecafb91bf4e2912fae82729286c31ed Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Oct 2022 19:59:01 +0300 Subject: [PATCH 03/74] separate: Vector opearations --- .../GraphBLAS-sharp.Backend.fsproj | 2 + src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 59 ++++++++++--------- .../Vector/COOVector/COOVector.fs | 17 ++++++ .../Vector/DenseVector/DenseVector.fs | 17 ++++++ src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 31 ++-------- .../BackendCommonTests/VectorTest.fs | 8 +++ .../GraphBLAS-sharp.Tests.fsproj | 1 + 7 files changed, 82 insertions(+), 53 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs create mode 100644 src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs create mode 100644 tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index a01477c7..63483a7c 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -26,6 +26,8 @@ + + diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index d7a442d3..dd3c9c30 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -8,10 +8,11 @@ type VectorFormat = | Dense type COOVector<'a> = - { Size: int - Indices: int [] + { Indices: int [] Values: 'a [] } + member this.Size = this.Indices.Length + override this.ToString() = [ sprintf "Sparse Vector\n" sprintf "Size: %i \n" this.Size @@ -24,14 +25,10 @@ type COOVector<'a> = let values = context.CreateClArray this.Values { Context = context - Size = this.Size Indices = indices Values = values } - static member FromTuples(size: int, indices: int [], values: 'a []) = - { Size = size - Indices = indices - Values = values } + static member FromTuples(indices: int [], values: 'a []) = { Indices = indices; Values = values } static member FromArray(array: 'a [], isZero: 'a -> bool) = let (indices, vals) = @@ -42,14 +39,15 @@ type COOVector<'a> = |> Array.ofSeq |> Array.unzip - COOVector.FromTuples(array.Length, indices, vals) + COOVector.FromTuples(indices, vals) and ClCooVector<'a> = { Context: ClContext - Size: int Indices: ClArray Values: ClArray<'a> } + member this.Size = this.Indices.Length + member this.ToHost(q: MailboxProcessor<_>) = let indices = Array.zeroCreate this.Indices.Length let values = Array.zeroCreate this.Values.Length @@ -60,9 +58,7 @@ and ClCooVector<'a> = let _ = q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, values, ch)) - { Size = this.Size - Indices = indices - Values = values } + { Indices = indices; Values = values } interface IDeviceMemObject with member this.Dispose(q) = @@ -73,44 +69,47 @@ and ClCooVector<'a> = member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) type DenseVector<'a> = - { Size: int - Values: 'a [] } + { Values: 'a option [] } + + member this.Size = this.Values.Length override this.ToString() = [ sprintf "Dense Vector\n" - sprintf "Size: %i \n" this.Size + sprintf "Size: %i \n" this.Values.Length sprintf "Values: %A \n" this.Values ] |> String.concat "" member this.ToDevice(context: ClContext) = - let values = context.CreateClArray this.Values + context.CreateClArray this.Values :?> ClDenseVector<'a> - { Context = context - Size = this.Size - Values = values } - - static member FromArray(array: 'a []) = { Size = array.Length; Values = array } + static member FromArray(array: 'a [], isZero: 'a -> bool) = + { Values = + array + |> Array.map (fun v -> if isZero v then None else Some v) } and ClDenseVector<'a> = - { Context: ClContext - Size: int - Values: ClArray<'a> } + inherit ClArray<'a option> + + member this.Size = this.Length member this.ToHost(q: MailboxProcessor<_>) = - let values = Array.zeroCreate this.Values.Length + let vector = Array.zeroCreate this.Length let _ = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, values, ch)) + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, vector, ch)) - { Size = this.Size; Values = values } + { Values = vector } interface IDeviceMemObject with member this.Dispose(q) = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) + q.Post(Msg.CreateFreeMsg<_>(this)) q.PostAndReply(Msg.MsgNotifyMe) member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + static member FromArray(context: ClContext, array: 'a option []) = + context.CreateClArray array :?> ClDenseVector<'a> + type TuplesVector<'a> = { Indices: int [] Values: 'a [] } @@ -121,6 +120,8 @@ type TuplesVector<'a> = sprintf "Values: %A \n" this.Values ] |> String.concat "" + member this.Size = this.Indices.Length + member this.ToDevice(context: ClContext) = let indices = context.CreateClArray this.Indices let values = context.CreateClArray this.Values @@ -136,6 +137,8 @@ and ClTuplesVector<'a> = Indices: ClArray Values: ClArray<'a> } + member this.Size = this.Indices.Length + member this.ToHost(q: MailboxProcessor<_>) = let indices = Array.zeroCreate this.Indices.Length let values = Array.zeroCreate this.Values.Length diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs new file mode 100644 index 00000000..6e78e4ab --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -0,0 +1,17 @@ +namespace GraphBLAS.FSharp.Backend + +open + +module COOVector = + let zeroCreate<'a when 'a : struct> : Vector<'a> = + VectorCOO <| COOVector.FromTuples([||], [||]) + + let ofList (elements: (int * 'a) list) : Vector<'a> = + let (indices, values) = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip + + VectorCOO + <| COOVector.FromTuples(indices, values) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs new file mode 100644 index 00000000..d07418ef --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -0,0 +1,17 @@ +namespace GraphBLAS.FSharp.Backend + +module DenseVector = + let zeroCreate<'a when 'a : struct> (size: int) : Vector<'a> = + DenseVector.FromArray (Array.zeroCreate size, fun _ -> true) + |> VectorDense + + let ofList (elements: (int * 'a) list) (isZero: 'a -> bool) : Vector<'a> = + let (indices, values) = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip + + (values, isZero) + |> DenseVector.FromArray + |> VectorDense diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 63f1af09..a516a8e6 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -1,31 +1,12 @@ namespace GraphBLAS.FSharp.Backend + module Vector = - let zeroCreate<'a when 'a : struct> (format: VectorFormat) (size: int) : Vector<'a> = - match format with - | COO -> - VectorCOO - <| COOVector.FromTuples(size, [||], [||]) - | Dense -> - Array.zeroCreate size - |> DenseVector.FromArray - |> VectorDense - - let ofList (format: VectorFormat) (size: int) (elements: (int * 'a) list) : Vector<'a> = - let (indices, values) = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip - - match format with - | COO -> - VectorCOO - <| COOVector.FromTuples(size, indices, values) - | Dense -> - values - |> DenseVector.FromArray - |> VectorDense + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs new file mode 100644 index 00000000..e01dfa70 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs @@ -0,0 +1,8 @@ +module GraphBLAS.Sharp.Tests.BackendCommonTests.VectorTest + +open GraphBLAS.FSharp.Backend + +let vector = Vector.zeroCreate VectorFormat.COO 3 + + + diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 11b3c161..322a92a9 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -20,6 +20,7 @@ + From 816b4f74b2186c13d0a746d101b73c142d6c0cdf Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Oct 2022 18:14:12 +0300 Subject: [PATCH 04/74] add: DenseVector.mask --- .../GraphBLAS-sharp.Backend.fsproj | 2 +- .../Vector/COOVector/COOVector.fs | 5 +- .../Vector/DenseVector/DenseVector.fs | 171 +++++++++++++++++- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 12 -- 4 files changed, 174 insertions(+), 16 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 63483a7c..dd73ccbe 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -25,9 +25,9 @@ - + diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 6e78e4ab..592f386f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -1,7 +1,5 @@ namespace GraphBLAS.FSharp.Backend -open - module COOVector = let zeroCreate<'a when 'a : struct> : Vector<'a> = VectorCOO <| COOVector.FromTuples([||], [||]) @@ -15,3 +13,6 @@ module COOVector = VectorCOO <| COOVector.FromTuples(indices, values) + + + diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index d07418ef..c8da0510 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -1,12 +1,16 @@ namespace GraphBLAS.FSharp.Backend +open Brahma.FSharp +open GraphBLAS.FSharp.Backend +open Microsoft.FSharp.Control + module DenseVector = let zeroCreate<'a when 'a : struct> (size: int) : Vector<'a> = DenseVector.FromArray (Array.zeroCreate size, fun _ -> true) |> VectorDense let ofList (elements: (int * 'a) list) (isZero: 'a -> bool) : Vector<'a> = - let (indices, values) = + let (_, values) = elements |> Array.ofList |> Array.sortBy fst @@ -15,3 +19,168 @@ module DenseVector = (values, isZero) |> DenseVector.FromArray |> VectorDense + + let getBitmap (clContext: ClContext) (workGroupSize: int) = + let getBitmap = + <@ + fun (range: Range1D) (vector: ClArray<'a option>) (vectorSize: int) (bitmap: ClArray) -> + let gid = range.GlobalID0 + + if gid < vectorSize then + match vector[gid] with + | None -> bitmap[gid] <- 0 + | Some _ -> () + @> + + let kernel = clContext.Compile(getBitmap) + + fun (processor: MailboxProcessor<_>) (vector: DenseVector<'a>) -> + let vectorSize = vector.Size + + let bitmap = Array.create vectorSize 1 + let clBitmap = clContext.CreateClArray bitmap + + let clVector = vector.ToDevice clContext + + let ndRange = Range1D.CreateValid(vectorSize, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + clVector + vectorSize + clBitmap) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + clBitmap + + let unzip (clContext: ClContext) (workGroupSize: int) = + let getMask = + <@ + fun (ndRange: Range1D) vectorLength (bitmap: ClArray) (vector: ClArray<'a option>) (prefixSumArray: ClArray) (valueArray: ClArray<'a option>) (indicesArray: ClArray ) -> + let gid = ndRange.GlobalID0 + + if gid < vectorLength then + if bitmap[gid] = 1 then + let resultIndex = prefixSumArray[gid] + + valueArray[resultIndex] <- vector[gid] + indicesArray[resultIndex] <- gid + @> + + let kernel = clContext.Compile(getMask) + + let sum = ClArray.prefixSumExcludeInplace clContext workGroupSize + + let resultLength = Array.zeroCreate 1 + + let getBitmap = getBitmap clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: DenseVector<'a>) -> + let positions = getBitmap processor vector + + let clVector = vector.ToDevice clContext + + let prefixSumArrayLength = positions.Length + + let resultLengthGpu = clContext.CreateClCell 0 + + let prefixSumArray, r = sum processor positions resultLengthGpu + + let resultLength = + let res = + processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(r, resultLength, ch)) + + processor.Post(Msg.CreateFreeMsg<_>(r)) + + res.[0] + + let ndRange = + Range1D.CreateValid(positions.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + let resultValues = + clContext.CreateClArray( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + let resultIndices = + clContext.CreateClArray( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + prefixSumArrayLength + positions + clVector + prefixSumArray + resultValues + resultIndices) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultValues, resultIndices + + let mask (clContext: ClContext) (workGroupSize: int) = + let toOptionIndices = + <@ + fun (ndRange: Range1D) length (indices: ClArray) (resultArray: ClArray) -> + let gid = ndRange.GlobalID0 + + if gid < length then + resultArray[gid] <- Some indices[gid] + @> + + let kernel = clContext.Compile(toOptionIndices) + + let unzip = unzip clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: DenseVector<'a>) -> + let _, indices = unzip processor vector + + let resultLength = indices.Length + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + let resultIndices = + clContext.CreateClArray( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + indices + resultIndices) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultIndices :?> ClDenseVector diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index a516a8e6..0503cdc9 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -1,16 +1,4 @@ namespace GraphBLAS.FSharp.Backend - module Vector = - - - - - - - - - - - From e99607714b538dd956afc3eff0c9c2fb90c6e413 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Oct 2022 18:46:49 +0300 Subject: [PATCH 05/74] add: toOptionArray --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 44 ++++++++++++++ .../Vector/COOVector/COOVector.fs | 4 ++ .../Vector/DenseVector/DenseVector.fs | 58 ++++--------------- 3 files changed, 58 insertions(+), 48 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 69655267..0bc055c3 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -452,3 +452,47 @@ module ClArray = setPositions processor workGroupSize inputArray positions resultLength outputArray + + + let toOptionArray (clContext: ClContext) (workGroupSize: int) = + let toOptionValues = + <@ + fun (ndRange: Range1D) length (array: ClArray<'a>) (resultArray: ClArray<'a option>) -> + let gid = ndRange.GlobalID0 + + if gid < length then + resultArray[gid] <- Some array[gid] + @> + + let kernel = clContext.Compile(toOptionValues) + + fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> + + let resultLength = array.Length + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + let resultArray = + clContext.CreateClArray<'a option>( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + array + resultArray) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultArray diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 592f386f..a0baec95 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -1,5 +1,8 @@ namespace GraphBLAS.FSharp.Backend +open Brahma.FSharp +open GraphBLAS.FSharp.Backend + module COOVector = let zeroCreate<'a when 'a : struct> : Vector<'a> = VectorCOO <| COOVector.FromTuples([||], [||]) @@ -14,5 +17,6 @@ module COOVector = VectorCOO <| COOVector.FromTuples(indices, values) + let mask (clContext: ClContext) (workGroupSize: int) = diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index c8da0510..9639668f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -34,15 +34,14 @@ module DenseVector = let kernel = clContext.Compile(getBitmap) - fun (processor: MailboxProcessor<_>) (vector: DenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> let vectorSize = vector.Size let bitmap = Array.create vectorSize 1 let clBitmap = clContext.CreateClArray bitmap - let clVector = vector.ToDevice clContext - - let ndRange = Range1D.CreateValid(vectorSize, workGroupSize) + let ndRange = + Range1D.CreateValid(vectorSize, workGroupSize) let kernel = kernel.GetKernel() @@ -51,7 +50,7 @@ module DenseVector = (fun () -> kernel.KernelFunc ndRange - clVector + vector vectorSize clBitmap) ) @@ -82,11 +81,9 @@ module DenseVector = let getBitmap = getBitmap clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: DenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> let positions = getBitmap processor vector - let clVector = vector.ToDevice clContext - let prefixSumArrayLength = positions.Length let resultLengthGpu = clContext.CreateClCell 0 @@ -129,7 +126,7 @@ module DenseVector = ndRange prefixSumArrayLength positions - clVector + vector prefixSumArray resultValues resultIndices) @@ -140,47 +137,12 @@ module DenseVector = resultValues, resultIndices let mask (clContext: ClContext) (workGroupSize: int) = - let toOptionIndices = - <@ - fun (ndRange: Range1D) length (indices: ClArray) (resultArray: ClArray) -> - let gid = ndRange.GlobalID0 - - if gid < length then - resultArray[gid] <- Some indices[gid] - @> - - let kernel = clContext.Compile(toOptionIndices) - let unzip = unzip clContext workGroupSize + let toOptionArray = ClArray.toOptionArray clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: DenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> let _, indices = unzip processor vector - let resultLength = indices.Length - - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) - - let kernel = kernel.GetKernel() - - let resultIndices = - clContext.CreateClArray( - resultLength, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, - allocationMode = AllocationMode.Default - ) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - indices - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let optionIndices = toOptionArray processor indices - resultIndices :?> ClDenseVector + optionIndices :?> ClDenseVector From a00be904c838677bb208f4bf3a80f928f84e592d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Oct 2022 18:52:43 +0300 Subject: [PATCH 06/74] add: COOVector.mask --- src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index a0baec95..41789551 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -18,5 +18,7 @@ module COOVector = <| COOVector.FromTuples(indices, values) let mask (clContext: ClContext) (workGroupSize: int) = + let toOptionArray = ClArray.toOptionArray clContext workGroupSize - + fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> + toOptionArray processor vector.Indices From 2f48101a128a5fab6b4e34af6fe938e9b61274e5 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 9 Oct 2022 16:45:09 +0300 Subject: [PATCH 07/74] refactor: DenseVector.getBitmap --- .../Vector/DenseVector/DenseVector.fs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 9639668f..8783f946 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -10,7 +10,7 @@ module DenseVector = |> VectorDense let ofList (elements: (int * 'a) list) (isZero: 'a -> bool) : Vector<'a> = - let (_, values) = + let _, values = elements |> Array.ofList |> Array.sortBy fst @@ -29,7 +29,7 @@ module DenseVector = if gid < vectorSize then match vector[gid] with | None -> bitmap[gid] <- 0 - | Some _ -> () + | _ -> () @> let kernel = clContext.Compile(getBitmap) @@ -38,7 +38,14 @@ module DenseVector = let vectorSize = vector.Size let bitmap = Array.create vectorSize 1 - let clBitmap = clContext.CreateClArray bitmap + + let clBitmap = + clContext.CreateClArray( + bitmap, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) let ndRange = Range1D.CreateValid(vectorSize, workGroupSize) From 97e5cfd71e51e96afe36d06909df321d35d3d140 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 11 Oct 2022 13:11:50 +0300 Subject: [PATCH 08/74] refactor: Vector zeroCreate, ofList --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 39 ++--- src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 46 +++--- .../Vector/COOVector/COOVector.fs | 43 ++++- .../Vector/DenseVector/DenseVector.fs | 152 ++---------------- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 3 - .../BackendCommonTests/VectorTest.fs | 8 - .../GraphBLAS-sharp.Tests.fsproj | 2 +- .../VectorOperationsTests/zeroCreateTests.fs | 15 ++ 8 files changed, 110 insertions(+), 198 deletions(-) delete mode 100644 tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 0bc055c3..eee552e3 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -453,46 +453,35 @@ module ClArray = outputArray - + //TODO(comments) let toOptionArray (clContext: ClContext) (workGroupSize: int) = - let toOptionValues = + let toDense = <@ - fun (ndRange: Range1D) length (array: ClArray<'a>) (resultArray: ClArray<'a option>) -> + fun (ndRange: Range1D) (length: int) (values: ClArray<'a>) (indices: ClArray) (outputArray: ClArray<'a option>) -> let gid = ndRange.GlobalID0 if gid < length then - resultArray[gid] <- Some array[gid] + let resultIndex = indices[gid] + + outputArray[resultIndex] <- Some values[resultIndex] @> - let kernel = clContext.Compile(toOptionValues) + let kernel = clContext.Compile(toDense) - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> + let zeroCreate = zeroCreate clContext workGroupSize - let resultLength = array.Length + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (indices: ClArray) (size: int) -> + let outputArray = zeroCreate processor size - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = Range1D.CreateValid(size, workGroupSize) let kernel = kernel.GetKernel() - let resultArray = - clContext.CreateClArray<'a option>( - resultLength, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, - allocationMode = AllocationMode.Default - ) - processor.Post( Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - array - resultArray) + (fun () -> kernel.KernelFunc ndRange size values indices outputArray) ) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) - resultArray + outputArray diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index dd3c9c30..2c52778e 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -9,9 +9,8 @@ type VectorFormat = type COOVector<'a> = { Indices: int [] - Values: 'a [] } - - member this.Size = this.Indices.Length + Values: 'a [] + Size: int } override this.ToString() = [ sprintf "Sparse Vector\n" @@ -26,9 +25,13 @@ type COOVector<'a> = { Context = context Indices = indices - Values = values } + Values = values + Size = this.Size } - static member FromTuples(indices: int [], values: 'a []) = { Indices = indices; Values = values } + static member FromTuples(indices: int [], values: 'a [], size: int) = + { Indices = indices + Values = values + Size = size } static member FromArray(array: 'a [], isZero: 'a -> bool) = let (indices, vals) = @@ -39,14 +42,13 @@ type COOVector<'a> = |> Array.ofSeq |> Array.unzip - COOVector.FromTuples(indices, vals) + COOVector.FromTuples(indices, vals, array.Length) and ClCooVector<'a> = { Context: ClContext Indices: ClArray - Values: ClArray<'a> } - - member this.Size = this.Indices.Length + Values: ClArray<'a> + Size: int } member this.ToHost(q: MailboxProcessor<_>) = let indices = Array.zeroCreate this.Indices.Length @@ -58,7 +60,9 @@ and ClCooVector<'a> = let _ = q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, values, ch)) - { Indices = indices; Values = values } + { Indices = indices + Values = values + Size = this.Size } interface IDeviceMemObject with member this.Dispose(q) = @@ -112,7 +116,8 @@ and ClDenseVector<'a> = type TuplesVector<'a> = { Indices: int [] - Values: 'a [] } + Values: 'a [] + Size: int } override this.ToString() = [ sprintf "Tuples Vector\n" @@ -120,24 +125,25 @@ type TuplesVector<'a> = sprintf "Values: %A \n" this.Values ] |> String.concat "" - member this.Size = this.Indices.Length - member this.ToDevice(context: ClContext) = let indices = context.CreateClArray this.Indices let values = context.CreateClArray this.Values { Context = context Indices = indices - Values = values } + Values = values + Size = this.Size } - static member FromTuples(indices: int [], values: 'a []) = { Indices = indices; Values = values } + static member FromTuples(indices: int [], values: 'a [], size: int) = + { Indices = indices + Values = values + Size = size } and ClTuplesVector<'a> = { Context: ClContext Indices: ClArray - Values: ClArray<'a> } - - member this.Size = this.Indices.Length + Values: ClArray<'a> + Size: int } member this.ToHost(q: MailboxProcessor<_>) = let indices = Array.zeroCreate this.Indices.Length @@ -149,7 +155,9 @@ and ClTuplesVector<'a> = let _ = q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, values, ch)) - { Indices = indices; Values = values } + { Indices = indices + Values = values + Size = this.Size } interface IDeviceMemObject with member this.Dispose(q) = diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 41789551..d564be13 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -2,23 +2,52 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp open GraphBLAS.FSharp.Backend +open Microsoft.FSharp.Control module COOVector = - let zeroCreate<'a when 'a : struct> : Vector<'a> = - VectorCOO <| COOVector.FromTuples([||], [||]) + let zeroCreate (clContext: ClContext) = + let resultIndices = clContext.CreateClArray [||] + let resultValues = clContext.CreateClArray [||] - let ofList (elements: (int * 'a) list) : Vector<'a> = + { ClCooVector.Context = clContext + Indices = resultIndices + Values = resultValues + Size = 0 } + + let ofList (clContext: ClContext) (elements: (int * 'a) list) = let (indices, values) = elements |> Array.ofList |> Array.sortBy fst |> Array.unzip - VectorCOO - <| COOVector.FromTuples(indices, values) + let resultSize = elements.Length + + let resultIndices = clContext.CreateClArray indices + let resultValues = clContext.CreateClArray values + + { ClCooVector.Context = clContext + Indices = resultIndices + Values = resultValues + Size = resultSize } let mask (clContext: ClContext) (workGroupSize: int) = - let toOptionArray = ClArray.toOptionArray clContext workGroupSize + let copy = ClArray.copy clContext workGroupSize + let copyData = ClArray.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> - toOptionArray processor vector.Indices + let resultIndices = copy processor vector.Indices + + let resultValues = copyData processor vector.Values + + let resultSize = vector.Size + + { ClCooVector.Context = clContext + Indices = resultIndices + Values = resultValues + Size = resultSize } + + (*let fillSubVector (clContext: ClContext) (workGroupSize: int) = + + fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (mask: ClVector<'b>) (scalar: 'c) ->*) + diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 8783f946..7c89213f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -5,151 +5,33 @@ open GraphBLAS.FSharp.Backend open Microsoft.FSharp.Control module DenseVector = - let zeroCreate<'a when 'a : struct> (size: int) : Vector<'a> = - DenseVector.FromArray (Array.zeroCreate size, fun _ -> true) - |> VectorDense + let zeroCreate (clContext: ClContext) (workGroupSize: int) = + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - let ofList (elements: (int * 'a) list) (isZero: 'a -> bool) : Vector<'a> = - let _, values = + fun (processor: MailboxProcessor<_>) (length: int) -> + let resultValues = zeroCreate processor length + + resultValues :?> ClDenseVector<'a> + + let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = + let indices, values = elements |> Array.ofList |> Array.sortBy fst |> Array.unzip - (values, isZero) - |> DenseVector.FromArray - |> VectorDense - - let getBitmap (clContext: ClContext) (workGroupSize: int) = - let getBitmap = - <@ - fun (range: Range1D) (vector: ClArray<'a option>) (vectorSize: int) (bitmap: ClArray) -> - let gid = range.GlobalID0 - - if gid < vectorSize then - match vector[gid] with - | None -> bitmap[gid] <- 0 - | _ -> () - @> - - let kernel = clContext.Compile(getBitmap) - - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> - let vectorSize = vector.Size - - let bitmap = Array.create vectorSize 1 - - let clBitmap = - clContext.CreateClArray( - bitmap, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, - allocationMode = AllocationMode.Default - ) - - let ndRange = - Range1D.CreateValid(vectorSize, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vector - vectorSize - clBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - clBitmap - - let unzip (clContext: ClContext) (workGroupSize: int) = - let getMask = - <@ - fun (ndRange: Range1D) vectorLength (bitmap: ClArray) (vector: ClArray<'a option>) (prefixSumArray: ClArray) (valueArray: ClArray<'a option>) (indicesArray: ClArray ) -> - let gid = ndRange.GlobalID0 - - if gid < vectorLength then - if bitmap[gid] = 1 then - let resultIndex = prefixSumArray[gid] - - valueArray[resultIndex] <- vector[gid] - indicesArray[resultIndex] <- gid - @> - - let kernel = clContext.Compile(getMask) - - let sum = ClArray.prefixSumExcludeInplace clContext workGroupSize - - let resultLength = Array.zeroCreate 1 - - let getBitmap = getBitmap clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> - let positions = getBitmap processor vector - - let prefixSumArrayLength = positions.Length - - let resultLengthGpu = clContext.CreateClCell 0 - - let prefixSumArray, r = sum processor positions resultLengthGpu - - let resultLength = - let res = - processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(r, resultLength, ch)) - - processor.Post(Msg.CreateFreeMsg<_>(r)) - - res.[0] - - let ndRange = - Range1D.CreateValid(positions.Length, workGroupSize) - - let kernel = kernel.GetKernel() - - let resultValues = - clContext.CreateClArray( - resultLength, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, - allocationMode = AllocationMode.Default - ) - - let resultIndices = - clContext.CreateClArray( - resultLength, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, - allocationMode = AllocationMode.Default - ) + let toOptionArray = ClArray.toOptionArray clContext workGroupSize - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - prefixSumArrayLength - positions - vector - prefixSumArray - resultValues - resultIndices) - ) + fun (processor: MailboxProcessor<_>) -> + let values = clContext.CreateClArray values + let indices = clContext.CreateClArray indices - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + toOptionArray processor values indices elements.Length :?> ClDenseVector<'a> - resultValues, resultIndices - let mask (clContext: ClContext) (workGroupSize: int) = - let unzip = unzip clContext workGroupSize - let toOptionArray = ClArray.toOptionArray clContext workGroupSize + (*let mask (clContext: ClContext) (workGroupSize: int) = + let copy = ClArray.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> - let _, indices = unzip processor vector - - let optionIndices = toOptionArray processor indices + copy processor vector :?> ClDenseVector<'a>*) - optionIndices :?> ClDenseVector diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 0503cdc9..7ae757c6 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -1,4 +1 @@ namespace GraphBLAS.FSharp.Backend - -module Vector = - diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs deleted file mode 100644 index e01dfa70..00000000 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/VectorTest.fs +++ /dev/null @@ -1,8 +0,0 @@ -module GraphBLAS.Sharp.Tests.BackendCommonTests.VectorTest - -open GraphBLAS.FSharp.Backend - -let vector = Vector.zeroCreate VectorFormat.COO 3 - - - diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 322a92a9..fe7a3e26 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -20,7 +20,6 @@ - @@ -29,6 +28,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs new file mode 100644 index 00000000..22115b99 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs @@ -0,0 +1,15 @@ +module Backend.ZeroCreate + +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests + +(*let checkResult actual (expected: 'a []) = + match actual with + | VectorCOO actual -> + let expected = createVectorFromArray expected + () + + | VectorDense actual -> + ()*) + + From 8b1a2343a918a2c3d80d6cb172fa90fa171db560 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 11 Oct 2022 17:56:12 +0300 Subject: [PATCH 09/74] add: CooVector merge fun --- .../Vector/COOVector/COOVector.fs | 167 +++++++++++++++++- .../Vector/DenseVector/DenseVector.fs | 6 +- 2 files changed, 170 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index d564be13..87345015 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -31,7 +31,7 @@ module COOVector = Values = resultValues Size = resultSize } - let mask (clContext: ClContext) (workGroupSize: int) = + let copy (clContext: ClContext) (workGroupSize: int) = let copy = ClArray.copy clContext workGroupSize let copyData = ClArray.copy clContext workGroupSize @@ -47,6 +47,171 @@ module COOVector = Values = resultValues Size = resultSize } + let private merge (clContext: ClContext) (workGroupSize: int) = + let merge = + <@ + fun (ndRange: Range1D) (sumOfSides: int) (firstSide: int) (secondSide: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (scalarBuffer: ClArray<'a>) (allIndicesBuffer: ClArray) (allValuesBuffer: ClArray<'a>) -> + + let i = ndRange.GlobalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 + + if localID < 2 then + let mutable x = localID * (workGroupSize - 1) + i - 1 + + if x >= sumOfSides then + x <- sumOfSides - 1 + + let diagonalNumber = x + + let mutable leftEdge = diagonalNumber + 1 - secondSide + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstSide - 1 + + if rightEdge > diagonalNumber then + rightEdge <- diagonalNumber + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = firstIndicesBuffer.[middleIdx] + + let secondIndex = + secondIndicesBuffer.[diagonalNumber - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + // Here localID equals either 0 or 1 + if localID = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge + + 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 + + if rightEdge > localID then + rightEdge <- localID + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] + + let secondIndex = + localIndices.[firstLocalLength + localID - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + let boundaryX = rightEdge + let boundaryY = localID - leftEdge + + // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) + let isValidX = boundaryX >= 0 + let isValidY = boundaryY >= 0 + + let mutable fstIdx = 0 + + if isValidX then + fstIdx <- localIndices.[boundaryX] + + let mutable sndIdx = 0 + + if isValidY then + sndIdx <- localIndices.[firstLocalLength + boundaryY] + + if not isValidX || isValidY && fstIdx <= sndIdx then + allIndicesBuffer.[i] <- sndIdx + allValuesBuffer.[i] <- scalarBuffer.[0] + else + allIndicesBuffer.[i] <- fstIdx + allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + @> + + let kernel = clContext.Compile(merge) + + fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (scalar: ClArray<'a>) () -> + let firstSide = firstIndices.Length + + let secondSide = secondIndices.Length + + let sumOfSides = firstIndices.Length + secondIndices.Length + + let allIndices = + clContext.CreateClArray( + sumOfSides, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + let allValues = + clContext.CreateClArray<'a>( + sumOfSides, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid(sumOfSides, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + firstIndices + firstValues + secondIndices + scalar + allIndices + allValues) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allIndices, allValues + + (*let fillSubVector (clContext: ClContext) (workGroupSize: int) = fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (mask: ClVector<'b>) (scalar: 'c) ->*) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 7c89213f..763d1526 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -29,9 +29,11 @@ module DenseVector = toOptionArray processor values indices elements.Length :?> ClDenseVector<'a> - (*let mask (clContext: ClContext) (workGroupSize: int) = + let copy (clContext: ClContext) (workGroupSize: int) = let copy = ClArray.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> - copy processor vector :?> ClDenseVector<'a>*) + copy processor vector :?> ClDenseVector<'a> + + From 01b4bd2d2985cdf050213d202542a95760ea2122 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 11 Oct 2022 20:11:06 +0300 Subject: [PATCH 10/74] refactor: CooVector merge fun --- .../Vector/COOVector/COOVector.fs | 24 ++++++++++++++----- 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 87345015..233d9ce8 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -50,7 +50,7 @@ module COOVector = let private merge (clContext: ClContext) (workGroupSize: int) = let merge = <@ - fun (ndRange: Range1D) (sumOfSides: int) (firstSide: int) (secondSide: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (scalarBuffer: ClArray<'a>) (allIndicesBuffer: ClArray) (allValuesBuffer: ClArray<'a>) -> + fun (ndRange: Range1D) (sumOfSides: int) (firstSide: int) (secondSide: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'a>) (allIndicesBuffer: ClArray) (allValuesBuffer: ClArray<'a>) (isLeftBitMap: ClArray) -> let i = ndRange.GlobalID0 @@ -156,15 +156,16 @@ module COOVector = if not isValidX || isValidY && fstIdx <= sndIdx then allIndicesBuffer.[i] <- sndIdx - allValuesBuffer.[i] <- scalarBuffer.[0] + allValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + isLeftBitMap.[i] <- 0 else allIndicesBuffer.[i] <- fstIdx allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - @> + isLeftBitMap.[i] <- 1 @> let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (scalar: ClArray<'a>) () -> + fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (scalar: ClArray<'a>) -> let firstSide = firstIndices.Length let secondSide = secondIndices.Length @@ -187,6 +188,14 @@ module COOVector = allocationMode = AllocationMode.Default ) + let isLeftBitmap = + clContext.CreateClArray( + sumOfSides, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + let ndRange = Range1D.CreateValid(sumOfSides, workGroupSize) let kernel = kernel.GetKernel () @@ -204,12 +213,15 @@ module COOVector = secondIndices scalar allIndices - allValues) + allValues + isLeftBitmap) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - allIndices, allValues + allIndices, allValues, isLeftBitmap + + (*let fillSubVector (clContext: ClContext) (workGroupSize: int) = From 7fab131bc6fe4e998201e32a3f3d87b76db3a5f4 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 12 Oct 2022 09:13:50 +0300 Subject: [PATCH 11/74] refactor: COOVector setPositions --- .../Vector/COOVector/COOVector.fs | 90 ++++++++++++++++--- 1 file changed, 78 insertions(+), 12 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 233d9ce8..b7915fea 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -2,7 +2,8 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp open GraphBLAS.FSharp.Backend -open Microsoft.FSharp.Control +open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Quotations module COOVector = let zeroCreate (clContext: ClContext) = @@ -49,8 +50,7 @@ module COOVector = let private merge (clContext: ClContext) (workGroupSize: int) = let merge = - <@ - fun (ndRange: Range1D) (sumOfSides: int) (firstSide: int) (secondSide: int) (firstIndicesBuffer: ClArray) (firstValuesBuffer: ClArray<'a>) (secondIndicesBuffer: ClArray) (secondValuesBuffer: ClArray<'a>) (allIndicesBuffer: ClArray) (allValuesBuffer: ClArray<'a>) (isLeftBitMap: ClArray) -> + <@ 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 @@ -156,16 +156,16 @@ module COOVector = if not isValidX || isValidY && fstIdx <= sndIdx then allIndicesBuffer.[i] <- sndIdx - allValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] isLeftBitMap.[i] <- 0 else allIndicesBuffer.[i] <- fstIdx - allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] isLeftBitMap.[i] <- 1 @> let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (scalar: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (secondValues: ClArray<'b>) -> let firstSide = firstIndices.Length let secondSide = secondIndices.Length @@ -180,7 +180,7 @@ module COOVector = allocationMode = AllocationMode.Default ) - let allValues = + let firstResultValues = clContext.CreateClArray<'a>( sumOfSides, hostAccessMode = HostAccessMode.NotAccessible, @@ -188,6 +188,14 @@ module COOVector = allocationMode = AllocationMode.Default ) + let secondResultValues = + clContext.CreateClArray<'b>( + sumOfSides, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + let isLeftBitmap = clContext.CreateClArray( sumOfSides, @@ -211,20 +219,78 @@ module COOVector = firstIndices firstValues secondIndices - scalar + secondValues allIndices - allValues + firstResultValues + secondResultValues isLeftBitmap) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - allIndices, allValues, isLeftBitmap + allIndices, firstResultValues, secondResultValues, isLeftBitmap + + let private preparePositionsAtLeasOne + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + (workGroupSize: int) + = + + let preparePositions = + <@ 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 + positions[gid] <- 0 + + match (%opAdd) (Both (leftValues[gid + 1], rightValues[gid])) with + | Some value -> + allValues[gid + 1] <- value + positions[gid + 1] <- 1 + | None -> + positions[gid + 1] <- 1 + elif (gid < length && gid > 0 && allIndices[gid - 1] <> allIndices[gid]) || gid = 0 then + if isLeft[gid] = 1 then + match (%opAdd) (Left leftValues[gid]) with + | Some value -> + allValues[gid] <- value + positions[gid] <- 1 + | None -> + positions[gid] <- 0 + else + match (%opAdd) (Right rightValues[gid]) with + | Some value -> + allValues[gid] <- value + positions[gid] <- 1 + | None -> + positions[gid] <- 0 + @> + let kernel = clContext.Compile(preparePositions) + fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + let length = allIndices.Length - (*let fillSubVector (clContext: ClContext) (workGroupSize: int) = + let allValues = + clContext.CreateClArray( + length, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid(length, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + ) + ) - fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (mask: ClVector<'b>) (scalar: 'c) ->*) From f92e1583c5a99906260c6ef9c4778a3d2762f549 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 12 Oct 2022 23:31:14 +0300 Subject: [PATCH 12/74] add: CooVector.setPositions --- .../Vector/COOVector/COOVector.fs | 97 ++++++++++++++++++- 1 file changed, 96 insertions(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index b7915fea..45b5273d 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -49,6 +49,7 @@ module COOVector = Size = resultSize } let private merge (clContext: ClContext) (workGroupSize: int) = + 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) -> @@ -281,6 +282,14 @@ module COOVector = allocationMode = AllocationMode.Default ) + let positions = + clContext.CreateClArray( + length, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + let ndRange = Range1D.CreateValid(length, workGroupSize) let kernel = kernel.GetKernel () @@ -290,7 +299,93 @@ module COOVector = fun () -> kernel.KernelFunc ndRange - ) + length + allIndices + leftValues + rightValues + isLeft + allValues + positions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allValues, positions + + + let setPositionsAtLeasOne (clContext: ClContext) (workGroupSize: int) = + + let setPositions = + <@ fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'c>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> + + let i = ndRange.GlobalID0 + + if i = prefixSumArrayLength - 1 + || i < prefixSumArrayLength + && prefixSumBuffer.[i] + <> prefixSumBuffer.[i + 1] then + let index = prefixSumBuffer.[i] + + resultValues.[index] <- allValues.[i] + resultIndices.[index] <- allIndices.[i] + @> + + let kernel = clContext.Compile(setPositions) + + let sum = + ClArray.prefixSumExcludeInplace clContext workGroupSize + + let resultLength = Array.zeroCreate 1 + + fun (processor: MailboxProcessor<_>) (allValues: ClArray<'c>) (allIndices: ClArray) (positions: ClArray) -> + + let prefixSumArrayLength = positions.Length + + let resultLengthGpu = clContext.CreateClCell 0 + + let _, r = sum processor positions resultLengthGpu + + let resultLength = + let res = + processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(r, resultLength, ch)) + + processor.Post(Msg.CreateFreeMsg<_>(r)) + + res.[0] + + let resultValues = + clContext.CreateClArray<'c>( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + let resultIndices = + clContext.CreateClArray( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid(prefixSumArrayLength, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + prefixSumArrayLength + allValues + allIndices + positions + resultValues + resultIndices) ) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + resultValues, resultIndices From ddca85605df12c0ee3baa1e7e2d4b318bc214090 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 12 Oct 2022 23:51:07 +0300 Subject: [PATCH 13/74] add: CooVector.elementWiseAdd --- .../Vector/COOVector/COOVector.fs | 46 +++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 45b5273d..d31c78e1 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -389,3 +389,49 @@ module COOVector = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) resultValues, resultIndices + + //TODO comment + let elementWiseAdd (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = + + let merge = merge clContext workGroupSize + + let prepare = preparePositionsAtLeasOne clContext opAdd workGroupSize + + let setPositions = setPositionsAtLeasOne clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (rightVector: ClCooVector<'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)) + + let resultValues, resultIndices = + setPositions + processor + allValues + allIndices + positions + + processor.Post(Msg.CreateFreeMsg<_>(allValues)) + processor.Post(Msg.CreateFreeMsg<_>(allIndices)) + processor.Post(Msg.CreateFreeMsg<_>(positions)) + + { ClCooVector.Context = clContext + Values = resultValues + Indices = resultIndices + Size = leftVector.Size } From 8ab5d63f7446f19fa9f008e5cca0a776eb9117a5 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 13 Oct 2022 14:10:24 +0300 Subject: [PATCH 14/74] add: ClCooVector.fillSubVector --- .../Vector/COOVector/COOVector.fs | 31 ++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index d31c78e1..91eb1a81 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -391,7 +391,7 @@ module COOVector = resultValues, resultIndices //TODO comment - let elementWiseAdd (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = + let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = let merge = merge clContext workGroupSize @@ -435,3 +435,32 @@ module COOVector = Values = resultValues Indices = resultIndices Size = leftVector.Size } + + let fillSubVector (clContext: ClContext) (workGroupSize: int) = + + let opAdd = + <@ fun (value: AtLeastOne<'a, 'a>) -> + match value with + | Both (_, right) -> Some right + | Left left -> Some left + | Right _ -> None @> + + let create = ClArray.create clContext workGroupSize + + let eWiseAdd = elementWiseAddAtLeastOne clContext opAdd workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (maskVector: ClCooVector<'b>) (scalar: 'a) -> + + let maskSize = maskVector.Size + + let maskValues = create processor maskVector.Size scalar + + let maskIndices = maskVector.Indices + + let rightVector = + { ClCooVector.Context = clContext + Indices = maskIndices + Values = maskValues + Size = maskSize } + + eWiseAdd processor leftVector rightVector From 2b2092ed7f3fd548092e46b1f98c63b51d8c704b Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 13 Oct 2022 14:44:45 +0300 Subject: [PATCH 15/74] add: ClDenseVector.fillSubVector --- .../Vector/DenseVector/DenseVector.fs | 53 ++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 763d1526..df758a72 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -2,7 +2,8 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp open GraphBLAS.FSharp.Backend -open Microsoft.FSharp.Control +open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Quotations module DenseVector = let zeroCreate (clContext: ClContext) (workGroupSize: int) = @@ -35,5 +36,55 @@ module DenseVector = fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> copy processor vector :?> ClDenseVector<'a> + let elementWiseAddAtLeasOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = + let eWiseAdd = + <@ fun (ndRange: Range1D) length (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + let gid = ndRange.GlobalID0 + + if gid < length then + + let leftItem = leftVector[gid] + let rightItem = rightVector[gid] + + match leftItem, rightItem with + | Some left, Some right -> + resultVector.[gid] <- (%opAdd) (Both (left, right)) + | Some left, None -> + resultVector.[gid] <- (%opAdd) (Left left) + | None, Some right -> + resultVector.[gid] <- (%opAdd) (Right right) + | None, None -> + resultVector.[gid] <- None @> + + let kernel = clContext.Compile(eWiseAdd) + + fun (processor: MailboxProcessor<_>) (leftVector: ClDenseVector<'a>) (rightVector: ClDenseVector<'b>) -> + + let resultVector = + clContext.CreateClArray( + leftVector.Size, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.WriteOnly, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid (leftVector.Size, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + leftVector.Size + leftVector + rightVector + resultVector) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultVector From e0d47d610728c35482ab506805324d0eba46080e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 13 Oct 2022 17:15:40 +0300 Subject: [PATCH 16/74] add: DenseVector.fillSubVector --- .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Vector/COOVector/COOVector.fs | 11 +- .../Vector/DenseVector/DenseVector.fs | 110 +++++++++++++++--- .../Vector/VectorOperaions.fs | 18 +++ 4 files changed, 118 insertions(+), 22 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index dd73ccbe..ff6ad0de 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -25,6 +25,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 91eb1a81..9cff08fd 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -438,20 +438,15 @@ module COOVector = let fillSubVector (clContext: ClContext) (workGroupSize: int) = - let opAdd = - <@ fun (value: AtLeastOne<'a, 'a>) -> - match value with - | Both (_, right) -> Some right - | Left left -> Some left - | Right _ -> None @> - let create = ClArray.create clContext workGroupSize + let opAdd = VectorOperations.fillSubAddAtLeastOne None + let eWiseAdd = elementWiseAddAtLeastOne clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (maskVector: ClCooVector<'b>) (scalar: 'a) -> - let maskSize = maskVector.Size + let maskSize = maskVector.Size //TODO() let maskValues = create processor maskVector.Size scalar diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index df758a72..7fcfddcb 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -36,27 +36,85 @@ module DenseVector = fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> copy processor vector :?> ClDenseVector<'a> + let private copyWithValue (clContext: ClContext) (workGroupSize: int) = + + let fillVector = + <@ fun (ndRange: Range1D) length (maskArray: ClArray<'a option>) (scalar: ClCell<'b>) (resultArray: ClArray<'b option>)-> + + let gid = ndRange.GlobalID0 + + if gid < length then + match maskArray.[gid] with + | Some _ -> + resultArray.[gid] <- Some scalar.Value + | None -> + resultArray.[gid] <- None @> + + let kernel = clContext.Compile(fillVector) + + fun (processor: MailboxProcessor<_>) (maskVector: ClDenseVector<'a>) (scalar: 'b) -> + + let resultArray = + clContext.CreateClArray( + maskVector.Size, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let clScalar = + clContext.CreateClCell( + scalar, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadOnly, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid(maskVector.Size, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + maskVector.Size + maskVector + clScalar + resultArray) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.Post(Msg.CreateFreeMsg<_>(clScalar)) + + resultArray :?> ClDenseVector<'b> + let elementWiseAddAtLeasOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = let eWiseAdd = - <@ fun (ndRange: Range1D) length (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + <@ fun (ndRange: Range1D) leftVectorLength rightVectorLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> let gid = ndRange.GlobalID0 - if gid < length then + let mutable leftItem = None + let mutable rightItem = None + + if gid < leftVectorLength then + leftItem <- leftVector[gid] - let leftItem = leftVector[gid] - let rightItem = rightVector[gid] + if gid < rightVectorLength then + rightItem <- rightVector[gid] - match leftItem, rightItem with - | Some left, Some right -> - resultVector.[gid] <- (%opAdd) (Both (left, right)) - | Some left, None -> - resultVector.[gid] <- (%opAdd) (Left left) - | None, Some right -> - resultVector.[gid] <- (%opAdd) (Right right) - | None, None -> - resultVector.[gid] <- None @> + match leftItem, rightItem with + | Some left, Some right -> + resultVector.[gid] <- (%opAdd) (Both (left, right)) + | Some left, None -> + resultVector.[gid] <- (%opAdd) (Left left) + | None, Some right -> + resultVector.[gid] <- (%opAdd) (Right right) + | None, None -> + resultVector.[gid] <- None @> let kernel = clContext.Compile(eWiseAdd) @@ -70,7 +128,9 @@ module DenseVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid (leftVector.Size, workGroupSize) + let resultLength = max leftVector.Size rightVector.Size + + let ndRange = Range1D.CreateValid (resultLength, workGroupSize) let kernel = kernel.GetKernel () @@ -80,6 +140,7 @@ module DenseVector = kernel.KernelFunc ndRange leftVector.Size + rightVector.Size leftVector rightVector resultVector) @@ -88,3 +149,24 @@ module DenseVector = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) resultVector + + let fillSubVector (clContext: ClContext) (workGroupSize: int) = + + let opAdd = VectorOperations.fillSubAddAtLeastOne None + + let eWiseAdd = elementWiseAddAtLeasOne clContext opAdd workGroupSize + + let copyWithValue = copyWithValue clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClDenseVector<'a>) (maskVector: ClDenseVector<'b>) (scalar: 'a) -> + + let maskVector = copyWithValue processor maskVector scalar + + let resultVector = + eWiseAdd processor leftVector maskVector + + processor.Post(Msg.CreateFreeMsg<_>(maskVector)) + + resultVector + + diff --git a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs new file mode 100644 index 00000000..ff45d6e4 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs @@ -0,0 +1,18 @@ +namespace GraphBLAS.FSharp.Backend + +open GraphBLAS.FSharp.Backend.Common + +module VectorOperations = + let fillSubAddAtLeastOne zero = + <@ fun (value: AtLeastOne<'a, 'a>) -> + let mutable res = zero + + match value with + | Both (_, right) -> + res <- Some right + | Left left -> + res <- Some left + | Right right -> + res <- Some right + + if res = zero then None else res @> From a8bceb8447ab303d2f4b71be9a9f176310167850 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 13 Oct 2022 17:32:27 +0300 Subject: [PATCH 17/74] add: ClDenseVector.complemented --- .../Vector/DenseVector/DenseVector.fs | 44 +++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 7fcfddcb..261e6b67 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -169,4 +169,48 @@ module DenseVector = resultVector + let Complemented (clContext: ClContext) (workGroupSize: int) = + + let complemented = + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (resultArray: ClArray<'a option>) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + match inputArray.[gid] with + | Some _ -> + resultArray.[gid] <- None + | None -> + resultArray.[gid] <- Some Unchecked.defaultof<'a> @> + + + let kernel = clContext.Compile(complemented) + + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + + let length = vector.Size + + let resultArray = + clContext.CreateClArray( + length, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid(length, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + length + vector + resultArray) + ) + + resultArray :?> ClDenseVector<'a> From 8553bacae57f811a5f813c041a76e52ea810f29a Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 13 Oct 2022 23:50:02 +0300 Subject: [PATCH 18/74] add: reduce module --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 65 +++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Vector/COOVector/COOVector.fs | 71 ++++++++++++++++++- .../Vector/DenseVector/DenseVector.fs | 1 - 4 files changed, 134 insertions(+), 4 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Common/Reduce.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs new file mode 100644 index 00000000..f713e36a --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -0,0 +1,65 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.FSharp +open Microsoft.FSharp.Control +open Microsoft.FSharp.Quotations + +module Reduce = + let private reduce + (opAdd: Expr<'a -> 'a -> 'a>) + (zero: 'a) + (clContext: ClContext) + (workGroupSize: int) + = + + let reduce = + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let localValues = localArray<'a> workGroupSize + + if gid < length then + localValues[lid] <- inputArray[gid] + else + localValues[lid] <- zero + + barrierLocal () + + let mutable step = 2 + + while step <= workGroupSize do + + if lid < workGroupSize / step then + let firstValue = localValues[lid] + let secondValue = localValues[lid + workGroupSize / step] + + localValues[lid] <- (%opAdd) firstValue secondValue + + step <- step <<< 1 + + barrierLocal () + + if lid = 0 then + atomic (%opAdd) localValues.[0] totalSum.Value |> ignore @> //TODO right atomic usage ? + + let kernel = clContext.Compile reduce + + fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + + let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + valuesArray.Length + valuesArray + totalSum) + ) + + totalSum diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index ff6ad0de..8bb0abd6 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -17,6 +17,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 9cff08fd..1a06403e 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -16,7 +16,7 @@ module COOVector = Size = 0 } let ofList (clContext: ClContext) (elements: (int * 'a) list) = - let (indices, values) = + let indices, values = elements |> Array.ofList |> Array.sortBy fst @@ -313,7 +313,7 @@ module COOVector = allValues, positions - let setPositionsAtLeasOne (clContext: ClContext) (workGroupSize: int) = + let setPositions (clContext: ClContext) (workGroupSize: int) = let setPositions = <@ fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'c>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> @@ -397,7 +397,7 @@ module COOVector = let prepare = preparePositionsAtLeasOne clContext opAdd workGroupSize - let setPositions = setPositionsAtLeasOne clContext workGroupSize + let setPositions = setPositions clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (rightVector: ClCooVector<'b>) -> @@ -459,3 +459,68 @@ module COOVector = Size = maskSize } eWiseAdd processor leftVector rightVector + + let preparePositionsComplemented (clContext: ClContext) (workGroupSize: int) = + + let preparePositions = + <@ fun (ndRange: Range1D) indicesArrayLength (inputIndices: ClArray) (positions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < indicesArrayLength then + let index = inputIndices.[gid] + + positions.[index] <- 0 @> //TODO + + let kernel = clContext.Compile(preparePositions) + + let creat = ClArray.create clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (inputIndices: ClArray) (vectorSize: int) -> + + let positions = creat processor vectorSize 1 + + let ndRange = Range1D.CreateValid(inputIndices.Length, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + inputIndices.Length + inputIndices + positions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + positions + + let complemented (clContext: ClContext) (workGroupSize: int) = + + let init = ClArray.init <@ id @> clContext workGroupSize + + let preparePositions = preparePositionsComplemented clContext workGroupSize + + let setPositions = setPositions clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> + + let positions = + preparePositions processor vector.Indices vector.Size + + let allIndices = + init processor vector.Size + + let resultValues, resultIndices = + setPositions processor allIndices allIndices positions + + processor.Post(Msg.CreateFreeMsg<_>(positions)) + processor.Post(Msg.CreateFreeMsg<_>(allIndices)) + + { ClCooVector.Context = clContext + Indices = resultIndices + Values = resultValues + Size = vector.Size } diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 261e6b67..7beaba06 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -213,4 +213,3 @@ module DenseVector = ) resultArray :?> ClDenseVector<'a> - From 49360e07e62516ee8b11e5c84b7c421efed17525 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 15 Oct 2022 14:29:40 +0300 Subject: [PATCH 19/74] add: ClCooVector.reduce --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 6 +++--- .../Vector/COOVector/COOVector.fs | 16 ++++++++++++++++ 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index f713e36a..c918ac62 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -5,11 +5,11 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module Reduce = - let private reduce - (opAdd: Expr<'a -> 'a -> 'a>) - (zero: 'a) + let reduce (clContext: ClContext) (workGroupSize: int) + (opAdd: Expr<'a -> 'a -> 'a>) + (zero: 'a) = let reduce = diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 1a06403e..57820001 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -3,6 +3,7 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module COOVector = @@ -524,3 +525,18 @@ module COOVector = Indices = resultIndices Values = resultValues Size = vector.Size } + + let reduce + (clContext: ClContext) + (workGroupSize: int) + (opAdd: Expr<'a -> 'a -> 'a>) + = + + let reduce = Reduce.reduce clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) (-) -> + + let resultCell = + clContext.CreateClCell Unchecked.defaultof<'a> + + reduce opAdd Unchecked.defaultof<'a> processor vector.Values resultCell From 6987dc2799d19e0fc04ab0788f981b9811cae1e6 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 15 Oct 2022 17:16:43 +0300 Subject: [PATCH 20/74] add: Vector generic funcs --- .../Vector/COOVector/COOVector.fs | 34 ++-- .../Vector/DenseVector/DenseVector.fs | 171 +++++++++++++++++- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 95 ++++++++++ 3 files changed, 286 insertions(+), 14 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 57820001..643cb039 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -49,7 +49,7 @@ module COOVector = Values = resultValues Size = resultSize } - let private merge (clContext: ClContext) (workGroupSize: int) = + let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = 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) -> @@ -232,7 +232,7 @@ module COOVector = allIndices, firstResultValues, secondResultValues, isLeftBitmap - let private preparePositionsAtLeasOne + let private preparePositionsAtLeasOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) @@ -317,7 +317,7 @@ module COOVector = let setPositions (clContext: ClContext) (workGroupSize: int) = let setPositions = - <@ fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'c>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> + <@ fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> let i = ndRange.GlobalID0 @@ -338,7 +338,7 @@ module COOVector = let resultLength = Array.zeroCreate 1 - fun (processor: MailboxProcessor<_>) (allValues: ClArray<'c>) (allIndices: ClArray) (positions: ClArray) -> + fun (processor: MailboxProcessor<_>) (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> let prefixSumArrayLength = positions.Length @@ -355,7 +355,7 @@ module COOVector = res.[0] let resultValues = - clContext.CreateClArray<'c>( + clContext.CreateClArray<'a>( resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.WriteOnly, @@ -392,7 +392,11 @@ module COOVector = resultValues, resultIndices //TODO comment - let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = + let elementWiseAddAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + (workGroupSize: int) + = let merge = merge clContext workGroupSize @@ -499,13 +503,19 @@ module COOVector = positions - let complemented (clContext: ClContext) (workGroupSize: int) = + let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let init = ClArray.init <@ id @> clContext workGroupSize + let preparePositions = + preparePositionsComplemented clContext workGroupSize - let preparePositions = preparePositionsComplemented clContext workGroupSize + let init = + ClArray.init <@ id @> clContext workGroupSize - let setPositions = setPositions clContext workGroupSize + let create = + ClArray.zeroCreate clContext workGroupSize + + let setPositions = + setPositions clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> @@ -515,8 +525,10 @@ module COOVector = let allIndices = init processor vector.Size + let (values: ClArray<'a>) = create processor vector.Size //TODO() + let resultValues, resultIndices = - setPositions processor allIndices allIndices positions + setPositions processor values allIndices positions processor.Post(Msg.CreateFreeMsg<_>(positions)) processor.Post(Msg.CreateFreeMsg<_>(allIndices)) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 7beaba06..576c0e88 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -3,6 +3,7 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module DenseVector = @@ -90,7 +91,11 @@ module DenseVector = resultArray :?> ClDenseVector<'b> - let elementWiseAddAtLeasOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = + let elementWiseAddAtLeasOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + (workGroupSize: int) + = let eWiseAdd = <@ fun (ndRange: Range1D) leftVectorLength rightVectorLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> @@ -148,7 +153,7 @@ module DenseVector = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - resultVector + resultVector :?> ClDenseVector<'c> let fillSubVector (clContext: ClContext) (workGroupSize: int) = @@ -169,7 +174,7 @@ module DenseVector = resultVector - let Complemented (clContext: ClContext) (workGroupSize: int) = + let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let complemented = <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (resultArray: ClArray<'a option>) -> @@ -213,3 +218,163 @@ module DenseVector = ) resultArray :?> ClDenseVector<'a> + + let getSomeBitmap (clContext: ClContext) (workGroupSize: int) = + + let getSomeBitmap = + <@ fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + match vector[gid] with + | Some _ -> + positions[gid] <- 1 + | None -> + positions[gid] <- 0 @> + + let kernel = clContext.Compile(getSomeBitmap) + + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + + let positions = + clContext.CreateClArray( + vector.Size, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + vector.Length + vector + positions)) + + processor.Post(Msg.CreateRunMsg(kernel)) + + positions + + let unzip (clContext: ClContext) (workGroupSize: int) = + + let unzip = + <@ fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (prefixSumBuffer: ClArray) (bitmap: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < length && bitmap[gid] = 1 then + let index = prefixSumBuffer[gid] + + match denseVector[gid] with + | Some value -> + resultValues[index] <- value + resultIndices[index] <- gid + | None -> () @> + + + let kernel = clContext.Compile(unzip) + + let getBitmap = getSomeBitmap clContext workGroupSize + + let copy = ClArray.copy clContext workGroupSize + + let prefixSum = ClArray.prefixSumExcludeInplace clContext workGroupSize + + let resultLength = Array.zeroCreate 1 + + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + + let bitmap = getBitmap processor vector + + let prefixSumArray = copy processor bitmap + + let prefixSumArrayLength = prefixSumArray.Length + + let resultLengthGpu = clContext.CreateClCell 0 + + let _, r = prefixSum processor prefixSumArray resultLengthGpu + + let resultLength = + let res = + processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(r, resultLength, ch)) + + processor.Post(Msg.CreateFreeMsg<_>(r)) + + res.[0] + + let resultValues = + clContext.CreateClArray( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default) + + let resultIndices = + clContext.CreateClArray( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default) + + let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) + + let kernel = kernel.GetKernel () + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + vector.Size + vector + prefixSumArray + bitmap + resultValues + resultIndices) + ) + + processor.Post(Msg.CreateRunMsg(kernel)) + + processor.Post(Msg.CreateFreeMsg<_>(bitmap)) + processor.Post(Msg.CreateFreeMsg<_>(prefixSumArray)) + + resultValues, resultIndices + + let toCoo (clContext: ClContext) (workGroupSize: int) = + + let unzip = unzip clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + + let values, indices = unzip processor vector + + { ClCooVector.Context = clContext + Indices = indices + Values = values + Size = vector.Size } + + + let reduce + (clContext: ClContext) + (workGroupSize: int) + (opAdd: Expr<'a -> 'a -> 'a>) + = + + let unzip = unzip clContext workGroupSize + + let reduce = Reduce.reduce clContext workGroupSize opAdd Unchecked.defaultof<'a> //TODO() + + fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + + let values, indices = unzip processor vector + + processor.Post(Msg.CreateFreeMsg<_>(indices)) + + reduce processor values diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 7ae757c6..5cd82ed6 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -1 +1,96 @@ namespace GraphBLAS.FSharp.Backend + +open Brahma.FSharp +open Microsoft.FSharp.Quotations + +module Vector = + let copy (clContext: ClContext) (workGroupSize: int) = + fun (processor: MailboxProcessor<_>) vector -> + match vector with + | ClVectorCOO vector -> + let res = COOVector.copy clContext workGroupSize processor vector + + ClVectorCOO res + | ClVectorDense vector -> + let res = DenseVector.copy clContext workGroupSize processor vector + + ClVectorDense res + + let mask (clContext: ClContext) (workGroupSize: int) = + copy clContext workGroupSize + + let fillSubVector (clContext: ClContext) (workGroupSize: int) = + + let cooFillVector = COOVector.fillSubVector clContext workGroupSize + let denseFillVector = DenseVector.fillSubVector clContext workGroupSize + + let toCooVector = DenseVector.toCoo clContext workGroupSize + let toCooMask = DenseVector.toCoo clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> //TODO() + match vector, maskVector with + | ClVectorCOO vector, ClVectorCOO mask -> + + let res = cooFillVector processor vector mask value + + ClVectorCOO res + + | ClVectorCOO vector, ClVectorDense mask -> + + let mask = toCooMask processor mask + + let res = cooFillVector processor vector mask value //TODO() + + ClVectorCOO res + | ClVectorDense vector, ClVectorCOO mask -> + + let vector = toCooVector processor vector + + let res = cooFillVector processor vector mask value //TODO() + + ClVectorCOO res + + | ClVectorDense vector, ClVectorDense mask -> + let res = denseFillVector processor vector mask value //TODO() + + ClVectorDense res + + let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + + let cooComplemented = + COOVector.complemented clContext workGroupSize + + let denseComplemented = + DenseVector.complemented clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + + match vector with + | ClVectorCOO vector -> + ClVectorCOO <| cooComplemented processor vector + + | ClVectorDense vector -> + ClVectorDense <| denseComplemented processor vector + + let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = + + let cooReduce = + COOVector.reduce clContext workGroupSize opAdd + + let denseReduce = + DenseVector.reduce clContext workGroupSize opAdd + + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + + match vector with + | ClVectorCOO vector -> + cooReduce processor vector + + | ClVectorDense vector -> + denseReduce processor vector + + + + + + From b97162deb5f212f36959452720597de9778c91cc Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 16 Oct 2022 12:55:33 +0300 Subject: [PATCH 21/74] refactor: Vector --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 1 + .../Vector/COOVector/COOVector.fs | 84 ++++-------- .../Vector/DenseVector/DenseVector.fs | 115 +++++++--------- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 126 +++++++++++++----- .../Vector/VectorOperaions.fs | 22 +-- .../GraphBLAS-sharp.Tests.fsproj | 1 - .../VectorOperationsTests/zeroCreateTests.fs | 15 --- 7 files changed, 177 insertions(+), 187 deletions(-) delete mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index eee552e3..f5e6c260 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -455,6 +455,7 @@ module ClArray = //TODO(comments) let toOptionArray (clContext: ClContext) (workGroupSize: int) = + let toDense = <@ fun (ndRange: Range1D) (length: int) (values: ClArray<'a>) (indices: ClArray) (outputArray: ClArray<'a option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 643cb039..f7b7d43c 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -7,52 +7,11 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module COOVector = - let zeroCreate (clContext: ClContext) = - let resultIndices = clContext.CreateClArray [||] - let resultValues = clContext.CreateClArray [||] - - { ClCooVector.Context = clContext - Indices = resultIndices - Values = resultValues - Size = 0 } - - let ofList (clContext: ClContext) (elements: (int * 'a) list) = - let indices, values = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip - - let resultSize = elements.Length - - let resultIndices = clContext.CreateClArray indices - let resultValues = clContext.CreateClArray values - - { ClCooVector.Context = clContext - Indices = resultIndices - Values = resultValues - Size = resultSize } - - let copy (clContext: ClContext) (workGroupSize: int) = - let copy = ClArray.copy clContext workGroupSize - let copyData = ClArray.copy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> - let resultIndices = copy processor vector.Indices - - let resultValues = copyData processor vector.Values - - let resultSize = vector.Size - - { ClCooVector.Context = clContext - Indices = resultIndices - Values = resultValues - Size = resultSize } - let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = 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) -> + <@ + 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 @@ -163,7 +122,8 @@ module COOVector = else allIndicesBuffer.[i] <- fstIdx firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - isLeftBitMap.[i] <- 1 @> + isLeftBitMap.[i] <- 1 + @> let kernel = clContext.Compile(merge) @@ -208,7 +168,7 @@ module COOVector = let ndRange = Range1D.CreateValid(sumOfSides, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( @@ -239,7 +199,8 @@ module COOVector = = let preparePositions = - <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> + <@ + fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> let gid = ndRange.GlobalID0 @@ -293,7 +254,7 @@ module COOVector = let ndRange = Range1D.CreateValid(length, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( @@ -317,18 +278,19 @@ module COOVector = let setPositions (clContext: ClContext) (workGroupSize: int) = let setPositions = - <@ fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> + <@ + fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> - let i = ndRange.GlobalID0 + let i = ndRange.GlobalID0 - if i = prefixSumArrayLength - 1 - || i < prefixSumArrayLength - && prefixSumBuffer.[i] - <> prefixSumBuffer.[i + 1] then - let index = prefixSumBuffer.[i] + if i = prefixSumArrayLength - 1 + || i < prefixSumArrayLength + && prefixSumBuffer.[i] + <> prefixSumBuffer.[i + 1] then + let index = prefixSumBuffer.[i] - resultValues.[index] <- allValues.[i] - resultIndices.[index] <- allIndices.[i] + resultValues.[index] <- allValues.[i] + resultIndices.[index] <- allIndices.[i] @> let kernel = clContext.Compile(setPositions) @@ -372,7 +334,7 @@ module COOVector = let ndRange = Range1D.CreateValid(prefixSumArrayLength, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments @@ -468,14 +430,16 @@ module COOVector = let preparePositionsComplemented (clContext: ClContext) (workGroupSize: int) = let preparePositions = - <@ fun (ndRange: Range1D) indicesArrayLength (inputIndices: ClArray) (positions: ClArray) -> + <@ + fun (ndRange: Range1D) indicesArrayLength (inputIndices: ClArray) (positions: ClArray) -> let gid = ndRange.GlobalID0 if gid < indicesArrayLength then let index = inputIndices.[gid] - positions.[index] <- 0 @> //TODO + positions.[index] <- 0 + @> //TODO let kernel = clContext.Compile(preparePositions) @@ -487,7 +451,7 @@ module COOVector = let ndRange = Range1D.CreateValid(inputIndices.Length, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 576c0e88..f3106ece 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -3,44 +3,14 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Common -open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module DenseVector = - let zeroCreate (clContext: ClContext) (workGroupSize: int) = - let zeroCreate = ClArray.zeroCreate clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (length: int) -> - let resultValues = zeroCreate processor length - - resultValues :?> ClDenseVector<'a> - - let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = - let indices, values = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip - - let toOptionArray = ClArray.toOptionArray clContext workGroupSize - - fun (processor: MailboxProcessor<_>) -> - let values = clContext.CreateClArray values - let indices = clContext.CreateClArray indices - - toOptionArray processor values indices elements.Length :?> ClDenseVector<'a> - - - let copy (clContext: ClContext) (workGroupSize: int) = - let copy = ClArray.copy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> - copy processor vector :?> ClDenseVector<'a> - let private copyWithValue (clContext: ClContext) (workGroupSize: int) = let fillVector = - <@ fun (ndRange: Range1D) length (maskArray: ClArray<'a option>) (scalar: ClCell<'b>) (resultArray: ClArray<'b option>)-> + <@ + fun (ndRange: Range1D) length (maskArray: ClArray<'a option>) (scalar: ClCell<'b>) (resultArray: ClArray<'b option>)-> let gid = ndRange.GlobalID0 @@ -49,7 +19,8 @@ module DenseVector = | Some _ -> resultArray.[gid] <- Some scalar.Value | None -> - resultArray.[gid] <- None @> + resultArray.[gid] <- None + @> let kernel = clContext.Compile(fillVector) @@ -73,7 +44,7 @@ module DenseVector = let ndRange = Range1D.CreateValid(maskVector.Size, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( @@ -98,7 +69,8 @@ module DenseVector = = let eWiseAdd = - <@ fun (ndRange: Range1D) leftVectorLength rightVectorLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + <@ + fun (ndRange: Range1D) leftVectorLength rightVectorLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> let gid = ndRange.GlobalID0 @@ -119,7 +91,8 @@ module DenseVector = | None, Some right -> resultVector.[gid] <- (%opAdd) (Right right) | None, None -> - resultVector.[gid] <- None @> + resultVector.[gid] <- None + @> let kernel = clContext.Compile(eWiseAdd) @@ -137,7 +110,7 @@ module DenseVector = let ndRange = Range1D.CreateValid (resultLength, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( @@ -177,16 +150,18 @@ module DenseVector = let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let complemented = - <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (resultArray: ClArray<'a option>) -> + <@ + fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (resultArray: ClArray<'a option>) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < length then - match inputArray.[gid] with - | Some _ -> - resultArray.[gid] <- None - | None -> - resultArray.[gid] <- Some Unchecked.defaultof<'a> @> + if gid < length then + match inputArray.[gid] with + | Some _ -> + resultArray.[gid] <- None + | None -> + resultArray.[gid] <- Some Unchecked.defaultof<'a> + @> let kernel = clContext.Compile(complemented) @@ -205,7 +180,7 @@ module DenseVector = let ndRange = Range1D.CreateValid(length, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( @@ -219,19 +194,21 @@ module DenseVector = resultArray :?> ClDenseVector<'a> - let getSomeBitmap (clContext: ClContext) (workGroupSize: int) = + let getSomeBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let getSomeBitmap = - <@ fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray) -> + <@ + fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < length then - match vector[gid] with - | Some _ -> - positions[gid] <- 1 - | None -> - positions[gid] <- 0 @> + if gid < length then + match vector[gid] with + | Some _ -> + positions[gid] <- 1 + | None -> + positions[gid] <- 0 + @> let kernel = clContext.Compile(getSomeBitmap) @@ -247,7 +224,7 @@ module DenseVector = let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( @@ -262,21 +239,23 @@ module DenseVector = positions - let unzip (clContext: ClContext) (workGroupSize: int) = + let unzip<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let unzip = - <@ fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (prefixSumBuffer: ClArray) (bitmap: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> + <@ + fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (prefixSumBuffer: ClArray) (bitmap: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < length && bitmap[gid] = 1 then - let index = prefixSumBuffer[gid] + if gid < length && bitmap[gid] = 1 then + let index = prefixSumBuffer[gid] - match denseVector[gid] with - | Some value -> - resultValues[index] <- value - resultIndices[index] <- gid - | None -> () @> + match denseVector[gid] with + | Some value -> + resultValues[index] <- value + resultIndices[index] <- gid + | None -> () + @> let kernel = clContext.Compile(unzip) @@ -295,8 +274,6 @@ module DenseVector = let prefixSumArray = copy processor bitmap - let prefixSumArrayLength = prefixSumArray.Length - let resultLengthGpu = clContext.CreateClCell 0 let _, r = prefixSum processor prefixSumArray resultLengthGpu @@ -325,7 +302,7 @@ module DenseVector = let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) - let kernel = kernel.GetKernel () + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 5cd82ed6..bf6cdd17 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -1,62 +1,135 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp +open GraphBLAS.FSharp.Backend +open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module Vector = + let zeroCreate (clContext: ClContext) (workGroupSize: int) = + + let zeroCreate = ClArray.zeroCreate clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (size: int) (format: VectorFormat) -> + match format with + | COO -> + let indices = clContext.CreateClArray [||] + let values = clContext.CreateClArray [||] + + let vector = + { ClCooVector.Context = clContext + Indices = indices + Values = values + Size = size } + + ClVectorCOO vector + | Dense -> + let resultValues = zeroCreate processor size + let vector = resultValues :?> ClDenseVector<'a> + + ClVectorDense vector + + let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = + + let toOptionArray = ClArray.toOptionArray clContext workGroupSize + + let indices, values = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip + + let indices = clContext.CreateClArray indices + let values = clContext.CreateClArray values + + fun (processor: MailboxProcessor<_>) (format: VectorFormat) -> + match format with + | COO -> + let resultSize = elements.Length + + let vector = + { ClCooVector.Context = clContext + Indices = indices + Values = values + Size = resultSize } + + ClVectorCOO vector + + | Dense -> + let array = + toOptionArray processor values indices elements.Length + + let vector = + array :?> ClDenseVector<'a> + + ClVectorDense vector + let copy (clContext: ClContext) (workGroupSize: int) = - fun (processor: MailboxProcessor<_>) vector -> - match vector with - | ClVectorCOO vector -> - let res = COOVector.copy clContext workGroupSize processor vector + let copy = + ClArray.copy clContext workGroupSize - ClVectorCOO res - | ClVectorDense vector -> - let res = DenseVector.copy clContext workGroupSize processor vector + let copyData = + ClArray.copy clContext workGroupSize - ClVectorDense res + let copyOptionData = + ClArray.copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + match vector with + | ClVectorCOO vector -> + let vector = + { ClCooVector.Context = clContext + Indices = copy processor vector.Indices + Values = copyData processor vector.Values + Size = vector.Size } - let mask (clContext: ClContext) (workGroupSize: int) = - copy clContext workGroupSize + ClVectorCOO vector + | ClVectorDense vector -> + let vector = + copyOptionData processor vector :?> ClDenseVector<'a> + + ClVectorDense vector + + let mask = copy let fillSubVector (clContext: ClContext) (workGroupSize: int) = + let cooFillVector = + COOVector.fillSubVector clContext workGroupSize + + let denseFillVector = + DenseVector.fillSubVector clContext workGroupSize - let cooFillVector = COOVector.fillSubVector clContext workGroupSize - let denseFillVector = DenseVector.fillSubVector clContext workGroupSize + let toCooVector = + DenseVector.toCoo clContext workGroupSize - let toCooVector = DenseVector.toCoo clContext workGroupSize - let toCooMask = DenseVector.toCoo clContext workGroupSize + let toCooMask = + DenseVector.toCoo clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> //TODO() match vector, maskVector with | ClVectorCOO vector, ClVectorCOO mask -> - let res = cooFillVector processor vector mask value ClVectorCOO res - | ClVectorCOO vector, ClVectorDense mask -> - let mask = toCooMask processor mask let res = cooFillVector processor vector mask value //TODO() ClVectorCOO res | ClVectorDense vector, ClVectorCOO mask -> - let vector = toCooVector processor vector - let res = cooFillVector processor vector mask value //TODO() + let res = + cooFillVector processor vector mask value //TODO() ClVectorCOO res - | ClVectorDense vector, ClVectorDense mask -> let res = denseFillVector processor vector mask value //TODO() ClVectorDense res let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let cooComplemented = COOVector.complemented clContext workGroupSize @@ -64,16 +137,13 @@ module Vector = DenseVector.complemented clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> - match vector with | ClVectorCOO vector -> ClVectorCOO <| cooComplemented processor vector - | ClVectorDense vector -> ClVectorDense <| denseComplemented processor vector let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = - let cooReduce = COOVector.reduce clContext workGroupSize opAdd @@ -81,16 +151,8 @@ module Vector = DenseVector.reduce clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> - match vector with | ClVectorCOO vector -> cooReduce processor vector - | ClVectorDense vector -> denseReduce processor vector - - - - - - diff --git a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs index ff45d6e4..b66e5af9 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs @@ -4,15 +4,17 @@ open GraphBLAS.FSharp.Backend.Common module VectorOperations = let fillSubAddAtLeastOne zero = - <@ fun (value: AtLeastOne<'a, 'a>) -> - let mutable res = zero + <@ + fun (value: AtLeastOne<'a, 'a>) -> + let mutable res = zero - match value with - | Both (_, right) -> - res <- Some right - | Left left -> - res <- Some left - | Right right -> - res <- Some right + match value with + | Both (_, right) -> + res <- Some right + | Left left -> + res <- Some left + | Right right -> + res <- Some right - if res = zero then None else res @> + if res = zero then None else res + @> diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index fe7a3e26..11b3c161 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -28,7 +28,6 @@ - diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs deleted file mode 100644 index 22115b99..00000000 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs +++ /dev/null @@ -1,15 +0,0 @@ -module Backend.ZeroCreate - -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Tests - -(*let checkResult actual (expected: 'a []) = - match actual with - | VectorCOO actual -> - let expected = createVectorFromArray expected - () - - | VectorDense actual -> - ()*) - - From ab59f3c8e0a1ca14341e5f21ebcf57c11b7e6a2e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Oct 2022 16:11:17 +0300 Subject: [PATCH 22/74] add: Reduce.run tests --- .../BenchmarksMxv.fs | 20 ++--- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 4 +- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 57 +++++++------ src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 16 ++-- .../Vector/COOVector/COOVector.fs | 54 ++++++------- .../Vector/DenseVector/DenseVector.fs | 50 ++++++------ src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 8 +- src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj | 1 - src/GraphBLAS-sharp/Objects/Vector.fs | 40 ---------- .../BackendCommonTests/ReduceTest.fs | 80 +++++++++++++++++++ .../GraphBLAS-sharp.Tests.fsproj | 2 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 2 + tests/GraphBLAS-sharp.Tests/Program.fs | 30 ++++--- .../VectorOperationsTests/zeroCreateTest.fs | 29 +++++++ 14 files changed, 237 insertions(+), 156 deletions(-) delete mode 100644 src/GraphBLAS-sharp/Objects/Vector.fs create mode 100644 tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs index 2e58b17a..0756e0c6 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs @@ -7,15 +7,15 @@ open BenchmarkDotNet.Columns open System.IO open GraphBLAS.FSharp.IO -[)>] -type MxvBenchmarks() = - let rand = System.Random() - - let mutable matrix = Unchecked.defaultof> - let mutable vector = Unchecked.defaultof> - let semiring = Predefined.AddMult.float - - //TODO fix me +// [)>] +// 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 = @@ -75,4 +75,4 @@ type MxvBenchmarks() = | ".mtx" -> MtxReader(Utils.getFullPathToMatrix "Common" matrixFilename) | _ -> failwith "Unsupported matrix format" ) -*) \ 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 f5e6c260..6cb8fe32 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -456,7 +456,7 @@ module ClArray = //TODO(comments) let toOptionArray (clContext: ClContext) (workGroupSize: int) = - let toDense = + let toOption = <@ fun (ndRange: Range1D) (length: int) (values: ClArray<'a>) (indices: ClArray) (outputArray: ClArray<'a option>) -> let gid = ndRange.GlobalID0 @@ -467,7 +467,7 @@ module ClArray = outputArray[resultIndex] <- Some values[resultIndex] @> - let kernel = clContext.Compile(toDense) + let kernel = clContext.Compile(toOption) let zeroCreate = zeroCreate clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index c918ac62..462e71e5 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -5,7 +5,7 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module Reduce = - let reduce + let run (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) @@ -13,44 +13,51 @@ module Reduce = = let reduce = - <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + <@ + fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 - let localValues = localArray<'a> workGroupSize + let i = (gid - lid) * 2 + lid - if gid < length then - localValues[lid] <- inputArray[gid] - else - localValues[lid] <- zero + let localValues = localArray<'a> workGroupSize - barrierLocal () - - let mutable step = 2 + if i + workGroupSize < length then + localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] + elif i < length then + localValues[lid] <- inputArray[i] + else + localValues[lid] <- zero + barrierLocal () - while step <= workGroupSize do + let mutable step = 2 - if lid < workGroupSize / step then - let firstValue = localValues[lid] - let secondValue = localValues[lid + workGroupSize / step] + while step <= workGroupSize do + if lid < workGroupSize / step then + let firstValue = localValues[lid] + let secondValue = localValues[lid + workGroupSize / step] - localValues[lid] <- (%opAdd) firstValue secondValue + localValues[lid] <- (%opAdd) firstValue secondValue - step <- step <<< 1 + step <- step <<< 1 - barrierLocal () + barrierLocal () - if lid = 0 then - atomic (%opAdd) localValues.[0] totalSum.Value |> ignore @> //TODO right atomic usage ? + if lid = 0 then + atomic (%opAdd) totalSum.Value localValues[0] |> ignore + @> - let kernel = clContext.Compile reduce + let kernel = clContext.Compile(reduce) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) - let kernel = kernel.GetKernel () + let totalSum = + clContext.CreateClCell(zero) + + let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments( @@ -62,4 +69,6 @@ module Reduce = totalSum) ) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + totalSum diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index 2c52778e..4a0be9a9 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -84,7 +84,7 @@ type DenseVector<'a> = |> String.concat "" member this.ToDevice(context: ClContext) = - context.CreateClArray this.Values :?> ClDenseVector<'a> + { ClDenseVector.Values = context.CreateClArray this.Values } static member FromArray(array: 'a [], isZero: 'a -> bool) = { Values = @@ -92,27 +92,27 @@ type DenseVector<'a> = |> Array.map (fun v -> if isZero v then None else Some v) } and ClDenseVector<'a> = - inherit ClArray<'a option> + { Values: ClArray<'a option> } - member this.Size = this.Length + member this.Size = this.Values.Length member this.ToHost(q: MailboxProcessor<_>) = - let vector = Array.zeroCreate this.Length + let vector = Array.zeroCreate this.Values.Length let _ = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, vector, ch)) + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, vector, ch)) - { Values = vector } + { DenseVector.Values = vector } interface IDeviceMemObject with member this.Dispose(q) = - q.Post(Msg.CreateFreeMsg<_>(this)) + q.Post(Msg.CreateFreeMsg<_>(this.Values)) q.PostAndReply(Msg.MsgNotifyMe) member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) static member FromArray(context: ClContext, array: 'a option []) = - context.CreateClArray array :?> ClDenseVector<'a> + { Values = context.CreateClArray array } type TuplesVector<'a> = { Indices: int [] diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index f7b7d43c..eb879551 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -37,10 +37,10 @@ module COOVector = while leftEdge <= rightEdge do let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] + let firstIndex = firstIndicesBuffer[middleIdx] let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] + secondIndicesBuffer[diagonalNumber - middleIdx] if firstIndex <= secondIndex then leftEdge <- middleIdx + 1 @@ -70,10 +70,10 @@ module COOVector = let localIndices = localArray workGroupSize if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] + localIndices[localID] <- firstIndicesBuffer[beginIdx + localID] if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] + localIndices[firstLocalLength + localID] <- secondIndicesBuffer[i - beginIdx] barrierLocal () @@ -88,10 +88,10 @@ module COOVector = while leftEdge <= rightEdge do let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] + let firstIndex = localIndices[middleIdx] let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] + localIndices[firstLocalLength + localID - middleIdx] if firstIndex <= secondIndex then leftEdge <- middleIdx + 1 @@ -108,21 +108,21 @@ module COOVector = let mutable fstIdx = 0 if isValidX then - fstIdx <- localIndices.[boundaryX] + fstIdx <- localIndices[boundaryX] let mutable sndIdx = 0 if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] + sndIdx <- localIndices[firstLocalLength + boundaryY] if not isValidX || isValidY && fstIdx <= sndIdx then - allIndicesBuffer.[i] <- sndIdx - secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - isLeftBitMap.[i] <- 0 + 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 + allIndicesBuffer[i] <- fstIdx + firstResultValues[i] <- firstValuesBuffer[beginIdx + boundaryX] + isLeftBitMap[i] <- 1 @> let kernel = clContext.Compile(merge) @@ -285,12 +285,12 @@ module COOVector = if i = prefixSumArrayLength - 1 || i < prefixSumArrayLength - && prefixSumBuffer.[i] - <> prefixSumBuffer.[i + 1] then - let index = prefixSumBuffer.[i] + && prefixSumBuffer[i] + <> prefixSumBuffer[i + 1] then + let index = prefixSumBuffer[i] - resultValues.[index] <- allValues.[i] - resultIndices.[index] <- allIndices.[i] + resultValues[index] <- allValues[i] + resultIndices[index] <- allIndices[i] @> let kernel = clContext.Compile(setPositions) @@ -314,7 +314,7 @@ module COOVector = processor.Post(Msg.CreateFreeMsg<_>(r)) - res.[0] + res[0] let resultValues = clContext.CreateClArray<'a>( @@ -436,9 +436,9 @@ module COOVector = let gid = ndRange.GlobalID0 if gid < indicesArrayLength then - let index = inputIndices.[gid] + let index = inputIndices[gid] - positions.[index] <- 0 + positions[index] <- 0 @> //TODO let kernel = clContext.Compile(preparePositions) @@ -508,11 +508,7 @@ module COOVector = (opAdd: Expr<'a -> 'a -> 'a>) = - let reduce = Reduce.reduce clContext workGroupSize + let reduce = Reduce.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) (-) -> - - let resultCell = - clContext.CreateClCell Unchecked.defaultof<'a> - - reduce opAdd Unchecked.defaultof<'a> processor vector.Values resultCell + fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> + reduce opAdd Unchecked.defaultof<'a> processor vector.Values diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index f3106ece..56d569f1 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -15,11 +15,11 @@ module DenseVector = let gid = ndRange.GlobalID0 if gid < length then - match maskArray.[gid] with + match maskArray[gid] with | Some _ -> - resultArray.[gid] <- Some scalar.Value + resultArray[gid] <- Some scalar.Value | None -> - resultArray.[gid] <- None + resultArray[gid] <- None @> let kernel = clContext.Compile(fillVector) @@ -52,7 +52,7 @@ module DenseVector = kernel.KernelFunc ndRange maskVector.Size - maskVector + maskVector.Values clScalar resultArray) ) @@ -60,7 +60,7 @@ module DenseVector = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) processor.Post(Msg.CreateFreeMsg<_>(clScalar)) - resultArray :?> ClDenseVector<'b> + { Values = resultArray } let elementWiseAddAtLeasOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) @@ -85,13 +85,13 @@ module DenseVector = match leftItem, rightItem with | Some left, Some right -> - resultVector.[gid] <- (%opAdd) (Both (left, right)) + resultVector[gid] <- (%opAdd) (Both (left, right)) | Some left, None -> - resultVector.[gid] <- (%opAdd) (Left left) + resultVector[gid] <- (%opAdd) (Left left) | None, Some right -> - resultVector.[gid] <- (%opAdd) (Right right) + resultVector[gid] <- (%opAdd) (Right right) | None, None -> - resultVector.[gid] <- None + resultVector[gid] <- None @> let kernel = clContext.Compile(eWiseAdd) @@ -119,14 +119,14 @@ module DenseVector = ndRange leftVector.Size rightVector.Size - leftVector - rightVector + leftVector.Values + rightVector.Values resultVector) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - resultVector :?> ClDenseVector<'c> + { Values = resultVector } let fillSubVector (clContext: ClContext) (workGroupSize: int) = @@ -143,7 +143,7 @@ module DenseVector = let resultVector = eWiseAdd processor leftVector maskVector - processor.Post(Msg.CreateFreeMsg<_>(maskVector)) + processor.Post(Msg.CreateFreeMsg<_>(maskVector.Values)) resultVector @@ -156,11 +156,11 @@ module DenseVector = let gid = ndRange.GlobalID0 if gid < length then - match inputArray.[gid] with + match inputArray[gid] with | Some _ -> - resultArray.[gid] <- None + resultArray[gid] <- None | None -> - resultArray.[gid] <- Some Unchecked.defaultof<'a> + resultArray[gid] <- Some Unchecked.defaultof<'a> @> @@ -188,11 +188,11 @@ module DenseVector = kernel.KernelFunc ndRange length - vector + vector.Values resultArray) ) - resultArray :?> ClDenseVector<'a> + { Values = resultArray } let getSomeBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = @@ -222,7 +222,7 @@ module DenseVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) + let ndRange = Range1D.CreateValid(vector.Size, workGroupSize) let kernel = kernel.GetKernel() @@ -231,8 +231,8 @@ module DenseVector = fun () -> kernel.KernelFunc ndRange - vector.Length - vector + vector.Size + vector.Values positions)) processor.Post(Msg.CreateRunMsg(kernel)) @@ -284,7 +284,7 @@ module DenseVector = processor.Post(Msg.CreateFreeMsg<_>(r)) - res.[0] + res[0] let resultValues = clContext.CreateClArray( @@ -300,7 +300,7 @@ module DenseVector = deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default) - let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) + let ndRange = Range1D.CreateValid(vector.Size, workGroupSize) let kernel = kernel.GetKernel() @@ -310,7 +310,7 @@ module DenseVector = kernel.KernelFunc ndRange vector.Size - vector + vector.Values prefixSumArray bitmap resultValues @@ -346,7 +346,7 @@ module DenseVector = let unzip = unzip clContext workGroupSize - let reduce = Reduce.reduce clContext workGroupSize opAdd Unchecked.defaultof<'a> //TODO() + let reduce = Reduce.run clContext workGroupSize opAdd Unchecked.defaultof<'a> //TODO() fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index bf6cdd17..da105c3b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -25,7 +25,7 @@ module Vector = ClVectorCOO vector | Dense -> let resultValues = zeroCreate processor size - let vector = resultValues :?> ClDenseVector<'a> + let vector = { Values = resultValues } ClVectorDense vector @@ -60,7 +60,7 @@ module Vector = toOptionArray processor values indices elements.Length let vector = - array :?> ClDenseVector<'a> + { Values = array } ClVectorDense vector @@ -86,9 +86,9 @@ module Vector = ClVectorCOO vector | ClVectorDense vector -> let vector = - copyOptionData processor vector :?> ClDenseVector<'a> + copyOptionData processor vector.Values - ClVectorDense vector + ClVectorDense { Values = vector } let mask = copy diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index 71c6f62a..878e73d6 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -19,7 +19,6 @@ - diff --git a/src/GraphBLAS-sharp/Objects/Vector.fs b/src/GraphBLAS-sharp/Objects/Vector.fs deleted file mode 100644 index ab994a93..00000000 --- a/src/GraphBLAS-sharp/Objects/Vector.fs +++ /dev/null @@ -1,40 +0,0 @@ -namespace GraphBLAS.FSharp - -type VectorFormat = | COO - -type Vector<'a when 'a: struct> = - | VectorCOO of COOVector<'a> - - member this.Size = - match this with - | VectorCOO vector -> vector.Size - -and COOVector<'a> = - { mutable Size: int - mutable Indices: int [] - mutable Values: 'a [] } - - override this.ToString() = - [ sprintf "Sparse Vector\n" - sprintf "Size: %i \n" this.Size - sprintf "Indices: %A \n" this.Indices - sprintf "Values: %A \n" this.Values ] - |> String.concat "" - - static member FromTuples(size: int, indices: int [], values: 'a []) = - { Size = size - Indices = indices - Values = values } - - static member FromArray(array: 'a [], isZero: 'a -> bool) = - let (indices, vals) = - array - |> Seq.cast<'a> - |> Seq.mapi (fun idx v -> (idx, v)) - |> Seq.filter (fun (_, v) -> not (isZero v)) - |> Array.ofSeq - |> Array.unzip - - COOVector.FromTuples(array.Length, indices, vals) - -type VectorTuples<'a> = { Indices: int []; Values: 'a [] } diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs new file mode 100644 index 00000000..5f838514 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs @@ -0,0 +1,80 @@ +module Backend.Reduce + +open Expecto +open Expecto.Logging +open Expecto.Logging.Message +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Tests.Utils + +let logger = Log.create "Reduce.Tests" + +let context = defaultContext.ClContext + +let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> 'a []) (array: 'a []) = + let array = filter array + + if array.Length > 0 then + + let reduce = reduce zero q + + 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 = [| zero |] + let sum = + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) + + sum[0] + + logger.debug ( + eventX "Actual is {actual}\n" + >> setField "actual" (sprintf "%A" actualSum) + ) + + let expectedSum = + Array.fold plus zero array + + logger.debug ( + eventX "Expected is {expected}\n" + >> setField "expected" (sprintf "%A" expectedSum) + ) + + "Total sums should be equal" + |> Expect.equal actualSum expectedSum + + +let testFixtures config wgSize q plus plusQ zero isEqual filter name = + let reduce = + Reduce.run context wgSize plusQ + + makeTest q reduce plus zero isEqual filter + |> testPropertyWithConfig config (sprintf "Correctness on %s" name) + +let tests = + let config = defaultConfig + + let wgSize = 128 + let q = defaultContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + let filterFloats = + Array.filter (System.Double.IsNaN >> not) + + [ testFixtures config wgSize q (+) <@ (+) @> 0 (=) id "int add" + testFixtures config wgSize q (+) <@ (+) @> 0uy (=) id "byte add" + testFixtures config wgSize q max <@ max @> 0 (=) id "int max" + testFixtures config wgSize q max <@ max @> 0.0 (=) filterFloats "float max" + testFixtures config wgSize q max <@ max @> 0uy (=) id "byte max" + testFixtures config wgSize q min <@ min @> System.Int32.MaxValue (=) id "int min" + testFixtures config wgSize q min <@ min @> System.Double.MaxValue (=) filterFloats "float min" + testFixtures config wgSize q min <@ min @> System.Byte.MaxValue (=) id "byte min" + testFixtures config wgSize q (||) <@ (||) @> false (=) id "bool logic-or" + testFixtures config wgSize q (&&) <@ (&&) @> true (=) id "bool logic-and" ] + |> testList "Backend.Common.Reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 11b3c161..af9ef45c 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -20,6 +20,7 @@ + @@ -27,6 +28,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index ff4d2586..88b32045 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -3,6 +3,7 @@ namespace GraphBLAS.FSharp.Tests open Brahma.FSharp.OpenCL.Shared open Brahma.FSharp.OpenCL.Translator open FsCheck +open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp open Microsoft.FSharp.Reflection open Brahma.FSharp @@ -537,6 +538,7 @@ module Utils = let createVectorFromArray vectorCase array isZero = match vectorCase with | VectorFormat.COO -> VectorCOO <| COOVector.FromArray(array, isZero) + | VectorFormat.Dense -> VectorDense <| DenseVector.FromArray(array, isZero) let compareArrays areEqual (actual: 'a []) (expected: 'a []) message = sprintf "%s. Lengths should be equal. Actual is %A, expected %A" message actual expected diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 1a4e09d3..d3bb7228 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -11,19 +11,23 @@ open GraphBLAS.FSharp.IO let allTests = testList "All tests" - [ Backend.BitonicSort.tests - Backend.PrefixSum.tests - Backend.Convert.tests - Backend.RemoveDuplicates.tests - Backend.Copy.tests - Backend.Replicate.tests - Backend.EwiseAdd.tests - Backend.EwiseAdd.tests2 - //Backend.EwiseAdd.tests3 - Backend.Transpose.tests - //Matrix.GetTuples.tests - //Matrix.Mxv.tests - //Algo.Bfs.tests + [ + // [ Backend.BitonicSort.tests //TODO() + // Backend.PrefixSum.tests + // Backend.Convert.tests + // Backend.RemoveDuplicates.tests + // Backend.Copy.tests + // Backend.Replicate.tests + // Backend.EwiseAdd.tests + // Backend.EwiseAdd.tests2 //TODO() + // //Backend.EwiseAdd.tests3 + // Backend.Transpose.tests //TODO() + // //Matrix.GetTuples.tests + // //Matrix.Mxv.tests + // //Algo.Bfs.tests + //Backend.Vector.ZeroCreate.tests //TODO() + Backend.Reduce.tests + ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs new file mode 100644 index 00000000..3328ec5d --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs @@ -0,0 +1,29 @@ +module Backend.Vector.ZeroCreate + +open Expecto +open Expecto.Logging +open Expecto.Logging.Message +open Brahma.FSharp +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Utils + +let logger = Log.create "Vector.zeroCreate.Tests" + +let checkResult size (actual: Vector<'a>) = + + Expect.equal actual.Size size "The size should be the same." + + match actual with + | VectorDense vector -> + let actualValues = vector.Values + + for i in 0..actual.Size - 1 do + Expect.equal actualValues[i] None "" //TODO() + | VectorCOO vector -> + let actualValues = vector.Values + let actualIndices = vector.Indices + + Expect.equal actualValues [||] "" //TODO() + Expect.equal actualIndices [||] "" //TODO() + From 6c2b8f366ffc31d78f89af7850aae659f1123f26 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Oct 2022 17:36:47 +0300 Subject: [PATCH 23/74] add: new TestCases --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 15 +++++-- .../BackendCommonTests/MatrixEwiseAddTests.fs | 2 +- .../BackendCommonTests/ReduceTest.fs | 4 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 44 +++++++++---------- .../VectorOperationsTests/zeroCreateTest.fs | 19 ++++++-- 5 files changed, 50 insertions(+), 34 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 462e71e5..9662799a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -23,14 +23,21 @@ module Reduce = let localValues = localArray<'a> workGroupSize - if i + workGroupSize < length then - localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] - elif i < length then - localValues[lid] <- inputArray[i] + if gid < length then + localValues[lid] <- inputArray[gid] else localValues[lid] <- zero + barrierLocal () + // if i + workGroupSize < length then + // localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] + // elif i < length then + // localValues[lid] <- inputArray[i] + // else + // localValues[lid] <- zero + // barrierLocal () + let mutable step = 2 while step <= workGroupSize do diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs index 239f86f2..436b17e6 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs @@ -51,7 +51,7 @@ let correctnessGenericTest toCOOFun (isEqual: 'a -> 'a -> bool) q - (case: OperationCase) + (case: OperationCase) (leftMatrix: 'a [,], rightMatrix: 'a [,]) = diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs index 5f838514..f88bda9b 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs @@ -58,9 +58,9 @@ let testFixtures config wgSize q plus plusQ zero isEqual filter name = |> testPropertyWithConfig config (sprintf "Correctness on %s" name) let tests = - let config = defaultConfig + let config = { defaultConfig with endSize = 500 } //TODO() - let wgSize = 128 + let wgSize = 32 let q = defaultContext.Queue q.Error.Add(fun e -> failwithf "%A" e) diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 88b32045..849bbca2 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -424,18 +424,6 @@ module Utils = typeof typeof ] } - let rec cartesian listOfLists = - match listOfLists with - | [ x ] -> List.fold (fun acc elem -> [ elem ] :: acc) [] x - | h :: t -> - List.fold - (fun cacc celem -> - (List.fold (fun acc elem -> (elem :: celem) :: acc) [] h) - @ cacc) - [] - (cartesian t) - | _ -> [] - let listOfUnionCases<'a> = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) @@ -516,19 +504,27 @@ module Utils = { ClContext = context; Queue = queue } - type OperationCase = + type OperationCase<'a> = { ClContext: TestContext - MatrixCase: MatrixFormat } - - let testCases = - [ avaliableContexts "" |> Seq.map box - listOfUnionCases |> Seq.map box ] - |> List.map List.ofSeq - |> cartesian - |> List.map - (fun list -> - { ClContext = unbox list.[0] - MatrixCase = unbox list.[1] }) + MatrixCase: 'a } + + let cartesian firstList secondList = + firstList + |> List.collect (fun x -> secondList |> List.map (fun y -> x, y)) + + let testCases<'a> = + let avaliableCotextes = + avaliableContexts "" + |> List.ofSeq + + let listOfUnionCases = + listOfUnionCases<'a> + |> List.ofSeq + + cartesian avaliableCotextes listOfUnionCases + |> List.map (fun pair -> + { ClContext = fst pair + MatrixCase = snd pair }) let createMatrixFromArray2D matrixCase array isZero = match matrixCase with diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs index 3328ec5d..b9ba31ef 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs @@ -2,10 +2,8 @@ module Backend.Vector.ZeroCreate open Expecto open Expecto.Logging -open Expecto.Logging.Message -open Brahma.FSharp + open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Utils let logger = Log.create "Vector.zeroCreate.Tests" @@ -27,3 +25,18 @@ let checkResult size (actual: Vector<'a>) = Expect.equal actualValues [||] "" //TODO() Expect.equal actualIndices [||] "" //TODO() +let testFixtures (case: OperationCase) = + let config = defaultConfig + + let wgSize = 32 + + let getCorrectnessTestName datatype = + sprintf "Correctness on %s, %A" datatype case + + let context = case.ClContext.ClContext + let q = case.ClContext.Queue + + let zeroCreate = Vector.zeroCreate context wgSize + + () + From 25b068b432d8e6578534bb8f5fad6179f54f49e9 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 22 Oct 2022 23:23:52 +0300 Subject: [PATCH 24/74] add: Vector.zeroCreate tests --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 2 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 8 ++-- .../BackendCommonTests/ConvertTests.fs | 6 +-- .../BackendCommonTests/MatrixEwiseAddTests.fs | 10 ++-- .../BackendCommonTests/TransposeTests.fs | 8 ++-- tests/GraphBLAS-sharp.Tests/Helpers.fs | 4 +- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- .../VectorOperationsTests/zeroCreateTest.fs | 46 +++++++++++++------ 8 files changed, 53 insertions(+), 34 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 9662799a..9fa0f8ff 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -19,7 +19,7 @@ module Reduce = let gid = ndRange.GlobalID0 let lid = ndRange.LocalID0 - let i = (gid - lid) * 2 + lid + // let i = (gid - lid) * 2 + lid let localValues = localArray<'a> workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index da105c3b..23c7d883 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -6,21 +6,21 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module Vector = - let zeroCreate (clContext: ClContext) (workGroupSize: int) = + let zeroCreate<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let zeroCreate = ClArray.zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (size: int) (format: VectorFormat) -> match format with | COO -> - let indices = clContext.CreateClArray [||] - let values = clContext.CreateClArray [||] + let indices = clContext.CreateClArray [| 0 |] + let values = clContext.CreateClArray<'a> [| Unchecked.defaultof<'a> |] let vector = { ClCooVector.Context = clContext Indices = indices Values = values - Size = size } + Size = 0 } ClVectorCOO vector | Dense -> diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs index efb31703..32007b32 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs @@ -61,7 +61,7 @@ let makeTestCOO context q toCSR isZero (array: 'a [,]) = let testFixtures case = let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.MatrixCase + sprintf "Correctness on %s, %A" datatype case.FormatCase let filterFloat x = System.Double.IsNaN x @@ -71,7 +71,7 @@ let testFixtures case = let q = case.ClContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - match case.MatrixCase with + match case.FormatCase with | COO -> [ let toCSR = Matrix.toCSR context wgSize @@ -126,6 +126,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.MatrixCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures |> testList "Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs index 436b17e6..594fe979 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs @@ -56,10 +56,10 @@ let correctnessGenericTest = let mtx1 = - createMatrixFromArray2D case.MatrixCase leftMatrix (isEqual zero) + createMatrixFromArray2D case.FormatCase leftMatrix (isEqual zero) let mtx2 = - createMatrixFromArray2D case.MatrixCase rightMatrix (isEqual zero) + createMatrixFromArray2D case.FormatCase rightMatrix (isEqual zero) if mtx1.NNZCount > 0 && mtx2.NNZCount > 0 then let m1 = mtx1.ToBackend case.ClContext.ClContext @@ -140,7 +140,7 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.MatrixCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixturesEWiseAdd |> testList "Backend.Matrix.eWiseAdd tests" @@ -204,7 +204,7 @@ let tests2 = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.MatrixCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixturesEWiseAddAtLeastOne |> testList "Backend.Matrix.eWiseAddAtLeastOne tests" @@ -269,6 +269,6 @@ let tests3 = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.MatrixCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixturesEWiseMulAtLeastOne |> testList "Backend.Matrix.eWiseMulAtLeastOne tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs index 8edc2299..2273756a 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs @@ -54,7 +54,7 @@ let checkResult areEqual zero actual (expected2D: 'a [,]) = let makeTestRegular context q transposeFun areEqual zero case (array: 'a [,]) = let mtx = - createMatrixFromArray2D case.MatrixCase array (areEqual zero) + createMatrixFromArray2D case.FormatCase array (areEqual zero) if mtx.NNZCount > 0 then let actual = @@ -81,7 +81,7 @@ let makeTestRegular context q transposeFun areEqual zero case (array: 'a [,]) = let makeTestTwiceTranspose context q transposeFun areEqual zero case (array: 'a [,]) = let mtx = - createMatrixFromArray2D case.MatrixCase array (areEqual zero) + createMatrixFromArray2D case.FormatCase array (areEqual zero) if mtx.NNZCount > 0 then let actual = @@ -103,7 +103,7 @@ let makeTestTwiceTranspose context q transposeFun areEqual zero case (array: 'a let testFixtures case = let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.MatrixCase + sprintf "Correctness on %s, %A" datatype case.FormatCase let areEqualFloat x y = System.Double.IsNaN x && System.Double.IsNaN y @@ -167,6 +167,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.MatrixCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures |> testList "Transpose tests" diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 849bbca2..c36a7931 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -506,7 +506,7 @@ module Utils = type OperationCase<'a> = { ClContext: TestContext - MatrixCase: 'a } + FormatCase: 'a } let cartesian firstList secondList = firstList @@ -524,7 +524,7 @@ module Utils = cartesian avaliableCotextes listOfUnionCases |> List.map (fun pair -> { ClContext = fst pair - MatrixCase = snd pair }) + FormatCase = snd pair }) let createMatrixFromArray2D matrixCase array isZero = match matrixCase with diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index d3bb7228..54912816 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -26,7 +26,8 @@ let allTests = // //Matrix.Mxv.tests // //Algo.Bfs.tests //Backend.Vector.ZeroCreate.tests //TODO() - Backend.Reduce.tests + //Backend.Reduce.tests TODO() bytes doesn't work + Backend.Vector.ZeroCreate.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs index b9ba31ef..a86e3c01 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs @@ -10,33 +10,51 @@ let logger = Log.create "Vector.zeroCreate.Tests" let checkResult size (actual: Vector<'a>) = - Expect.equal actual.Size size "The size should be the same." - match actual with | VectorDense vector -> let actualValues = vector.Values + Expect.equal actual.Size size "The size should be the same." + for i in 0..actual.Size - 1 do - Expect.equal actualValues[i] None "" //TODO() + Expect.equal actualValues[i] None "values must be None" | VectorCOO vector -> let actualValues = vector.Values let actualIndices = vector.Indices - Expect.equal actualValues [||] "" //TODO() - Expect.equal actualIndices [||] "" //TODO() + Expect.equal actual.Size 0 "The size should be the 0." -let testFixtures (case: OperationCase) = - let config = defaultConfig + Expect.equal actualValues [| Unchecked.defaultof<'a> |] "The values array must contain the default value" + Expect.equal actualIndices [| 0 |] "The index array must contain the 0" - let wgSize = 32 +let correctnessGenericTest<'a when 'a: struct and 'a: equality> + (wgSize: int) + (case: OperationCase) + (vectorSize: int) + = + if vectorSize > 0 then + let context = case.ClContext.ClContext + let q = case.ClContext.Queue + + let clVector = Vector.zeroCreate<'a> context wgSize q vectorSize case.FormatCase - let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case + let hostVector = clVector.ToHost q - let context = case.ClContext.ClContext - let q = case.ClContext.Queue + clVector.Dispose q - let zeroCreate = Vector.zeroCreate context wgSize + checkResult vectorSize hostVector + +let testFixtures (case: OperationCase) = + let config = defaultConfig + + let wgSize = 32 - () + case + |> correctnessGenericTest wgSize + |> testPropertyWithConfig config (sprintf "Correctness on %A" case) +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.map testFixtures + |> testList "Backend.Vector.zeroCreate tests" From 5d1482e6a156da82405f20b69a0ac5e428a7c9ec Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 23 Oct 2022 17:30:54 +0300 Subject: [PATCH 25/74] add: Vector.copy tests --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 25 ++-- .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Objects/ArrayExtensions.fs | 30 +++++ src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 47 +------ .../Vector/DenseVector/DenseVector.fs | 69 +++++----- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 30 ++--- .../{ReduceTest.fs => ReduceTests.fs} | 0 .../GraphBLAS-sharp.Tests.fsproj | 7 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 24 +++- tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- .../VectorOperationsTests/copyTests.fs | 96 ++++++++++++++ .../fillSubVectorTest.fs | 2 + .../VectorOperationsTests/ofListTests.fs | 125 ++++++++++++++++++ .../{zeroCreateTest.fs => zeroCreateTests.fs} | 14 +- 14 files changed, 357 insertions(+), 117 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs rename tests/GraphBLAS-sharp.Tests/BackendCommonTests/{ReduceTest.fs => ReduceTests.fs} (100%) create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs rename tests/GraphBLAS-sharp.Tests/VectorOperationsTests/{zeroCreateTest.fs => zeroCreateTests.fs} (81%) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 9fa0f8ff..b8f7f931 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -19,25 +19,26 @@ module Reduce = let gid = ndRange.GlobalID0 let lid = ndRange.LocalID0 - // let i = (gid - lid) * 2 + lid + let i = (gid - lid) * 2 + lid let localValues = localArray<'a> workGroupSize - if gid < length then - localValues[lid] <- inputArray[gid] - else - localValues[lid] <- zero - - barrierLocal () - - // if i + workGroupSize < length then - // localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] - // elif i < length then - // localValues[lid] <- inputArray[i] + // + // if gid < length then + // localValues[lid] <- inputArray[gid] // else // localValues[lid] <- zero + // // barrierLocal () + if i + workGroupSize < length then + localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] + elif i < length then + localValues[lid] <- inputArray[i] + else + localValues[lid] <- zero + barrierLocal () + let mutable step = 2 while step <= workGroupSize do diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 8bb0abd6..853468fe 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -25,6 +25,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs new file mode 100644 index 00000000..57531e30 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs @@ -0,0 +1,30 @@ +namespace GraphBLAS.FSharp.Backend + +open Brahma.FSharp + +module ArraysExtensions = + + type ClArray<'a> with + member this.Dispose(q: MailboxProcessor) = + q.PostAndReply(fun _ -> Msg.CreateFreeMsg this) + + member this.ToHost(q: MailboxProcessor) = + let dst = Array.zeroCreate this.Length + q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) + + member this.Size = this.Length + + type 'a ``[]`` with + member this.Size = this.Length + + member this.ToString() = + [ sprintf "Dense Vector\n" + sprintf "Size: %i \n" this.Length + sprintf "Values: %A \n" this ] + |> String.concat "" + + member this.ToDevice(context: ClContext) = context.CreateClArray this + + static member FromArray(array: 'a [], isZero: 'a -> bool) = + array + |> Array.map (fun v -> if isZero v then None else Some v) diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index 4a0be9a9..065eb3ec 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -2,6 +2,7 @@ namespace GraphBLAS.FSharp.Backend open Brahma.FSharp open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.ArraysExtensions type VectorFormat = | COO @@ -72,48 +73,6 @@ and ClCooVector<'a> = member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) -type DenseVector<'a> = - { Values: 'a option [] } - - member this.Size = this.Values.Length - - override this.ToString() = - [ sprintf "Dense Vector\n" - sprintf "Size: %i \n" this.Values.Length - sprintf "Values: %A \n" this.Values ] - |> String.concat "" - - member this.ToDevice(context: ClContext) = - { ClDenseVector.Values = context.CreateClArray this.Values } - - static member FromArray(array: 'a [], isZero: 'a -> bool) = - { Values = - array - |> Array.map (fun v -> if isZero v then None else Some v) } - -and ClDenseVector<'a> = - { Values: ClArray<'a option> } - - member this.Size = this.Values.Length - - member this.ToHost(q: MailboxProcessor<_>) = - let vector = Array.zeroCreate this.Values.Length - - let _ = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this.Values, vector, ch)) - - { DenseVector.Values = vector } - - interface IDeviceMemObject with - member this.Dispose(q) = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.PostAndReply(Msg.MsgNotifyMe) - - member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) - - static member FromArray(context: ClContext, array: 'a option []) = - { Values = context.CreateClArray array } - type TuplesVector<'a> = { Indices: int [] Values: 'a [] @@ -169,7 +128,7 @@ and ClTuplesVector<'a> = type Vector<'a when 'a: struct> = | VectorCOO of COOVector<'a> - | VectorDense of DenseVector<'a> + | VectorDense of 'a option [] member this.Size = match this with | VectorCOO vector -> vector.Size @@ -182,7 +141,7 @@ type Vector<'a when 'a: struct> = and ClVector<'a when 'a: struct> = | ClVectorCOO of ClCooVector<'a> - | ClVectorDense of ClDenseVector<'a> + | ClVectorDense of ClArray<'a option> member this.Size = match this with | ClVectorCOO vector -> vector.Size diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 56d569f1..473e14e3 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -6,7 +6,8 @@ open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Quotations module DenseVector = - let private copyWithValue (clContext: ClContext) (workGroupSize: int) = + + let private maskWithValue (clContext: ClContext) (workGroupSize: int) = //TODO() let fillVector = <@ @@ -24,11 +25,11 @@ module DenseVector = let kernel = clContext.Compile(fillVector) - fun (processor: MailboxProcessor<_>) (maskVector: ClDenseVector<'a>) (scalar: 'b) -> + fun (processor: MailboxProcessor<_>) (maskVector: ClArray<'a option>) (scalar: 'b) -> let resultArray = clContext.CreateClArray( - maskVector.Size, + maskVector.Length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default @@ -42,7 +43,7 @@ module DenseVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(maskVector.Size, workGroupSize) + let ndRange = Range1D.CreateValid(maskVector.Length, workGroupSize) let kernel = kernel.GetKernel() @@ -51,8 +52,8 @@ module DenseVector = fun () -> kernel.KernelFunc ndRange - maskVector.Size - maskVector.Values + maskVector.Length + maskVector clScalar resultArray) ) @@ -60,7 +61,7 @@ module DenseVector = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) processor.Post(Msg.CreateFreeMsg<_>(clScalar)) - { Values = resultArray } + resultArray let elementWiseAddAtLeasOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) @@ -96,17 +97,17 @@ module DenseVector = let kernel = clContext.Compile(eWiseAdd) - fun (processor: MailboxProcessor<_>) (leftVector: ClDenseVector<'a>) (rightVector: ClDenseVector<'b>) -> + fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> let resultVector = clContext.CreateClArray( - leftVector.Size, + leftVector.Length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.WriteOnly, allocationMode = AllocationMode.Default ) - let resultLength = max leftVector.Size rightVector.Size + let resultLength = max leftVector.Length rightVector.Length let ndRange = Range1D.CreateValid (resultLength, workGroupSize) @@ -117,16 +118,16 @@ module DenseVector = fun () -> kernel.KernelFunc ndRange - leftVector.Size - rightVector.Size - leftVector.Values - rightVector.Values + leftVector.Length + rightVector.Length + leftVector + rightVector resultVector) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - { Values = resultVector } + resultVector let fillSubVector (clContext: ClContext) (workGroupSize: int) = @@ -134,16 +135,16 @@ module DenseVector = let eWiseAdd = elementWiseAddAtLeasOne clContext opAdd workGroupSize - let copyWithValue = copyWithValue clContext workGroupSize + let copyWithValue = maskWithValue clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClDenseVector<'a>) (maskVector: ClDenseVector<'b>) (scalar: 'a) -> + fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (scalar: 'a) -> let maskVector = copyWithValue processor maskVector scalar let resultVector = eWiseAdd processor leftVector maskVector - processor.Post(Msg.CreateFreeMsg<_>(maskVector.Values)) + processor.Post(Msg.CreateFreeMsg<_>(maskVector)) resultVector @@ -166,9 +167,9 @@ module DenseVector = let kernel = clContext.Compile(complemented) - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - let length = vector.Size + let length = vector.Length let resultArray = clContext.CreateClArray( @@ -188,11 +189,11 @@ module DenseVector = kernel.KernelFunc ndRange length - vector.Values + vector resultArray) ) - { Values = resultArray } + resultArray let getSomeBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = @@ -212,17 +213,17 @@ module DenseVector = let kernel = clContext.Compile(getSomeBitmap) - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> let positions = clContext.CreateClArray( - vector.Size, + vector.Length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(vector.Size, workGroupSize) + let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) let kernel = kernel.GetKernel() @@ -231,8 +232,8 @@ module DenseVector = fun () -> kernel.KernelFunc ndRange - vector.Size - vector.Values + vector.Length + vector positions)) processor.Post(Msg.CreateRunMsg(kernel)) @@ -268,7 +269,7 @@ module DenseVector = let resultLength = Array.zeroCreate 1 - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> let bitmap = getBitmap processor vector @@ -300,7 +301,7 @@ module DenseVector = deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default) - let ndRange = Range1D.CreateValid(vector.Size, workGroupSize) + let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) let kernel = kernel.GetKernel() @@ -309,8 +310,8 @@ module DenseVector = fun () -> kernel.KernelFunc ndRange - vector.Size - vector.Values + vector.Length + vector prefixSumArray bitmap resultValues @@ -328,14 +329,14 @@ module DenseVector = let unzip = unzip clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> let values, indices = unzip processor vector { ClCooVector.Context = clContext Indices = indices Values = values - Size = vector.Size } + Size = vector.Length } let reduce @@ -348,7 +349,7 @@ module DenseVector = let reduce = Reduce.run clContext workGroupSize opAdd Unchecked.defaultof<'a> //TODO() - fun (processor: MailboxProcessor<_>) (vector: ClDenseVector<'a>) -> + fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> let values, indices = unzip processor vector diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 23c7d883..afec9b01 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -8,7 +8,7 @@ open Microsoft.FSharp.Quotations module Vector = let zeroCreate<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + let denseZeroCreate = ClArray.zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (size: int) (format: VectorFormat) -> match format with @@ -24,10 +24,9 @@ module Vector = ClVectorCOO vector | Dense -> - let resultValues = zeroCreate processor size - let vector = { Values = resultValues } + let resultValues = denseZeroCreate processor size - ClVectorDense vector + ClVectorDense resultValues let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = @@ -39,8 +38,8 @@ module Vector = |> Array.sortBy fst |> Array.unzip - let indices = clContext.CreateClArray indices - let values = clContext.CreateClArray values + let clIndices = clContext.CreateClArray indices + let clValues = clContext.CreateClArray values fun (processor: MailboxProcessor<_>) (format: VectorFormat) -> match format with @@ -49,20 +48,19 @@ module Vector = let vector = { ClCooVector.Context = clContext - Indices = indices - Values = values + Indices = clIndices + Values = clValues Size = resultSize } ClVectorCOO vector | Dense -> - let array = - toOptionArray processor values indices elements.Length + let size = Array.max indices - let vector = - { Values = array } + let array = + toOptionArray processor clValues clIndices size - ClVectorDense vector + ClVectorDense array let copy (clContext: ClContext) (workGroupSize: int) = let copy = @@ -85,10 +83,10 @@ module Vector = ClVectorCOO vector | ClVectorDense vector -> - let vector = - copyOptionData processor vector.Values + let array = + copyOptionData processor vector - ClVectorDense { Values = vector } + ClVectorDense array let mask = copy diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTest.fs rename to tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index af9ef45c..6fced9ad 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -20,7 +20,7 @@ - + @@ -28,7 +28,10 @@ - + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c36a7931..9058f6b9 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -5,6 +5,7 @@ open Brahma.FSharp.OpenCL.Translator open FsCheck open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp +open MathNet.Numerics.LinearAlgebra.Complex32 open Microsoft.FSharp.Reflection open Brahma.FSharp open Brahma.FSharp.ClContextExtensions @@ -534,7 +535,12 @@ module Utils = let createVectorFromArray vectorCase array isZero = match vectorCase with | VectorFormat.COO -> VectorCOO <| COOVector.FromArray(array, isZero) - | VectorFormat.Dense -> VectorDense <| DenseVector.FromArray(array, isZero) + | VectorFormat.Dense -> + VectorDense + <| Array.map + (fun (item :'a) -> if isZero item then None else Some item ) + array + let compareArrays areEqual (actual: 'a []) (expected: 'a []) message = sprintf "%s. Lengths should be equal. Actual is %A, expected %A" message actual expected @@ -549,3 +555,19 @@ module Utils = <| actual.[i] <| expected.[i] |> failtestf "%s" + + let createOptionArray elements = + + let indices, values = + elements + |> Array.ofList + |> Array.unzip + + let result = Array.zeroCreate <| Array.max indices + + for i in 0 .. indices.Length do + let index = indices[i] + + result[index] <- Some values[i] + + result diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 54912816..513934f9 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -26,8 +26,8 @@ let allTests = // //Matrix.Mxv.tests // //Algo.Bfs.tests //Backend.Vector.ZeroCreate.tests //TODO() - //Backend.Reduce.tests TODO() bytes doesn't work - Backend.Vector.ZeroCreate.tests + Backend.Reduce.tests + //Backend.Vector.ZeroCreate.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs new file mode 100644 index 00000000..0ace6925 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs @@ -0,0 +1,96 @@ +module Backend.Vector.Copy + +open Expecto +open Expecto.Logging + +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests.Utils + +let logger = Log.create "Vector.zeroCreate.Tests" + +let clContext = defaultContext.ClContext + +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 + | VectorDense actual, VectorDense expected -> + let isEqual left right = + match left, right with + | Some left, Some right -> + isEqual left right + | None, None -> true + | _, _ -> false + + compareArrays isEqual actual expected "The values array must contain the default value" + | VectorCOO actual, VectorCOO expected -> + compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" + 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 + (isZero: 'a -> bool) + (copy: MailboxProcessor -> ClVector<'a> -> ClVector<'a>) + (case: OperationCase) + (array: 'a []) + = + if array.Length > 0 then + let q = case.ClContext.Queue + let context = case.ClContext.ClContext + + let expected = + createVectorFromArray case.FormatCase array isZero + + let clVector = expected.ToDevice context + let clVectorCopy = copy q clVector + let actual = clVectorCopy.ToHost q + + clVector.Dispose q + clVectorCopy.Dispose q + + checkResult isEqual actual expected + +let testFixtures (case: OperationCase) = + let config = defaultConfig + + let getCorrectnessTestName datatype = + sprintf "Correctness on %s, %A" datatype case.FormatCase + + let wgSize = 32 + let context = case.ClContext.ClContext + + [ let intCopy = Vector.copy context wgSize + let isZero item = item = 0 + + case + |> correctnessGenericTest (=) isZero intCopy + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + let floatCopy = Vector.copy context wgSize + let isZero item = item = 0.0 + + case + |> correctnessGenericTest (=) isZero floatCopy + |> testPropertyWithConfig config (getCorrectnessTestName "float") + + let boolCopy = Vector.copy context wgSize + let isZero item = item = true + + case + |> correctnessGenericTest (=) isZero boolCopy + |> testPropertyWithConfig config (getCorrectnessTestName "bool") + + let floatCopy = Vector.copy context wgSize + let isZero item = item = 0uy + + case + |> correctnessGenericTest (=) isZero floatCopy + |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] + +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect testFixtures + |> testList "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs new file mode 100644 index 00000000..2b2eb4b7 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs @@ -0,0 +1,2 @@ +module GraphBLAS-sharp.Tests.VectorOperationsTests.fillSubVectorTest + diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs new file mode 100644 index 00000000..697d746f --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs @@ -0,0 +1,125 @@ +module Backend.Vector.OfList + +open Brahma.FSharp +open Expecto +open Expecto.Logging + +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests.Utils + +let logger = Log.create "Vector.zeroCreate.Tests" + +let checkResultDense + (isEqual: 'a -> 'a -> bool) + (expectedValues: 'a option []) + (actual: 'a option []) + = + + let actualSize = actual.Length + let expectedSize = expectedValues.Length + + Expect.equal actualSize expectedSize "lengths must be the same" + + let isEqual (left: 'a option) (right: 'a option) = + match left, right with + | Some left, Some right -> + isEqual left right + | None, None -> true + | _, _ -> false + + compareArrays isEqual actual expectedValues "values must be the same" + +let checkResultCOO + (isEqual: 'a -> 'a -> bool) + (expectedIndices: int []) + (expectedValues: 'a []) + (actual: COOVector<'a>) + = + + let actualSize = actual.Size + let expectedSize = expectedValues.Length + + Expect.equal actualSize expectedSize "lengths must be the same" + + compareArrays (=) actual.Indices expectedIndices "indices must be the same" + + compareArrays isEqual actual.Values expectedValues "values must be the same" + + +let correctnessGenericTest<'a when 'a: struct> + (isEqual: 'a -> 'a -> bool) + (ofList: (int * 'a) list -> MailboxProcessor -> VectorFormat -> ClVector<'a>) + (case: OperationCase) + (elements: (int * 'a) list) + = + + if elements.Length > 0 then + + let q = case.ClContext.Queue + + let indices, values = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip + + let clActual = + ofList elements q case.FormatCase + + let actual = clActual.ToHost q + + clActual.Dispose q + + match actual with + | VectorDense actual -> + let expected = + createOptionArray elements + + checkResultDense isEqual expected actual + | VectorCOO actual -> + checkResultCOO isEqual indices values actual + +let testFixtures (case: OperationCase) = + [ let config = defaultConfig + + let wgSize = 32 + + let context = case.ClContext.ClContext + + let getCorrectnessTestName datatype = + sprintf "Correctness on %s, %A" datatype case.FormatCase + + let intOfList = + Vector.ofList context wgSize + + case + |> correctnessGenericTest (=) intOfList + |> testPropertyWithConfig config (getCorrectnessTestName "bool") + + + let intOfList = + Vector.ofList context wgSize + + case + |> correctnessGenericTest (=) intOfList + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + let intOfList = + Vector.ofList context wgSize + + case + |> correctnessGenericTest (=) intOfList + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + let intOfList = + Vector.ofList context wgSize + + case + |> correctnessGenericTest (=) intOfList + |> testPropertyWithConfig config (getCorrectnessTestName "int")] + +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect testFixtures + |> testList "Backend.Vector.ofList tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs similarity index 81% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs index a86e3c01..c15397d1 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs @@ -12,9 +12,9 @@ let checkResult size (actual: Vector<'a>) = match actual with | VectorDense vector -> - let actualValues = vector.Values + let actualValues = vector - Expect.equal actual.Size size "The size should be the same." + Expect.equal actual.Size size "The size should be the same" for i in 0..actual.Size - 1 do Expect.equal actualValues[i] None "values must be None" @@ -22,21 +22,23 @@ let checkResult size (actual: Vector<'a>) = let actualValues = vector.Values let actualIndices = vector.Indices - Expect.equal actual.Size 0 "The size should be the 0." + Expect.equal actual.Size 0 "The size should be the 0" Expect.equal actualValues [| Unchecked.defaultof<'a> |] "The values array must contain the default value" - Expect.equal actualIndices [| 0 |] "The index array must contain the 0" + Expect.equal actualIndices [| |] "The index array must contain the 0" let correctnessGenericTest<'a when 'a: struct and 'a: equality> (wgSize: int) (case: OperationCase) (vectorSize: int) = + if vectorSize > 0 then let context = case.ClContext.ClContext let q = case.ClContext.Queue - let clVector = Vector.zeroCreate<'a> context wgSize q vectorSize case.FormatCase + let clVector = + Vector.zeroCreate<'a> context wgSize q vectorSize case.FormatCase let hostVector = clVector.ToHost q @@ -45,8 +47,8 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> checkResult vectorSize hostVector let testFixtures (case: OperationCase) = - let config = defaultConfig + let config = { defaultConfig with endSize = 10 } let wgSize = 32 case From cc9f632ad132940fc10a2e2b8794b4f0f79da561 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 23 Oct 2022 21:49:11 +0300 Subject: [PATCH 26/74] fix Reduce --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 158 +++++++++++++++--- .../BackendCommonTests/ReduceTests.fs | 2 +- .../fillSubVectorTest.fs | 108 +++++++++++- 3 files changed, 241 insertions(+), 27 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index b8f7f931..fcff230d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -5,43 +5,95 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module Reduce = - let run + let private scan (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) (zero: 'a) = - let reduce = + let scan = <@ - fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> let gid = ndRange.GlobalID0 let lid = ndRange.LocalID0 - let i = (gid - lid) * 2 + lid + let localValues = localArray<'a> workGroupSize + + if gid < length then + localValues[lid] <- inputArray[gid] + else + localValues[lid] <- zero + + barrierLocal () + + let mutable step = 2 + + while step <= workGroupSize do + + if lid < workGroupSize / step then + let firstValue = localValues[lid] + let secondValue = localValues[lid + workGroupSize / step] + + localValues[lid] <- (%opAdd) firstValue secondValue + + step <- step <<< 1 + + barrierLocal () + + resultArray[gid / workGroupSize] <- localValues[0] + @> + + let kernel = clContext.Compile(scan) + + fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> + + let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + valuesLength + valuesArray + resultArray) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + () + + let private scanToCell + (clContext: ClContext) + (workGroupSize: int) + (opAdd: Expr<'a -> 'a -> 'a>) + (zero: 'a) + = + + let scan = + <@ + fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultCell: ClCell<'a>) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 let localValues = localArray<'a> workGroupSize - // - // if gid < length then - // localValues[lid] <- inputArray[gid] - // else - // localValues[lid] <- zero - // - // barrierLocal () - - if i + workGroupSize < length then - localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] - elif i < length then - localValues[lid] <- inputArray[i] + if gid < length then + localValues[lid] <- inputArray[gid] else localValues[lid] <- zero + barrierLocal () let mutable step = 2 while step <= workGroupSize do + if lid < workGroupSize / step then let firstValue = localValues[lid] let secondValue = localValues[lid + workGroupSize / step] @@ -52,18 +104,16 @@ module Reduce = barrierLocal () - if lid = 0 then - atomic (%opAdd) totalSum.Value localValues[0] |> ignore + resultCell.Value <- localValues[0] @> - let kernel = clContext.Compile(reduce) + let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) - let totalSum = - clContext.CreateClCell(zero) + let resultCell = clContext.CreateClCell zero let kernel = kernel.GetKernel() @@ -72,11 +122,69 @@ module Reduce = fun () -> kernel.KernelFunc ndRange - valuesArray.Length + valuesLength valuesArray - totalSum) + resultCell) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - totalSum + resultCell + + let run + (clContext: ClContext) + (workGroupSize: int) + (opAdd: Expr<'a -> 'a -> 'a>) + (zero: 'a) + = + + let scan = scan clContext workGroupSize opAdd zero + let scanToCell = scanToCell clContext workGroupSize opAdd zero + + fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + + let scan = scan processor + + let firstLength = (inputArray.Length - 1) / workGroupSize + 1 + + let firstVerticesArray = + clContext.CreateClArray( + firstLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let secondLength = (firstLength - 1) / workGroupSize + 1 + + let secondVerticesArray = + clContext.CreateClArray( + secondLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let mutable verticesArrays = firstVerticesArray, secondVerticesArray + let swap (a, b) = (b, a) + + scan inputArray inputArray.Length (fst verticesArrays) + + let mutable verticesLength = firstLength + + while verticesLength > workGroupSize do + let fstVertices = fst verticesArrays + let sndVertices = snd verticesArrays + + scan fstVertices verticesLength sndVertices + + verticesArrays <- swap verticesArrays + verticesLength <- (verticesLength - 1) / workGroupSize + 1 + + let fstVertices = fst verticesArrays + let result = scanToCell processor fstVertices verticesLength + + processor.Post(Msg.CreateFreeMsg(firstVerticesArray)) + processor.Post(Msg.CreateFreeMsg(secondVerticesArray)) + + result diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index f88bda9b..74911884 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -58,7 +58,7 @@ let testFixtures config wgSize q plus plusQ zero isEqual filter name = |> testPropertyWithConfig config (sprintf "Correctness on %s" name) let tests = - let config = { defaultConfig with endSize = 500 } //TODO() + let config = defaultConfig let wgSize = 32 let q = defaultContext.Queue diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs index 2b2eb4b7..5e59205a 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs @@ -1,2 +1,108 @@ -module GraphBLAS-sharp.Tests.VectorOperationsTests.fillSubVectorTest +module Backend.Vector.FillSubVector +open Expecto +open Expecto.Logging + +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests.Utils + +let logger = Log.create "Vector.zeroCreate.Tests" + +let clContext = defaultContext.ClContext + + +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 + | VectorDense actual, VectorDense expected -> + let isEqual left right = + match left, right with + | Some left, Some right -> + isEqual left right + | None, None -> true + | _, _ -> false + + compareArrays isEqual actual expected "The values array must contain the default value" + | VectorCOO actual, VectorCOO expected -> + compareArrays isEqual actual.Values expected.Values "The values array must contain the same values" + compareArrays (=) actual.Indices expected.Indices "The index array must contain the same indices" + | _, _ -> failwith "Copy format must be the same" + + + + +let makeTest<'a, 'b when 'a: struct and 'b: struct> + (maskFormat: VectorFormat) + isEqual + (isVectorItemZero: 'a -> bool) + (isMaskItemZero: 'b -> bool) + (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) + (case: OperationCase) + (array: 'a []) + (mask: 'b []) + (value: 'a) + = + + if array.Length > 0 then + + let q = case.ClContext.Queue + let context = case.ClContext.ClContext + + let sourceVector = + createVectorFromArray case.FormatCase array isVectorItemZero + + let clSourceVector = + sourceVector.ToDevice context + + let maskVector = + createVectorFromArray maskFormat mask isMaskItemZero + + let clMaskVector = + maskVector.ToDevice context + + let expected = + let expected = array + + for i in 0 .. mask.Length do + if i < array.Length && not (isMaskItemZero mask[i]) then + expected[i] <- value + + createVectorFromArray case.FormatCase expected isVectorItemZero + + let clActual = + fillVector q clSourceVector clMaskVector value + + let actual = clActual.ToHost q + + clSourceVector.Dispose q + clMaskVector.Dispose q + clActual.Dispose q + + checkResult isEqual actual expected + + +// let testFixtures (case: OperationCase) = +// let config = defaultConfig +// +// let getCorrectnessTestName datatype = +// sprintf "Correctness on %s, %A" datatype case.FormatCase +// +// let wgSize = 32 +// let context = case.ClContext.ClContext +// +// [ let intFill = Vector.fillSubVector context wgSize +// let isZero item = item = 0 +// +// case +// |> correctnessGenericTest (=) isZero intFill +// |> testPropertyWithConfig config (getCorrectnessTestName "int") +// +// ] +// +// let tests = +// testCases +// |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) +// |> List.collect testFixtures +// |> testList "Backend.Vector.copy tests" From 4959176b40f3e1bdb27439c64ba5ab4fd7b5d61f Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 24 Oct 2022 00:06:12 +0300 Subject: [PATCH 27/74] refactor: Reduce.run, add: Reduce.atomicRun --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 88 ++++++++++++++++++- .../BackendCommonTests/ReduceTests.fs | 4 + 2 files changed, 88 insertions(+), 4 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index fcff230d..4349c8d7 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -21,13 +21,24 @@ module Reduce = let localValues = localArray<'a> workGroupSize - if gid < length then - localValues[lid] <- inputArray[gid] + let i = (gid - lid) * 2 + lid + + if i + workGroupSize < length then + localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] + elif i < length then + localValues[lid] <- inputArray[i] else localValues[lid] <- zero barrierLocal () + // if gid < length then + // localValues[lid] <- inputArray[gid] + // else + // localValues[lid] <- zero + // + // barrierLocal () + let mutable step = 2 while step <= workGroupSize do @@ -83,8 +94,12 @@ module Reduce = let localValues = localArray<'a> workGroupSize - if gid < length then - localValues[lid] <- inputArray[gid] + let i = (gid - lid) * 2 + lid + + if i + workGroupSize < length then + localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] + elif i < length then + localValues[lid] <- inputArray[i] else localValues[lid] <- zero @@ -188,3 +203,68 @@ module Reduce = processor.Post(Msg.CreateFreeMsg(secondVerticesArray)) result + + let atomicRun + (clContext: ClContext) + (workGroupSize: int) + (opAdd: Expr<'a -> 'a -> 'a>) + (zero: 'a) + = + + let reduce = + <@ + fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let localValues = localArray<'a> workGroupSize + + if gid < length then + localValues[lid] <- inputArray[gid] + else + localValues[lid] <- zero + + barrierLocal () + + let mutable step = 2 + + while step <= workGroupSize do + if lid < workGroupSize / step then + let firstValue = localValues[lid] + let secondValue = localValues[lid + workGroupSize / step] + + localValues[lid] <- (%opAdd) firstValue secondValue + + step <- step <<< 1 + + barrierLocal () + + if lid = 0 then + atomic (%opAdd) totalSum.Value localValues[0] |> ignore + @> + + let kernel = clContext.Compile(reduce) + + fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) -> + + let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) + + let totalSum = + clContext.CreateClCell(zero) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + valuesArray.Length + valuesArray + totalSum) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + totalSum diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index 74911884..a000e6e6 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -54,9 +54,13 @@ let testFixtures config wgSize q plus plusQ zero isEqual filter name = let reduce = Reduce.run context wgSize plusQ + let atomicResult = + Reduce.atomicRun context wgSize plusQ + makeTest q reduce plus zero isEqual filter |> testPropertyWithConfig config (sprintf "Correctness on %s" name) + let tests = let config = defaultConfig From 462295e84204175a30e2dc2256b664a379ed93ba Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 24 Oct 2022 10:46:17 +0300 Subject: [PATCH 28/74] add: Vector.ofList tests --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 5 ++- .../Objects/ArrayExtensions.fs | 9 +++--- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- .../BackendCommonTests/ReduceTests.fs | 8 ++--- tests/GraphBLAS-sharp.Tests/Helpers.fs | 11 ++----- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- .../VectorOperationsTests/ofListTests.fs | 32 ++++++++++--------- .../VectorOperationsTests/zeroCreateTests.fs | 15 ++++----- 8 files changed, 38 insertions(+), 47 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 6cb8fe32..ce9f0f68 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -453,7 +453,6 @@ module ClArray = outputArray - //TODO(comments) let toOptionArray (clContext: ClContext) (workGroupSize: int) = let toOption = @@ -464,7 +463,7 @@ module ClArray = if gid < length then let resultIndex = indices[gid] - outputArray[resultIndex] <- Some values[resultIndex] + outputArray[resultIndex] <- Some values[gid] @> let kernel = clContext.Compile(toOption) @@ -480,7 +479,7 @@ module ClArray = processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange size values indices outputArray) + (fun () -> kernel.KernelFunc ndRange indices.Length values indices outputArray) ) processor.Post(Msg.CreateRunMsg<_, _> kernel) diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs index 57531e30..4ab7d221 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs @@ -6,7 +6,8 @@ module ArraysExtensions = type ClArray<'a> with member this.Dispose(q: MailboxProcessor) = - q.PostAndReply(fun _ -> Msg.CreateFreeMsg this) + q.Post(Msg.CreateFreeMsg this) + q.PostAndReply(Msg.MsgNotifyMe) member this.ToHost(q: MailboxProcessor) = let dst = Array.zeroCreate this.Length @@ -25,6 +26,6 @@ module ArraysExtensions = member this.ToDevice(context: ClContext) = context.CreateClArray this - static member FromArray(array: 'a [], isZero: 'a -> bool) = - array - |> Array.map (fun v -> if isZero v then None else Some v) + let FromArray (array: 'a [], isZero: 'a -> bool) = + array + |> Array.map (fun v -> if isZero v then None else Some v) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index afec9b01..10a1bf55 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -55,7 +55,7 @@ module Vector = ClVectorCOO vector | Dense -> - let size = Array.max indices + let size = (Array.max indices) + 1 let array = toOptionArray processor clValues clIndices size diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index a000e6e6..a55cf447 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -11,10 +11,9 @@ let logger = Log.create "Reduce.Tests" let context = defaultContext.ClContext -let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> 'a []) (array: 'a []) = - let array = filter array - +let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> 'a []) (array: 'a []) = // TODO remove isEqual if array.Length > 0 then + let array = filter array let reduce = reduce zero q @@ -54,9 +53,6 @@ let testFixtures config wgSize q plus plusQ zero isEqual filter name = let reduce = Reduce.run context wgSize plusQ - let atomicResult = - Reduce.atomicRun context wgSize plusQ - makeTest q reduce plus zero isEqual filter |> testPropertyWithConfig config (sprintf "Correctness on %s" name) diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 9058f6b9..aa162d8f 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -535,12 +535,7 @@ module Utils = let createVectorFromArray vectorCase array isZero = match vectorCase with | VectorFormat.COO -> VectorCOO <| COOVector.FromArray(array, isZero) - | VectorFormat.Dense -> - VectorDense - <| Array.map - (fun (item :'a) -> if isZero item then None else Some item ) - array - + | VectorFormat.Dense -> VectorDense <| ArraysExtensions.FromArray(array, isZero) let compareArrays areEqual (actual: 'a []) (expected: 'a []) message = sprintf "%s. Lengths should be equal. Actual is %A, expected %A" message actual expected @@ -563,9 +558,9 @@ module Utils = |> Array.ofList |> Array.unzip - let result = Array.zeroCreate <| Array.max indices + let result = Array.zeroCreate <| (Array.max indices) + 1 - for i in 0 .. indices.Length do + for i in 0 .. indices.Length - 1 do let index = indices[i] result[index] <- Some values[i] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 513934f9..2575d329 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -26,8 +26,9 @@ let allTests = // //Matrix.Mxv.tests // //Algo.Bfs.tests //Backend.Vector.ZeroCreate.tests //TODO() - Backend.Reduce.tests + //Backend.Reduce.tests //Backend.Vector.ZeroCreate.tests + Backend.Vector.OfList.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs index 697d746f..95ede4a5 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs @@ -1,14 +1,21 @@ module Backend.Vector.OfList -open Brahma.FSharp open Expecto open Expecto.Logging - -open GraphBLAS.FSharp.Backend +open Brahma.FSharp open GraphBLAS.FSharp.Tests.Utils +open GraphBLAS.FSharp.Backend let logger = Log.create "Vector.zeroCreate.Tests" +let filter elements = + List.filter + <| (fun item -> fst item > 0) + <| elements + |> List.distinctBy fst + + + let checkResultDense (isEqual: 'a -> 'a -> bool) (expectedValues: 'a option []) @@ -45,7 +52,6 @@ let checkResultCOO compareArrays isEqual actual.Values expectedValues "values must be the same" - let correctnessGenericTest<'a when 'a: struct> (isEqual: 'a -> 'a -> bool) (ofList: (int * 'a) list -> MailboxProcessor -> VectorFormat -> ClVector<'a>) @@ -53,6 +59,8 @@ let correctnessGenericTest<'a when 'a: struct> (elements: (int * 'a) list) = + let elements = filter elements + if elements.Length > 0 then let q = case.ClContext.Queue @@ -89,11 +97,11 @@ let testFixtures (case: OperationCase) = let getCorrectnessTestName datatype = sprintf "Correctness on %s, %A" datatype case.FormatCase - let intOfList = + let boolOfList = Vector.ofList context wgSize case - |> correctnessGenericTest (=) intOfList + |> correctnessGenericTest (=) boolOfList |> testPropertyWithConfig config (getCorrectnessTestName "bool") @@ -104,19 +112,13 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) intOfList |> testPropertyWithConfig config (getCorrectnessTestName "int") - let intOfList = - Vector.ofList context wgSize - - case - |> correctnessGenericTest (=) intOfList - |> testPropertyWithConfig config (getCorrectnessTestName "int") - let intOfList = + let byteOfList = Vector.ofList context wgSize case - |> correctnessGenericTest (=) intOfList - |> testPropertyWithConfig config (getCorrectnessTestName "int")] + |> correctnessGenericTest (=) byteOfList + |> testPropertyWithConfig config (getCorrectnessTestName "byte")] let tests = testCases diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs index c15397d1..8b3bff85 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs @@ -12,20 +12,17 @@ let checkResult size (actual: Vector<'a>) = match actual with | VectorDense vector -> - let actualValues = vector Expect.equal actual.Size size "The size should be the same" - for i in 0..actual.Size - 1 do - Expect.equal actualValues[i] None "values must be None" + Array.iter + <| (fun item -> Expect.equal item None "values must be None") + <| vector | VectorCOO vector -> - let actualValues = vector.Values - let actualIndices = vector.Indices - Expect.equal actual.Size 0 "The size should be the 0" - Expect.equal actualValues [| Unchecked.defaultof<'a> |] "The values array must contain the default value" - Expect.equal actualIndices [| |] "The index array must contain the 0" + 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> (wgSize: int) @@ -48,7 +45,7 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> let testFixtures (case: OperationCase) = - let config = { defaultConfig with endSize = 10 } + let config = { defaultConfig with maxTest = 1} let wgSize = 32 case From 50bd2b66dba7a90e0f17b6ee66ef5ec382de1582 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 24 Oct 2022 10:56:30 +0300 Subject: [PATCH 29/74] add: Vector.copy tests --- .../GraphBLAS-sharp.Tests.fsproj | 8 ++++---- tests/GraphBLAS-sharp.Tests/Program.fs | 3 ++- .../VectorOperationsTests/copyTests.fs | 14 ++++++++++---- 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 6fced9ad..3ccf67ad 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -28,10 +28,10 @@ - - - - + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 2575d329..f4146335 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -28,7 +28,8 @@ let allTests = //Backend.Vector.ZeroCreate.tests //TODO() //Backend.Reduce.tests //Backend.Vector.ZeroCreate.tests - Backend.Vector.OfList.tests + //Backend.Vector.OfList.tests + Backend.Vector.Copy.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs index 0ace6925..195d9d8e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs @@ -30,6 +30,7 @@ let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vect | _, _ -> failwith "Copy format must be the same" let correctnessGenericTest<'a when 'a: struct> + filter isEqual (isZero: 'a -> bool) (copy: MailboxProcessor -> ClVector<'a> -> ClVector<'a>) @@ -37,6 +38,8 @@ let correctnessGenericTest<'a when 'a: struct> (array: 'a []) = if array.Length > 0 then + let array = filter array + let q = case.ClContext.Queue let context = case.ClContext.ClContext @@ -53,6 +56,9 @@ let correctnessGenericTest<'a when 'a: struct> checkResult isEqual actual expected let testFixtures (case: OperationCase) = + let filterFloats = + Array.filter (System.Double.IsNaN >> not) + let config = defaultConfig let getCorrectnessTestName datatype = @@ -65,28 +71,28 @@ let testFixtures (case: OperationCase) = let isZero item = item = 0 case - |> correctnessGenericTest (=) isZero intCopy + |> correctnessGenericTest id (=) isZero intCopy |> testPropertyWithConfig config (getCorrectnessTestName "int") let floatCopy = Vector.copy context wgSize let isZero item = item = 0.0 case - |> correctnessGenericTest (=) isZero floatCopy + |> correctnessGenericTest filterFloats (=) isZero floatCopy |> testPropertyWithConfig config (getCorrectnessTestName "float") let boolCopy = Vector.copy context wgSize let isZero item = item = true case - |> correctnessGenericTest (=) isZero boolCopy + |> correctnessGenericTest id (=) isZero boolCopy |> testPropertyWithConfig config (getCorrectnessTestName "bool") let floatCopy = Vector.copy context wgSize let isZero item = item = 0uy case - |> correctnessGenericTest (=) isZero floatCopy + |> correctnessGenericTest id (=) isZero floatCopy |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let tests = From 0be850c823346e016a19e06224efbda1941f082e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 24 Oct 2022 12:39:21 +0300 Subject: [PATCH 30/74] add: Vector.toCoo tests --- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 12 +++ .../GraphBLAS-sharp.Tests.fsproj | 2 + tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- .../VectorOperationsTests/ConvertTest.fs | 77 ++++++++++++++++ .../ElementWiseAddAtLeastOne.fs | 92 +++++++++++++++++++ .../fillSubVectorTest.fs | 56 +++++------ 6 files changed, 211 insertions(+), 32 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 10a1bf55..56127184 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -90,6 +90,18 @@ module Vector = let mask = copy + let toCoo (clContext: ClContext) (workGroupSize: int) = + let toCoo = DenseVector.toCoo clContext workGroupSize + + let copy = copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + match vector with + | ClVectorDense vector -> + ClVectorCOO <| toCoo processor vector + | ClVectorCOO _ -> + copy processor vector + let fillSubVector (clContext: ClContext) (workGroupSize: int) = let cooFillVector = COOVector.fillSubVector clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 3ccf67ad..b2559d2e 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -32,6 +32,8 @@ + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f4146335..dbf951c3 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -29,7 +29,9 @@ let allTests = //Backend.Reduce.tests //Backend.Vector.ZeroCreate.tests //Backend.Vector.OfList.tests - Backend.Vector.Copy.tests + //Backend.Vector.Copy.tests + Backend.Vector.Convert.tests + //Backend.Vector.FillSubVector.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs new file mode 100644 index 00000000..c8868f37 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs @@ -0,0 +1,77 @@ +module Backend.Vector.Convert + +open Expecto +open Expecto.Logging +open Expecto.Logging.Message +open GraphBLAS.FSharp.Tests.Utils + +open GraphBLAS.FSharp.Backend +let logger = Log.create "Convert.Tests" + +let config = defaultConfig +let wgSize = 32 + +let makeTestDense + isZero + context + q + (toCOO: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) + (array: 'a []) = + if array.Length > 0 then + let vector = + createVectorFromArray VectorFormat.Dense array isZero + + let actual = + let clDenseVector = vector.ToDevice context + let clCooVector = toCOO q clDenseVector + let result = clCooVector.ToHost q + clCooVector.Dispose q + clDenseVector.Dispose q + result + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) + + let expected = createVectorFromArray VectorFormat.COO array isZero + + Expect.equal actual expected "Vectors must be the same" + +let testFixtures case = + let getCorrectnessTestName datatype = + sprintf "Correctness on %s, %A" datatype case.FormatCase + + let filterFloat x = + System.Double.IsNaN x + || abs x < Accuracy.medium.absolute + + let context = case.ClContext.ClContext + let q = case.ClContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + [ let toCoo = Vector.toCoo context wgSize + + makeTestDense ((=) 0) context q toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + let toCoo = Vector.toCoo context wgSize + + makeTestDense filterFloat context q toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "float") + + let toCoo = Vector.toCoo context wgSize + + makeTestDense ((=) 0uy) context q toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "byte") + + let toCoo = Vector.toCoo context wgSize + + makeTestDense ((=) false) context q toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] + +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect testFixtures + |> testList "Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs new file mode 100644 index 00000000..ee7e4777 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs @@ -0,0 +1,92 @@ +module Backend.Vector.ElementWiseAddAtLeastOne + +open System +open Expecto +open Expecto.Logging +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests.Utils + +let logger = Log.create "Vector.zeroCreate.Tests" + +let clContext = defaultContext.ClContext + +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 + | VectorDense actual, VectorDense expected -> + let isEqual left right = + match left, right with + | Some left, Some right -> + isEqual left right + | None, None -> true + | _, _ -> false + + compareArrays isEqual actual expected "The values array must contain the default value" + | VectorCOO actual, VectorCOO expected -> + compareArrays isEqual actual.Values expected.Values "The values array must contain the same values" + compareArrays (=) actual.Indices expected.Indices "The index array must contain the same indices" + | _, _ -> failwith "Copy format must be the same" + +let makeTest + isEqual + secondVectorFormat + (isZero: 'a -> bool) + (addFun: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) + case + (leftVector: 'a []) + (rightVector: 'a []) + = + + if leftVector.Length > 0 && rightVector.Length > 0 then + + let q = case.ClContext.Queue + let context = case.ClContext.ClContext + + let firstVector = + createVectorFromArray case.FormatCase leftVector isZero + + let secondVector = + createVectorFromArray secondVectorFormat rightVector isZero + + let v1 = firstVector.ToDevice context + let v2 = secondVector.ToDevice context + + let res = addFun q v1 v2 + + v1.Dispose q + v2.Dispose q + + + + + + + + +// +// +// let testFixtures (case: OperationCase) = +// let config = defaultConfig +// +// let getCorrectnessTestName datatype = +// sprintf "Correctness on %s, %A" datatype case.FormatCase +// +// let wgSize = 32 +// let context = case.ClContext.ClContext +// +// [ let intFill = Vector.fillSubVector context wgSize +// let isZero item = item = 0 +// +// case +// |> makeTest (=) isZero isZero intFill +// |> testPropertyWithConfig config (getCorrectnessTestName "int") +// +// ] +// +// let tests = +// testCases +// |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) +// |> List.collect testFixtures +// |> testList "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs index 5e59205a..654d3726 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs @@ -2,7 +2,6 @@ module Backend.Vector.FillSubVector open Expecto open Expecto.Logging - open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils @@ -10,7 +9,6 @@ let logger = Log.create "Vector.zeroCreate.Tests" let clContext = defaultContext.ClContext - let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vector<'a>) = Expect.equal actual.Size expected.Size "The size should be the same" @@ -30,16 +28,12 @@ let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vect compareArrays (=) actual.Indices expected.Indices "The index array must contain the same indices" | _, _ -> failwith "Copy format must be the same" - - - let makeTest<'a, 'b when 'a: struct and 'b: struct> - (maskFormat: VectorFormat) isEqual (isVectorItemZero: 'a -> bool) (isMaskItemZero: 'b -> bool) (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) - (case: OperationCase) + case (array: 'a []) (mask: 'b []) (value: 'a) @@ -57,7 +51,7 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> sourceVector.ToDevice context let maskVector = - createVectorFromArray maskFormat mask isMaskItemZero + createVectorFromArray case.FormatCase mask isMaskItemZero let clMaskVector = maskVector.ToDevice context @@ -83,26 +77,26 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> checkResult isEqual actual expected -// let testFixtures (case: OperationCase) = -// let config = defaultConfig -// -// let getCorrectnessTestName datatype = -// sprintf "Correctness on %s, %A" datatype case.FormatCase -// -// let wgSize = 32 -// let context = case.ClContext.ClContext -// -// [ let intFill = Vector.fillSubVector context wgSize -// let isZero item = item = 0 -// -// case -// |> correctnessGenericTest (=) isZero intFill -// |> testPropertyWithConfig config (getCorrectnessTestName "int") -// -// ] -// -// let tests = -// testCases -// |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) -// |> List.collect testFixtures -// |> testList "Backend.Vector.copy tests" +let testFixtures (case: OperationCase) = + let config = defaultConfig + + let getCorrectnessTestName datatype = + sprintf "Correctness on %s, %A" datatype case.FormatCase + + let wgSize = 32 + let context = case.ClContext.ClContext + + [ let intFill = Vector.fillSubVector context wgSize + let isZero item = item = 0 + + case + |> makeTest (=) isZero isZero intFill + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + ] + +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect testFixtures + |> testList "Backend.Vector.copy tests" From 17429c0fdce55cea6c7c618f4864f358beec87b2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 24 Oct 2022 12:54:51 +0300 Subject: [PATCH 31/74] add: Vector.elementWiseAddAtLeastOne --- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 21 +++++++++++++++++++ .../ElementWiseAddAtLeastOne.fs | 3 +-- 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 56127184..c313d72f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -4,6 +4,7 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Common module Vector = let zeroCreate<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = @@ -102,6 +103,26 @@ module Vector = | ClVectorCOO _ -> copy processor vector + let elementWiseAddAtLeastOne + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + workGroupSize + = + + let addDense = + DenseVector.elementWiseAddAtLeasOne clContext opAdd workGroupSize + + let addCoo = + COOVector.elementWiseAddAtLeastOne clContext opAdd workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVectorCOO left, ClVectorCOO right -> + ClVectorCOO <| addCoo processor left right + | ClVectorDense left, ClVectorDense right -> + ClVectorDense <| addDense processor left right + | _ -> failwith "Vector formats are not matching" + let fillSubVector (clContext: ClContext) (workGroupSize: int) = let cooFillVector = COOVector.fillSubVector clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs index ee7e4777..887e7938 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs @@ -1,6 +1,5 @@ module Backend.Vector.ElementWiseAddAtLeastOne -open System open Expecto open Expecto.Logging open GraphBLAS.FSharp.Backend @@ -23,7 +22,7 @@ let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vect | None, None -> true | _, _ -> false - compareArrays isEqual actual expected "The values array must contain the default value" + compareArrays isEqual actual expected "The values array must contain the same value" | VectorCOO actual, VectorCOO expected -> compareArrays isEqual actual.Values expected.Values "The values array must contain the same values" compareArrays (=) actual.Indices expected.Indices "The index array must contain the same indices" From f33ca22c31a9d6790c8c4e0f2cd4c3bdb7ed8170 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 25 Oct 2022 00:25:55 +0300 Subject: [PATCH 32/74] add: elementWiseAddAtLeatOne with error test --- .../Vector/COOVector/COOVector.fs | 16 +- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- .../ElementWiseAddAtLeastOne.fs | 154 ++++++++++++------ 3 files changed, 110 insertions(+), 63 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index eb879551..0ccbe586 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -138,7 +138,7 @@ module COOVector = clContext.CreateClArray( sumOfSides, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) @@ -146,7 +146,7 @@ module COOVector = clContext.CreateClArray<'a>( sumOfSides, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) @@ -154,7 +154,7 @@ module COOVector = clContext.CreateClArray<'b>( sumOfSides, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) @@ -162,7 +162,7 @@ module COOVector = clContext.CreateClArray( sumOfSides, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) @@ -240,7 +240,7 @@ module COOVector = clContext.CreateClArray( length, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) @@ -248,7 +248,7 @@ module COOVector = clContext.CreateClArray( length, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) @@ -320,7 +320,7 @@ module COOVector = clContext.CreateClArray<'a>( resultLength, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) @@ -328,7 +328,7 @@ module COOVector = clContext.CreateClArray( resultLength, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, + deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index dbf951c3..8cd862ff 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -30,8 +30,9 @@ let allTests = //Backend.Vector.ZeroCreate.tests //Backend.Vector.OfList.tests //Backend.Vector.Copy.tests - Backend.Vector.Convert.tests + //Backend.Vector.Convert.tests //Backend.Vector.FillSubVector.tests + Backend.Vector.ElementWiseAddAtLeastOne.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs index 887e7938..929e7b21 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs @@ -4,50 +4,93 @@ open Expecto open Expecto.Logging open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils +open GraphBLAS.FSharp.Backend.Common let logger = Log.create "Vector.zeroCreate.Tests" let clContext = defaultContext.ClContext -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 - | VectorDense actual, VectorDense expected -> - let isEqual left right = - match left, right with - | Some left, Some right -> - isEqual left right - | None, None -> true - | _, _ -> false - - compareArrays isEqual actual expected "The values array must contain the same value" - | VectorCOO actual, VectorCOO expected -> - compareArrays isEqual actual.Values expected.Values "The values array must contain the same values" - compareArrays (=) actual.Indices expected.Indices "The index array must contain the same indices" - | _, _ -> failwith "Copy format must be the same" - -let makeTest - isEqual - secondVectorFormat - (isZero: 'a -> bool) - (addFun: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) +let checkResult + (isEqual: 'c -> 'c -> bool) + (zero: 'c) + (op: AtLeastOne<'a, 'b> -> 'c option) + (actual: Vector<'c>) + (leftArray: 'a []) + (rightArray: 'b []) = + + let resultExpectedLength = max leftArray.Length rightArray.Length + + "The size should be the same" + |> Expect.equal actual.Size resultExpectedLength + + let getValueOreZero = function + | Some value -> value + | None -> zero + + let isLeftLess = leftArray.Length < rightArray.Length + + let lowBound = + if isLeftLess then leftArray.Length else rightArray.Length + + let expectedArray = Array.create resultExpectedLength zero + + for i in 0 .. resultExpectedLength - 1 do + let result = + if i < lowBound then + Both (leftArray[i], rightArray[i]) + |> op + |> getValueOreZero + + elif isLeftLess then + Left leftArray[i] + |> op + |> getValueOreZero + else + Right rightArray[i] + |> op + |> getValueOreZero + + expectedArray[i] <- result + + match actual with + | VectorCOO actual -> + let actualArray = Array.create actual.Values.Length zero + + for i in 0 .. actual.Indices.Length - 1 do + if isEqual actual.Values[i] zero then + failwith "Resulting zeroes should be filtered." + + actualArray[actual.Indices[i]] <- actual.Values[i] + + "arrays must have the same values" + |> compareArrays isEqual actualArray expectedArray + | _ -> failwith "Vector format must be the COO" + +let correctnessGenericTest + firstIsEqual + secondIsEqual + thirdIsEqual + (firstZero: 'a) + (secondZero: 'b) + (thirdZero: 'c) + (op: AtLeastOne<'a, 'b> -> 'c option) + (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) //TODO() + (toCoo: MailboxProcessor<_> -> ClVector<'c> -> ClVector<'c>) case - (leftVector: 'a []) - (rightVector: 'a []) + (leftArray: 'a []) + (rightArray: 'b []) = - if leftVector.Length > 0 && rightVector.Length > 0 then + if leftArray.Length > 0 && rightArray.Length > 0 then let q = case.ClContext.Queue let context = case.ClContext.ClContext let firstVector = - createVectorFromArray case.FormatCase leftVector isZero + createVectorFromArray case.FormatCase leftArray (firstIsEqual firstZero) let secondVector = - createVectorFromArray secondVectorFormat rightVector isZero + createVectorFromArray case.FormatCase rightArray (secondIsEqual secondZero) let v1 = firstVector.ToDevice context let v2 = secondVector.ToDevice context @@ -57,35 +100,38 @@ let makeTest v1.Dispose q v2.Dispose q + let cooRes = toCoo q res + res.Dispose q + let actual = cooRes.ToHost q + checkResult thirdIsEqual thirdZero op actual leftArray rightArray +let testFixtures (case: OperationCase) = + let config = defaultConfig + let getCorrectnessTestName fstType sndType thrType = + $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, {case.FormatCase}" + let wgSize = 32 + let context = case.ClContext.ClContext + let opIntSum = function + | Both (_, x: int) + | Left x + | Right x -> + Some x -// -// -// let testFixtures (case: OperationCase) = -// let config = defaultConfig -// -// let getCorrectnessTestName datatype = -// sprintf "Correctness on %s, %A" datatype case.FormatCase -// -// let wgSize = 32 -// let context = case.ClContext.ClContext -// -// [ let intFill = Vector.fillSubVector context wgSize -// let isZero item = item = 0 -// -// case -// |> makeTest (=) isZero isZero intFill -// |> testPropertyWithConfig config (getCorrectnessTestName "int") -// -// ] -// -// let tests = -// testCases -// |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) -// |> List.collect testFixtures -// |> testList "Backend.Vector.copy tests" + [ let addFun = Vector.elementWiseAddAtLeastOne context <@ opIntSum @> wgSize + + let toCoo = Vector.toCoo clContext wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0 0 0 (opIntSum) addFun toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") ] + +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect testFixtures + |> testList "Backend.Vector.copy tests" From f1c2f04b0019e4f36ea208fd84d1866af5513b40 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Oct 2022 18:35:59 +0300 Subject: [PATCH 33/74] add: eWiseTests --- .../Vector/COOVector/COOVector.fs | 20 +- .../Vector/DenseVector/DenseVector.fs | 59 +++--- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 8 +- .../Vector/VectorOperaions.fs | 24 +-- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +- .../ElementWiseAddAtLeastOne.fs | 183 ++++++++++++------ .../fillSubVectorTest.fs | 97 ++++++---- 7 files changed, 247 insertions(+), 149 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 0ccbe586..4ff2cf8f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -128,6 +128,7 @@ module COOVector = 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 @@ -207,12 +208,12 @@ module COOVector = if gid < length - 1 && allIndices[gid] = allIndices[gid + 1] then positions[gid] <- 0 - match (%opAdd) (Both (leftValues[gid + 1], rightValues[gid])) with + match (%opAdd) (Both (leftValues[gid], rightValues[gid + 1])) with | Some value -> allValues[gid + 1] <- value positions[gid + 1] <- 1 | None -> - positions[gid + 1] <- 1 + positions[gid + 1] <- 0 elif (gid < length && gid > 0 && allIndices[gid - 1] <> allIndices[gid]) || gid = 0 then if isLeft[gid] = 1 then match (%opAdd) (Left leftValues[gid]) with @@ -274,7 +275,6 @@ module COOVector = allValues, positions - let setPositions (clContext: ClContext) (workGroupSize: int) = let setPositions = @@ -353,7 +353,9 @@ module COOVector = resultValues, resultIndices - //TODO comment + ///. + ///. + ///Should be a power of 2 and greater than 1. let elementWiseAddAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) (opAdd: Expr -> 'c option>) @@ -386,6 +388,7 @@ module COOVector = processor.Post(Msg.CreateFreeMsg<_>(leftValues)) processor.Post(Msg.CreateFreeMsg<_>(rightValues)) + processor.Post(Msg.CreateFreeMsg<_>(isLeft)) let resultValues, resultIndices = setPositions @@ -394,8 +397,8 @@ module COOVector = allIndices positions - processor.Post(Msg.CreateFreeMsg<_>(allValues)) processor.Post(Msg.CreateFreeMsg<_>(allIndices)) + processor.Post(Msg.CreateFreeMsg<_>(allValues)) processor.Post(Msg.CreateFreeMsg<_>(positions)) { ClCooVector.Context = clContext @@ -403,11 +406,14 @@ module COOVector = Indices = resultIndices Size = leftVector.Size } - let fillSubVector (clContext: ClContext) (workGroupSize: int) = + ///. + ///. + ///Should be a power of 2 and greater than 1. + let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a)= let create = ClArray.create clContext workGroupSize - let opAdd = VectorOperations.fillSubAddAtLeastOne None + let opAdd = VectorOperations.fillSubAddAtLeastOne zero let eWiseAdd = elementWiseAddAtLeastOne clContext opAdd workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 473e14e3..caec8652 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -25,7 +25,7 @@ module DenseVector = let kernel = clContext.Compile(fillVector) - fun (processor: MailboxProcessor<_>) (maskVector: ClArray<'a option>) (scalar: 'b) -> + fun (processor: MailboxProcessor<_>) (maskVector: ClArray<'a option>) (scalar: 'b) -> //TODO() scalar to clCell<'b> let resultArray = clContext.CreateClArray( @@ -71,7 +71,7 @@ module DenseVector = let eWiseAdd = <@ - fun (ndRange: Range1D) leftVectorLength rightVectorLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + fun (ndRange: Range1D) leftVectorLength rightVectorLength resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> let gid = ndRange.GlobalID0 @@ -84,32 +84,35 @@ module DenseVector = if gid < rightVectorLength then rightItem <- rightVector[gid] - match leftItem, rightItem with - | Some left, Some right -> - resultVector[gid] <- (%opAdd) (Both (left, right)) - | Some left, None -> - resultVector[gid] <- (%opAdd) (Left left) - | None, Some right -> - resultVector[gid] <- (%opAdd) (Right right) - | None, None -> - resultVector[gid] <- None + if gid < resultLength then + match leftItem, rightItem with + | Some left, Some right -> + resultVector[gid] <- (%opAdd) (Both (left, right)) + | Some left, None -> + resultVector[gid] <- (%opAdd) (Left left) + | None, Some right -> + resultVector[gid] <- (%opAdd) (Right right) + | None, None -> + resultVector[gid] <- None @> let kernel = clContext.Compile(eWiseAdd) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> + let resultLength = + max leftVector.Length rightVector.Length + let resultVector = clContext.CreateClArray( - leftVector.Length, + resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.WriteOnly, allocationMode = AllocationMode.Default ) - let resultLength = max leftVector.Length rightVector.Length - - let ndRange = Range1D.CreateValid (resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) let kernel = kernel.GetKernel() @@ -120,6 +123,7 @@ module DenseVector = ndRange leftVector.Length rightVector.Length + resultLength leftVector rightVector resultVector) @@ -240,7 +244,7 @@ module DenseVector = positions - let unzip<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + let getValuesAndIndices<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let unzip = <@ @@ -261,11 +265,14 @@ module DenseVector = let kernel = clContext.Compile(unzip) - let getBitmap = getSomeBitmap clContext workGroupSize + let getBitmap = + getSomeBitmap clContext workGroupSize - let copy = ClArray.copy clContext workGroupSize + let copy = + ClArray.copy clContext workGroupSize - let prefixSum = ClArray.prefixSumExcludeInplace clContext workGroupSize + let prefixSum = + ClArray.prefixSumExcludeInplace clContext workGroupSize let resultLength = Array.zeroCreate 1 @@ -292,14 +299,16 @@ module DenseVector = resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.Default) + allocationMode = AllocationMode.Default + ) let resultIndices = clContext.CreateClArray( resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.Default) + allocationMode = AllocationMode.Default + ) let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) @@ -327,7 +336,7 @@ module DenseVector = let toCoo (clContext: ClContext) (workGroupSize: int) = - let unzip = unzip clContext workGroupSize + let unzip = getValuesAndIndices clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> @@ -338,16 +347,16 @@ module DenseVector = Values = values Size = vector.Length } - let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = - let unzip = unzip clContext workGroupSize + let unzip = getValuesAndIndices clContext workGroupSize - let reduce = Reduce.run clContext workGroupSize opAdd Unchecked.defaultof<'a> //TODO() + let reduce = + Reduce.run clContext workGroupSize opAdd Unchecked.defaultof<'a> fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index c313d72f..710dee3d 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -109,19 +109,19 @@ module Vector = workGroupSize = - let addDense = - DenseVector.elementWiseAddAtLeasOne clContext opAdd workGroupSize - let addCoo = COOVector.elementWiseAddAtLeastOne clContext opAdd workGroupSize + let addDense = + DenseVector.elementWiseAddAtLeasOne clContext opAdd workGroupSize + fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVectorCOO left, ClVectorCOO right -> ClVectorCOO <| addCoo processor left right | ClVectorDense left, ClVectorDense right -> ClVectorDense <| addDense processor left right - | _ -> failwith "Vector formats are not matching" + | _ -> failwith "Vector formats are not matching." let fillSubVector (clContext: ClContext) (workGroupSize: int) = let cooFillVector = diff --git a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs index b66e5af9..0da36e08 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs @@ -4,17 +4,17 @@ open GraphBLAS.FSharp.Backend.Common module VectorOperations = let fillSubAddAtLeastOne zero = - <@ - fun (value: AtLeastOne<'a, 'a>) -> - let mutable res = zero + <@ + fun (value: AtLeastOne<'a, 'a>) -> + let mutable res = zero - match value with - | Both (_, right) -> - res <- Some right - | Left left -> - res <- Some left - | Right right -> - res <- Some right + match value with + | Both (_, right) -> + res <- Some right + | Left left -> + res <- Some left + | Right right -> + res <- Some right - if res = zero then None else res - @> + if res = zero then None else Some res + @> diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 8cd862ff..3bdedbbd 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -32,8 +32,9 @@ let allTests = //Backend.Vector.Copy.tests //Backend.Vector.Convert.tests //Backend.Vector.FillSubVector.tests - Backend.Vector.ElementWiseAddAtLeastOne.tests - + // Backend.Vector.ElementWiseAddAtLeastOne.addTests + // Backend.Vector.ElementWiseAddAtLeastOne.mulTests + Backend.Vector.FillSubVector.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs index 929e7b21..a9a73e65 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs @@ -5,92 +5,92 @@ open Expecto.Logging open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils open GraphBLAS.FSharp.Backend.Common - +open StandardOperations let logger = Log.create "Vector.zeroCreate.Tests" -let clContext = defaultContext.ClContext +let testArrayFilter array isZero = + Array.filter + <| (fun item -> not <| isZero item) + <| array let checkResult (isEqual: 'c -> 'c -> bool) - (zero: 'c) - (op: AtLeastOne<'a, 'b> -> 'c option) + leftZero + rightZero + resultZero + (op: 'a -> 'b -> 'c ) (actual: Vector<'c>) (leftArray: 'a []) - (rightArray: 'b []) = - - let resultExpectedLength = max leftArray.Length rightArray.Length - - "The size should be the same" - |> Expect.equal actual.Size resultExpectedLength + (rightArray: 'b []) + = - let getValueOreZero = function - | Some value -> value - | None -> zero + let expectedArrayLength = + max leftArray.Length rightArray.Length - let isLeftLess = leftArray.Length < rightArray.Length + let isLeftLess = + leftArray.Length < rightArray.Length let lowBound = if isLeftLess then leftArray.Length else rightArray.Length - let expectedArray = Array.create resultExpectedLength zero + let expectedArray = + Array.create expectedArrayLength resultZero - for i in 0 .. resultExpectedLength - 1 do - let result = + for i in 0 .. expectedArrayLength - 1 do + let item = if i < lowBound then - Both (leftArray[i], rightArray[i]) - |> op - |> getValueOreZero - + op leftArray[i] rightArray[i] elif isLeftLess then - Left leftArray[i] - |> op - |> getValueOreZero + op leftZero rightArray[i] else - Right rightArray[i] - |> op - |> getValueOreZero + op leftArray[i] rightZero + + expectedArray[i] <- item - expectedArray[i] <- result match actual with | VectorCOO actual -> - let actualArray = Array.create actual.Values.Length zero + let actualArray = Array.create expectedArrayLength resultZero for i in 0 .. actual.Indices.Length - 1 do - if isEqual actual.Values[i] zero then + if isEqual actual.Values[i] resultZero then failwith "Resulting zeroes should be filtered." actualArray[actual.Indices[i]] <- actual.Values[i] - "arrays must have the same values" + $"arrays must have the same values" |> compareArrays isEqual actualArray expectedArray - | _ -> failwith "Vector format must be the COO" + | _ -> failwith "Vector format must be COO." let correctnessGenericTest - firstIsEqual - secondIsEqual - thirdIsEqual - (firstZero: 'a) - (secondZero: 'b) - (thirdZero: 'c) - (op: AtLeastOne<'a, 'b> -> 'c option) - (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) //TODO() + leftIsEqual + rightIsEqual + resultIsEqual + (leftZero: 'a) + (rightZero: 'b) + (resultZero: 'c) + (op: 'a -> 'b -> 'c) + (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) (toCoo: MailboxProcessor<_> -> ClVector<'c> -> ClVector<'c>) case (leftArray: 'a []) (rightArray: 'b []) = - if leftArray.Length > 0 && rightArray.Length > 0 then + let leftFilteredArray = testArrayFilter leftArray (leftIsEqual leftZero) + + let rightFilteredArray = testArrayFilter rightArray (rightIsEqual rightZero) + + if leftFilteredArray.Length > 0 && rightFilteredArray.Length > 0 then let q = case.ClContext.Queue let context = case.ClContext.ClContext let firstVector = - createVectorFromArray case.FormatCase leftArray (firstIsEqual firstZero) + createVectorFromArray case.FormatCase leftArray (leftIsEqual leftZero) let secondVector = - createVectorFromArray case.FormatCase rightArray (secondIsEqual secondZero) + createVectorFromArray case.FormatCase rightArray (rightIsEqual rightZero) let v1 = firstVector.ToDevice context let v2 = secondVector.ToDevice context @@ -105,9 +105,9 @@ let correctnessGenericTest let actual = cooRes.ToHost q - checkResult thirdIsEqual thirdZero op actual leftArray rightArray + checkResult resultIsEqual leftZero rightZero resultZero op actual leftArray rightArray -let testFixtures (case: OperationCase) = +let addTestFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName fstType sndType thrType = @@ -116,22 +116,91 @@ let testFixtures (case: OperationCase) = let wgSize = 32 let context = case.ClContext.ClContext - let opIntSum = function - | Both (_, x: int) - | Left x - | Right x -> - Some x + [ let toCoo = Vector.toCoo context wgSize + + let intAddFun = Vector.elementWiseAddAtLeastOne context intSumAtLeastOne wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") + + let toFloatCoo = Vector.toCoo context wgSize + + let floatAddFun = Vector.elementWiseAddAtLeastOne context floatSumAtLeastOne wgSize + + let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute // infinity TODO() + + case + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun toFloatCoo + |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") + + let boolToCoo = Vector.toCoo context wgSize + + let boolAddFun = Vector.elementWiseAddAtLeastOne context boolSumAtLeastOne wgSize + + case + |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") + + let byteToCoo = Vector.toCoo context wgSize + + let byteAddFun = Vector.elementWiseAddAtLeastOne context byteSumAtLeastOne wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] + +let addTests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect addTestFixtures + |> testList "Backend.Vector.atLeastOneAdd tests" + +let mulTestFixtures (case: OperationCase) = + let config = defaultConfig + + let getCorrectnessTestName fstType sndType thrType = + $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, {case.FormatCase}" + + let wgSize = 32 + let context = case.ClContext.ClContext + + [ let toCoo = Vector.toCoo context wgSize + + let intMulFun = Vector.elementWiseAddAtLeastOne context intMulAtLeastOne wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") + + let toFloatCoo = Vector.toCoo context wgSize + + let floatMulFun = Vector.elementWiseAddAtLeastOne context floatMulAtLeastOne wgSize + + let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute // infinity TODO() + + case + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun toFloatCoo + |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") + + let boolToCoo = Vector.toCoo context wgSize + + let boolMulFun = Vector.elementWiseAddAtLeastOne context boolMulAtLeastOne wgSize + + case + |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") - [ let addFun = Vector.elementWiseAddAtLeastOne context <@ opIntSum @> wgSize + let byteToCoo = Vector.toCoo context wgSize - let toCoo = Vector.toCoo clContext wgSize + let byteMulFun = Vector.elementWiseAddAtLeastOne context byteMulAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0 0 0 (opIntSum) addFun toCoo - |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") ] + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let tests = +let mulTests = testCases |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) - |> List.collect testFixtures - |> testList "Backend.Vector.copy tests" + |> List.collect mulTestFixtures + |> testList "Backend.Vector.atLeastOneMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs index 654d3726..099e8651 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs @@ -9,72 +9,84 @@ let logger = Log.create "Vector.zeroCreate.Tests" let clContext = defaultContext.ClContext -let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vector<'a>) = +let checkResult + (resultIsEqual: 'a -> 'a -> bool) + (maskIsEqual: 'b -> 'b -> bool) + vectorZero + maskZero + (actual: Vector<'a>) + (leftVector: 'a []) + (mask: 'b []) + (value: 'a) + = + + let expectedArrayLength = leftVector.Length + + let expectedArray = + Array.create expectedArrayLength vectorZero + + for i in 0 .. expectedArrayLength - 1 do + let resultItem = + if maskIsEqual maskZero mask[i] then + leftVector[i] + else + value + + expectedArray[i] <- resultItem - Expect.equal actual.Size expected.Size "The size should be the same" + match actual with + | VectorCOO actual -> + let actualArray = Array.create expectedArrayLength vectorZero - match actual, expected with - | VectorDense actual, VectorDense expected -> - let isEqual left right = - match left, right with - | Some left, Some right -> - isEqual left right - | None, None -> true - | _, _ -> false + for i in 0 .. actual.Indices.Length - 1 do + actualArray[actual.Indices[i]] <- actual.Values[i] - compareArrays isEqual actual expected "The values array must contain the default value" - | VectorCOO actual, VectorCOO expected -> - compareArrays isEqual actual.Values expected.Values "The values array must contain the same values" - compareArrays (=) actual.Indices expected.Indices "The index array must contain the same indices" - | _, _ -> failwith "Copy format must be the same" + $"arrays must have the same values and length" + |> compareArrays resultIsEqual actualArray expectedArray + | _ -> failwith "Vector format must be COO." let makeTest<'a, 'b when 'a: struct and 'b: struct> - isEqual - (isVectorItemZero: 'a -> bool) - (isMaskItemZero: 'b -> bool) - (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) + resultIsEqual + maskIsEqual + (vectorZero: 'a ) + (maskZero: 'b) + (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) + (fillVector: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) + (maskFormat: VectorFormat) case - (array: 'a []) - (mask: 'b []) + (leftArray: 'a []) + (maskArray: 'b []) (value: 'a) = - if array.Length > 0 then - + if leftArray.Length > 0 then let q = case.ClContext.Queue let context = case.ClContext.ClContext - let sourceVector = - createVectorFromArray case.FormatCase array isVectorItemZero + let leftVector = + createVectorFromArray case.FormatCase leftArray (resultIsEqual vectorZero) let clSourceVector = - sourceVector.ToDevice context + leftVector.ToDevice context let maskVector = - createVectorFromArray case.FormatCase mask isMaskItemZero + createVectorFromArray maskFormat maskArray (maskIsEqual maskZero) let clMaskVector = maskVector.ToDevice context - let expected = - let expected = array - - for i in 0 .. mask.Length do - if i < array.Length && not (isMaskItemZero mask[i]) then - expected[i] <- value - - createVectorFromArray case.FormatCase expected isVectorItemZero - let clActual = fillVector q clSourceVector clMaskVector value - let actual = clActual.ToHost q + let cooClActual = toCoo q clActual + + let actual = cooClActual.ToHost q clSourceVector.Dispose q clMaskVector.Dispose q clActual.Dispose q - checkResult isEqual actual expected + checkResult resultIsEqual maskIsEqual vectorZero maskZero actual leftArray maskArray value let testFixtures (case: OperationCase) = @@ -87,16 +99,17 @@ let testFixtures (case: OperationCase) = let context = case.ClContext.ClContext [ let intFill = Vector.fillSubVector context wgSize - let isZero item = item = 0 + + let intToCoo = Vector.toCoo context wgSize case - |> makeTest (=) isZero isZero intFill + |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.COO |> testPropertyWithConfig config (getCorrectnessTestName "int") ] let tests = - testCases + testCases |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures - |> testList "Backend.Vector.copy tests" + |> testList "Backend.Vector.fillSubVector tests" From 4fc74666c46ad50b823a26ac91fd7cdc7424f6d1 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 28 Oct 2022 23:46:28 +0300 Subject: [PATCH 34/74] add: Vector.reduce tests --- .../Vector/COOVector/COOVector.fs | 13 +- .../Vector/DenseVector/DenseVector.fs | 21 ++- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 20 +-- .../Vector/VectorOperaions.fs | 6 +- .../GraphBLAS-sharp.Tests.fsproj | 2 + tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- .../ComplementedTests.fs | 122 +++++++++++++++ .../ElementWiseAddAtLeastOne.fs | 1 - .../VectorOperationsTests/ReduceTests.fs | 144 ++++++++++++++++++ .../fillSubVectorTest.fs | 130 ++++++++++++---- 10 files changed, 406 insertions(+), 57 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs create mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 4ff2cf8f..46530923 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -409,7 +409,7 @@ module COOVector = ///. ///. ///Should be a power of 2 and greater than 1. - let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a)= + let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a) = let create = ClArray.create clContext workGroupSize @@ -419,8 +419,6 @@ module COOVector = fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (maskVector: ClCooVector<'b>) (scalar: 'a) -> - let maskSize = maskVector.Size //TODO() - let maskValues = create processor maskVector.Size scalar let maskIndices = maskVector.Indices @@ -429,7 +427,7 @@ module COOVector = { ClCooVector.Context = clContext Indices = maskIndices Values = maskValues - Size = maskSize } + Size = maskVector.Size } //TODO() eWiseAdd processor leftVector rightVector @@ -479,7 +477,7 @@ module COOVector = preparePositionsComplemented clContext workGroupSize let init = - ClArray.init <@ id @> clContext workGroupSize + ClArray.init <@ fun x -> x @> clContext workGroupSize //TODO remove lambda ? let create = ClArray.zeroCreate clContext workGroupSize @@ -512,9 +510,10 @@ module COOVector = (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) + zero = - let reduce = Reduce.run clContext workGroupSize + let reduce = Reduce.run clContext workGroupSize opAdd zero fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> - reduce opAdd Unchecked.defaultof<'a> processor vector.Values + reduce processor vector.Values diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index caec8652..6e96ea2a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -107,8 +107,8 @@ module DenseVector = clContext.CreateClArray( resultLength, hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.WriteOnly, - allocationMode = AllocationMode.Default + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.AllocAndCopyHostPtr ) let ndRange = @@ -133,9 +133,9 @@ module DenseVector = resultVector - let fillSubVector (clContext: ClContext) (workGroupSize: int) = + let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a) = - let opAdd = VectorOperations.fillSubAddAtLeastOne None + let opAdd = VectorOperations.fillSubAddAtLeastOne zero //TODO() let eWiseAdd = elementWiseAddAtLeasOne clContext opAdd workGroupSize @@ -156,7 +156,7 @@ module DenseVector = let complemented = <@ - fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (resultArray: ClArray<'a option>) -> + fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (defaultValue: ClCell<'a>) (resultArray: ClArray<'a option>) -> let gid = ndRange.GlobalID0 @@ -165,7 +165,7 @@ module DenseVector = | Some _ -> resultArray[gid] <- None | None -> - resultArray[gid] <- Some Unchecked.defaultof<'a> + resultArray[gid] <- Some defaultValue.Value @> @@ -183,6 +183,9 @@ module DenseVector = allocationMode = AllocationMode.Default ) + let defaultValue = + clContext.CreateClCell Unchecked.defaultof<'a> + let ndRange = Range1D.CreateValid(length, workGroupSize) let kernel = kernel.GetKernel() @@ -194,9 +197,12 @@ module DenseVector = ndRange length vector + defaultValue resultArray) ) + processor.Post(Msg.CreateFreeMsg(defaultValue)) + resultArray let getSomeBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = @@ -351,12 +357,13 @@ module DenseVector = (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) + zero = let unzip = getValuesAndIndices clContext workGroupSize let reduce = - Reduce.run clContext workGroupSize opAdd Unchecked.defaultof<'a> + Reduce.run clContext workGroupSize opAdd zero fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 710dee3d..8cb8260f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -123,12 +123,12 @@ module Vector = ClVectorDense <| addDense processor left right | _ -> failwith "Vector formats are not matching." - let fillSubVector (clContext: ClContext) (workGroupSize: int) = + let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a) = let cooFillVector = - COOVector.fillSubVector clContext workGroupSize + COOVector.fillSubVector clContext workGroupSize zero let denseFillVector = - DenseVector.fillSubVector clContext workGroupSize + DenseVector.fillSubVector clContext workGroupSize zero let toCooVector = DenseVector.toCoo clContext workGroupSize @@ -139,13 +139,15 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> //TODO() match vector, maskVector with | ClVectorCOO vector, ClVectorCOO mask -> - let res = cooFillVector processor vector mask value + let res = + cooFillVector processor vector mask value ClVectorCOO res | ClVectorCOO vector, ClVectorDense mask -> let mask = toCooMask processor mask - let res = cooFillVector processor vector mask value //TODO() + let res = + cooFillVector processor vector mask value //TODO() ClVectorCOO res | ClVectorDense vector, ClVectorCOO mask -> @@ -156,7 +158,7 @@ module Vector = ClVectorCOO res | ClVectorDense vector, ClVectorDense mask -> - let res = denseFillVector processor vector mask value //TODO() + let res = denseFillVector processor vector mask value //TODO() remove zero ? ClVectorDense res @@ -174,12 +176,12 @@ module Vector = | ClVectorDense vector -> ClVectorDense <| denseComplemented processor vector - let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = + let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) (zero: 'a) = let cooReduce = - COOVector.reduce clContext workGroupSize opAdd + COOVector.reduce clContext workGroupSize opAdd zero let denseReduce = - DenseVector.reduce clContext workGroupSize opAdd + DenseVector.reduce clContext workGroupSize opAdd zero fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with diff --git a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs index 0da36e08..b94507b1 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs @@ -10,11 +10,11 @@ module VectorOperations = match value with | Both (_, right) -> - res <- Some right + res <- right | Left left -> - res <- Some left + res <- left | Right right -> - res <- Some right + res <- right if res = zero then None else Some res @> diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index b2559d2e..84e064f0 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -34,6 +34,8 @@ + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 3bdedbbd..d9728f13 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -34,7 +34,9 @@ let allTests = //Backend.Vector.FillSubVector.tests // Backend.Vector.ElementWiseAddAtLeastOne.addTests // Backend.Vector.ElementWiseAddAtLeastOne.mulTests - Backend.Vector.FillSubVector.tests + //Backend.Vector.FillSubVector.tests + //Backend.Vector.Complemented.tests + Backend.Vector.Reduce.tests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs new file mode 100644 index 00000000..5d18a13c --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs @@ -0,0 +1,122 @@ +module Backend.Vector.Complemented + +open Expecto +open Expecto.Logging +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests.Utils +open GraphBLAS.FSharp.Backend.Common +open StandardOperations +let logger = Log.create "Vector.Complemented.Tests" + +let testArrayFilter array isZero = + Array.filter + <| (fun item -> not <| isZero item) + <| array + +let checkResult + isEqual + zero + (actual: Vector<'a>) + (vector: 'a []) + = + + let expectedArrayLength = vector.Length + + let expectedArray = + Array.create expectedArrayLength 1 + + for i in 0 .. expectedArrayLength - 1 do + if isEqual vector[i] zero then + expectedArray[i] <- 0 + + match actual with + | VectorCOO actual -> + let actualArray = Array.create expectedArrayLength 0 + + for i in 0 .. actual.Indices.Length - 1 do + actualArray[actual.Indices[i]] <- 1 + + $"arrays must have the same values and length" + |> compareArrays (=) actualArray expectedArray + | _ -> failwith "Vector format must be COO." + +let correctnessGenericTest + isEqual + zero + (complemented: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) + (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) + case + (maskArray: 'a []) + = + + let rightFilteredArray = testArrayFilter maskArray (isEqual zero) + + if rightFilteredArray.Length > 0 then + let q = case.ClContext.Queue + let context = case.ClContext.ClContext + + let secondVector = + createVectorFromArray case.FormatCase maskArray (isEqual zero) + + let clVector = secondVector.ToDevice context + + let res = complemented q clVector + + clVector.Dispose q + + let cooRes = toCoo q res + + res.Dispose q + + let actual = cooRes.ToHost q + + cooRes.Dispose q + + checkResult isEqual zero actual maskArray + +let addTestFixtures (case: OperationCase) = + let config = defaultConfig + + let getCorrectnessTestName dataType = + $"Correctness on %A{dataType}, %A{case.FormatCase}" + + let wgSize = 32 + let context = case.ClContext.ClContext + + [ let intToCoo = Vector.toCoo context wgSize + + let intComplemented = Vector.complemented context wgSize + + case + |> correctnessGenericTest (=) 0 intComplemented intToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + let byteToCoo = Vector.toCoo context wgSize + + let byteComplemented = Vector.complemented context wgSize + + case + |> correctnessGenericTest (=) 0uy byteComplemented byteToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "byte") + + let floatToCoo = Vector.toCoo context wgSize + + let floatComplemented = Vector.complemented context wgSize + + case + |> correctnessGenericTest (=) 0.0 floatComplemented floatToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "float") + + let boolToCoo = Vector.toCoo context wgSize + + let boolComplemented = Vector.complemented context wgSize + + case + |> correctnessGenericTest (=) false boolComplemented boolToCoo + |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] + +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect addTestFixtures + |> testList "Backend.Vector.Complemented tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs index a9a73e65..cfcf8a4e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs @@ -47,7 +47,6 @@ let checkResult expectedArray[i] <- item - match actual with | VectorCOO actual -> let actualArray = Array.create expectedArrayLength resultZero diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs new file mode 100644 index 00000000..d976c900 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs @@ -0,0 +1,144 @@ +module Backend.Vector.Reduce + +open Expecto +open Expecto.Logging +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests.Utils +open Brahma.FSharp +open FSharp.Quotations + +let logger = Log.create "Vector.Complemented.Tests" + +let zeroFilter array isZero = + Array.filter + <| (fun item -> not <| isZero item) + <| array + +let checkResult + zero + op + (actual: 'a) + (vector: 'a []) + = + + let expected = + Array.fold op zero vector + + "Results should be the same" + |> Expect.equal actual expected + +let correctnessGenericTest + isEqual + zero + op + opQ + (reduce: Expr<'a -> 'a -> 'a> -> 'a -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) + filter + case + (array: 'a []) + = + + let array = filter array + + let filteredArray = + zeroFilter array (isEqual zero) + + if filteredArray.Length > 0 then + let q = case.ClContext.Queue + let context = case.ClContext.ClContext + + let vector = createVectorFromArray case.FormatCase array (isEqual zero) + + let clVector = vector.ToDevice context + + let resultCell = reduce opQ zero 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] + + checkResult zero op result array + +let addTestFixtures (case: OperationCase) = + let config = defaultConfig + + let getCorrectnessTestName dataType = + $"Correctness on %A{dataType}, %A{case.FormatCase}" + + let wgSize = 32 + let context = case.ClContext.ClContext + + let filterFloats = + Array.filter (System.Double.IsNaN >> not) + + [ let intReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) 0 (+) <@ (+) @> intReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + let byteReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) 0uy (+) <@ (+) @> byteReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "byte") + + let intMaxReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) 0 max <@ max @> intMaxReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "int max") + + let floatMaxReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) 0.0 max <@ max @> floatMaxReduce filterFloats + |> testPropertyWithConfig config (getCorrectnessTestName "float max") + + let byteMaxReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) 0uy max <@ max @> byteMaxReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "byte max") + + let intMinReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) System.Int32.MaxValue min <@ min @> intMinReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "int min") + + let floatMinReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) System.Double.MaxValue min <@ min @> floatMinReduce filterFloats + |> testPropertyWithConfig config (getCorrectnessTestName "float min") + + let byteMinReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) System.Byte.MaxValue min <@ min @> byteMinReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "byte min") + + let boolOrReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) false (||) <@ (||) @> boolOrReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "bool or") + + let boolAndReduce = Vector.reduce context wgSize + + case + |> correctnessGenericTest (=) true (&&) <@ (&&) @> boolAndReduce id + |> testPropertyWithConfig config (getCorrectnessTestName "bool and") ] + +let tests = + testCases + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.collect addTestFixtures + |> testList "Backend.Vector.Reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs index 099e8651..75c7bc5e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs @@ -9,30 +9,39 @@ let logger = Log.create "Vector.zeroCreate.Tests" let clContext = defaultContext.ClContext +let vectorFilter vector isZero = + Array.filter + <| (fun item -> not <| isZero item) + <| vector + let checkResult (resultIsEqual: 'a -> 'a -> bool) (maskIsEqual: 'b -> 'b -> bool) vectorZero maskZero (actual: Vector<'a>) - (leftVector: 'a []) + (vector: 'a []) (mask: 'b []) (value: 'a) = - let expectedArrayLength = leftVector.Length + let expectedArrayLength = + max vector.Length mask.Length + + let isVectorLess = + vector.Length < mask.Length + + let lowBound = + if isVectorLess then vector.Length else mask.Length let expectedArray = Array.create expectedArrayLength vectorZero for i in 0 .. expectedArrayLength - 1 do - let resultItem = - if maskIsEqual maskZero mask[i] then - leftVector[i] - else - value - - expectedArray[i] <- resultItem + if i < mask.Length && not (maskIsEqual mask[i] maskZero) then + expectedArray[i] <- value + elif i < vector.Length then + expectedArray[i] <- vector[i] match actual with | VectorCOO actual -> @@ -41,12 +50,12 @@ let checkResult for i in 0 .. actual.Indices.Length - 1 do actualArray[actual.Indices[i]] <- actual.Values[i] - $"arrays must have the same values and length" + "arrays must have the same values and length" |> compareArrays resultIsEqual actualArray expectedArray | _ -> failwith "Vector format must be COO." let makeTest<'a, 'b when 'a: struct and 'b: struct> - resultIsEqual + vectorIsZero maskIsEqual (vectorZero: 'a ) (maskZero: 'b) @@ -54,59 +63,122 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> (fillVector: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) (maskFormat: VectorFormat) case - (leftArray: 'a []) - (maskArray: 'b []) + (vector: 'a []) + (mask: 'b []) (value: 'a) = - if leftArray.Length > 0 then + let filteredLeftVector = + vectorFilter vector (vectorIsZero vectorZero) + + let filteredMask = + vectorFilter mask (maskIsEqual maskZero) + + if filteredLeftVector.Length > 0 && filteredMask.Length > 0 && not (vectorIsZero value vectorZero) then let q = case.ClContext.Queue let context = case.ClContext.ClContext let leftVector = - createVectorFromArray case.FormatCase leftArray (resultIsEqual vectorZero) - - let clSourceVector = - leftVector.ToDevice context + createVectorFromArray case.FormatCase vector (vectorIsZero vectorZero) let maskVector = - createVectorFromArray maskFormat maskArray (maskIsEqual maskZero) + createVectorFromArray maskFormat mask (maskIsEqual maskZero) + + let clLeftVector = + leftVector.ToDevice context let clMaskVector = maskVector.ToDevice context let clActual = - fillVector q clSourceVector clMaskVector value + fillVector q clLeftVector clMaskVector value let cooClActual = toCoo q clActual let actual = cooClActual.ToHost q - clSourceVector.Dispose q + clLeftVector.Dispose q clMaskVector.Dispose q clActual.Dispose q + cooClActual.Dispose q - checkResult resultIsEqual maskIsEqual vectorZero maskZero actual leftArray maskArray value + checkResult vectorIsZero maskIsEqual vectorZero maskZero actual vector mask value - -let testFixtures (case: OperationCase) = +let testFixtures case = let config = defaultConfig - let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + let getCorrectnessTestName datatype maskFormat = + $"Correctness on %s{datatype}, vector: %A{case.FormatCase}, mask: %s{maskFormat}" let wgSize = 32 let context = case.ClContext.ClContext - [ let intFill = Vector.fillSubVector context wgSize + let floatIsEqual x y = + abs (x - y) < Accuracy.medium.absolute + + [ let intFill = Vector.fillSubVector context wgSize 0 let intToCoo = Vector.toCoo context wgSize case |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.COO - |> testPropertyWithConfig config (getCorrectnessTestName "int") + |> testPropertyWithConfig config (getCorrectnessTestName "int" "COO") + + let floatFill = Vector.fillSubVector context wgSize 0.0 + + let floatToCoo = Vector.toCoo context wgSize + + case + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.COO + |> testPropertyWithConfig config (getCorrectnessTestName "float" "COO") //TODO filt floats + + let byteFill = Vector.fillSubVector context wgSize 0uy + + let byteToCoo = Vector.toCoo context wgSize + + case + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.COO + |> testPropertyWithConfig config (getCorrectnessTestName "byte" "COO") - ] + let boolFill = Vector.fillSubVector context wgSize false + + let boolToCoo = Vector.toCoo context wgSize + + case + |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.COO + |> testPropertyWithConfig config (getCorrectnessTestName "bool" "COO") + + let intFill = Vector.fillSubVector context wgSize 0 + + let intToCoo = Vector.toCoo context wgSize + + case + |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Dense + |> testPropertyWithConfig config (getCorrectnessTestName "int" "Dense") + + let floatFill = Vector.fillSubVector context wgSize 0.0 + + let floatToCoo = Vector.toCoo context wgSize + + case + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Dense + |> testPropertyWithConfig config (getCorrectnessTestName "float" "Dense") //TODO filt floats + + let byteFill = Vector.fillSubVector context wgSize 0uy + + let byteToCoo = Vector.toCoo context wgSize + + case + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Dense + |> testPropertyWithConfig config (getCorrectnessTestName "byte" "Dense") + + let boolFill = Vector.fillSubVector context wgSize false + + let boolToCoo = Vector.toCoo context wgSize + + case + |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense + |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] let tests = testCases From 02176242fa120e2ea886c12fd5b9c315edf1e3b9 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 30 Oct 2022 00:52:36 +0300 Subject: [PATCH 35/74] add: StandartOperations.mask --- .../Common/StandardOperations.fs | 16 +++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 1 - .../Vector/COOVector/COOVector.fs | 2 +- .../Vector/DenseVector/DenseVector.fs | 2 +- .../Vector/VectorOperaions.fs | 20 ------------------- 5 files changed, 18 insertions(+), 23 deletions(-) delete mode 100644 src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 309d981a..d1004f0b 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -94,3 +94,19 @@ module StandardOperations = let byteMulAtLeastOne = mkNumericMulAtLeastOne 0uy let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f + + let maks zero = + <@ + fun (value: AtLeastOne<'a, 'a>) -> + let mutable res = zero + + match value with + | Both (_, right) -> + res <- right + | Left left -> + res <- left + | Right right -> + res <- right + + if res = zero then None else Some res + @> diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 853468fe..9939b4ea 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -27,7 +27,6 @@ - diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 46530923..399c1e7b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -413,7 +413,7 @@ module COOVector = let create = ClArray.create clContext workGroupSize - let opAdd = VectorOperations.fillSubAddAtLeastOne zero + let opAdd = StandardOperations.maks zero let eWiseAdd = elementWiseAddAtLeastOne clContext opAdd workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 6e96ea2a..124368ef 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -135,7 +135,7 @@ module DenseVector = let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a) = - let opAdd = VectorOperations.fillSubAddAtLeastOne zero //TODO() + let opAdd = StandardOperations.maks zero let eWiseAdd = elementWiseAddAtLeasOne clContext opAdd workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs b/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs deleted file mode 100644 index b94507b1..00000000 --- a/src/GraphBLAS-sharp.Backend/Vector/VectorOperaions.fs +++ /dev/null @@ -1,20 +0,0 @@ -namespace GraphBLAS.FSharp.Backend - -open GraphBLAS.FSharp.Backend.Common - -module VectorOperations = - let fillSubAddAtLeastOne zero = - <@ - fun (value: AtLeastOne<'a, 'a>) -> - let mutable res = zero - - match value with - | Both (_, right) -> - res <- right - | Left left -> - res <- left - | Right right -> - res <- right - - if res = zero then None else Some res - @> From 7dd6d336e8e3d4e0dc8a7cb9028ba165b63a2684 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 30 Oct 2022 19:56:08 +0300 Subject: [PATCH 36/74] add: all tests pass localy --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 51 ++++++- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 28 ++-- .../Common/StandardOperations.fs | 14 +- .../Vector/COOVector/COOVector.fs | 114 ++++++++++++---- .../Vector/DenseVector/DenseVector.fs | 96 ++++++------- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 62 +++------ .../BackendCommonTests/ReduceTests.fs | 1 - .../GraphBLAS-sharp.Tests.fsproj | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 16 --- tests/GraphBLAS-sharp.Tests/Program.fs | 50 ++++--- .../ComplementedTests.fs | 54 +++++--- .../VectorOperationsTests/ConvertTest.fs | 18 ++- ...AtLeastOne.fs => ElementWiseAtLeastOne.fs} | 110 ++++++++++----- .../VectorOperationsTests/ReduceTests.fs | 25 +++- .../fillSubVectorTest.fs | 126 +++++++++++------- .../VectorOperationsTests/ofListTests.fs | 101 +++++++------- .../VectorOperationsTests/zeroCreateTests.fs | 60 +++++++-- 17 files changed, 556 insertions(+), 372 deletions(-) rename tests/GraphBLAS-sharp.Tests/VectorOperationsTests/{ElementWiseAddAtLeastOne.fs => ElementWiseAtLeastOne.fs} (70%) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index ce9f0f68..102043c5 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -471,7 +471,8 @@ module ClArray = let zeroCreate = zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (indices: ClArray) (size: int) -> - let outputArray = zeroCreate processor size + + let resultArray = zeroCreate processor size let ndRange = Range1D.CreateValid(size, workGroupSize) @@ -479,9 +480,51 @@ module ClArray = processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange indices.Length values indices outputArray) - ) + (fun () -> + kernel.KernelFunc + ndRange + indices.Length + values + indices + resultArray) + ) processor.Post(Msg.CreateRunMsg<_, _> kernel) - outputArray + resultArray + + let copyTo (clContext: ClContext) (workGroupSize: int) = + + let copy = + <@ + fun (ndRange: Range1D) inputArrayLength resultLength (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < inputArrayLength && gid < resultLength then + resultArray[gid] <- inputArray[gid] + @> + + let kernel = clContext.Compile(copy) + + fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> + + let ndRange = Range1D.CreateValid(resultArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + inputArray.Length + resultArray.Length + inputArray + resultArray) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultArray + diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 4349c8d7..757d3e63 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -5,7 +5,7 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module Reduce = - let private scan + let private scan<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) @@ -32,17 +32,9 @@ module Reduce = barrierLocal () - // if gid < length then - // localValues[lid] <- inputArray[gid] - // else - // localValues[lid] <- zero - // - // barrierLocal () - let mutable step = 2 while step <= workGroupSize do - if lid < workGroupSize / step then let firstValue = localValues[lid] let secondValue = localValues[lid + workGroupSize / step] @@ -78,7 +70,7 @@ module Reduce = () - let private scanToCell + let private scanToCell<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) @@ -108,7 +100,6 @@ module Reduce = let mutable step = 2 while step <= workGroupSize do - if lid < workGroupSize / step then let firstValue = localValues[lid] let secondValue = localValues[lid + workGroupSize / step] @@ -146,15 +137,18 @@ module Reduce = resultCell - let run + let run<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) (zero: 'a) = - let scan = scan clContext workGroupSize opAdd zero - let scanToCell = scanToCell clContext workGroupSize opAdd zero + let scan = + scan clContext workGroupSize opAdd zero + + let scanToCell = + scanToCell clContext workGroupSize opAdd zero fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> @@ -168,7 +162,7 @@ module Reduce = hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default - ) + ) let secondLength = (firstLength - 1) / workGroupSize + 1 @@ -178,7 +172,7 @@ module Reduce = hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default - ) + ) let mutable verticesArrays = firstVerticesArray, secondVerticesArray let swap (a, b) = (b, a) @@ -204,7 +198,7 @@ module Reduce = result - let atomicRun + let atomicRun<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index d1004f0b..d6aca676 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -88,25 +88,21 @@ module StandardOperations = | Both _ -> res <- true | _ -> () - if res then None else (Some true) @> + if res then Some true else None @> let intMulAtLeastOne = mkNumericMulAtLeastOne 0 let byteMulAtLeastOne = mkNumericMulAtLeastOne 0uy let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f - let maks zero = + let mask<'a when 'a: struct> = <@ fun (value: AtLeastOne<'a, 'a>) -> - let mutable res = zero - match value with | Both (_, right) -> - res <- right + Some right | Left left -> - res <- left + Some left | Right right -> - res <- right - - if res = zero then None else Some res + Some right @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 399c1e7b..bd5edc45 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -275,7 +275,7 @@ module COOVector = allValues, positions - let setPositions (clContext: ClContext) (workGroupSize: int) = + let private setPositions<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let setPositions = <@ @@ -404,32 +404,37 @@ module COOVector = { ClCooVector.Context = clContext Values = resultValues Indices = resultIndices - Size = leftVector.Size } + Size = max leftVector.Size rightVector.Size } ///. ///. ///Should be a power of 2 and greater than 1. - let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a) = + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = // zero let create = ClArray.create clContext workGroupSize - let opAdd = StandardOperations.maks zero + let eWiseAdd = + elementWiseAddAtLeastOne clContext StandardOperations.mask workGroupSize - let eWiseAdd = elementWiseAddAtLeastOne clContext opAdd workGroupSize + let copy = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (maskVector: ClCooVector<'b>) (scalar: 'a) -> + fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (rightVector: ClCooVector<'b>) (scalar: 'a) -> - let maskValues = create processor maskVector.Size scalar - - let maskIndices = maskVector.Indices + let maskValues = create processor rightVector.Size scalar + let maskIndices = copy processor rightVector.Indices let rightVector = { ClCooVector.Context = clContext - Indices = maskIndices + Indices = copy processor rightVector.Indices Values = maskValues - Size = maskVector.Size } //TODO() + Size = rightVector.Size } + + let res = eWiseAdd processor leftVector rightVector - eWiseAdd processor leftVector rightVector + processor.Post(Msg.CreateFreeMsg(maskValues)) + processor.Post(Msg.CreateFreeMsg(maskIndices)) + + res let preparePositionsComplemented (clContext: ClContext) (workGroupSize: int) = @@ -443,7 +448,7 @@ module COOVector = let index = inputIndices[gid] positions[index] <- 0 - @> //TODO + @> let kernel = clContext.Compile(preparePositions) @@ -471,42 +476,101 @@ module COOVector = positions + let setPositionsComplemented (clContext: ClContext) (workGroupSize: int) = + + let setPositions = + <@ + fun (ndRange: Range1D) length (positions: ClArray) (resultIndices: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid = length - 1 + || gid < length + && positions[gid] + <> positions[gid + 1] then + let index = positions[gid] + + resultIndices[index] <- gid + @> + + let kernel = clContext.Compile(setPositions) + + let sum = ClArray.prefixSumExcludeInplace clContext workGroupSize + + let resultLength = Array.zeroCreate 1 + + fun (processor: MailboxProcessor<_>) (positions: ClArray) -> + + let prefixArrayLenght = positions.Length + + let resultLengthGpu = clContext.CreateClCell 0 + + let _, r = sum processor positions resultLengthGpu + + let resultLength = + let res = + processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(r, resultLength, ch)) + + processor.Post(Msg.CreateFreeMsg<_>(r)) + + res[0] + + let resultIndices = + clContext.CreateClArray( + resultLength, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let ndRange = Range1D.CreateValid(prefixArrayLenght, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments( + fun () -> + kernel.KernelFunc + ndRange + prefixArrayLenght + positions + resultIndices) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultIndices + let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let preparePositions = preparePositionsComplemented clContext workGroupSize - let init = - ClArray.init <@ fun x -> x @> clContext workGroupSize //TODO remove lambda ? - let create = ClArray.zeroCreate clContext workGroupSize let setPositions = - setPositions clContext workGroupSize + setPositionsComplemented clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> let positions = preparePositions processor vector.Indices vector.Size - let allIndices = - init processor vector.Size + let resultIndices = setPositions processor positions - let (values: ClArray<'a>) = create processor vector.Size //TODO() + let resultLenght = resultIndices.Length - let resultValues, resultIndices = - setPositions processor values allIndices positions + let (ResultValues: ClArray<'a>) = create processor resultLenght processor.Post(Msg.CreateFreeMsg<_>(positions)) - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) { ClCooVector.Context = clContext Indices = resultIndices - Values = resultValues + Values = ResultValues Size = vector.Size } - let reduce + let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 124368ef..9153fb8a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -6,8 +6,10 @@ open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Quotations module DenseVector = - - let private maskWithValue (clContext: ClContext) (workGroupSize: int) = //TODO() + let private maskWithValue<'a, 'b when 'a: struct and 'b: struct> + (clContext: ClContext) + (workGroupSize: int) + = let fillVector = <@ @@ -25,7 +27,7 @@ module DenseVector = let kernel = clContext.Compile(fillVector) - fun (processor: MailboxProcessor<_>) (maskVector: ClArray<'a option>) (scalar: 'b) -> //TODO() scalar to clCell<'b> + fun (processor: MailboxProcessor<_>) (maskVector: ClArray<'a option>) (scalarCell: ClCell<'b>) -> let resultArray = clContext.CreateClArray( @@ -35,14 +37,6 @@ module DenseVector = allocationMode = AllocationMode.Default ) - let clScalar = - clContext.CreateClCell( - scalar, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.Default - ) - let ndRange = Range1D.CreateValid(maskVector.Length, workGroupSize) let kernel = kernel.GetKernel() @@ -54,12 +48,11 @@ module DenseVector = ndRange maskVector.Length maskVector - clScalar + scalarCell resultArray) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - processor.Post(Msg.CreateFreeMsg<_>(clScalar)) resultArray @@ -108,7 +101,7 @@ module DenseVector = resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.AllocAndCopyHostPtr + allocationMode = AllocationMode.Default ) let ndRange = @@ -133,23 +126,26 @@ module DenseVector = resultVector - let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a) = - - let opAdd = StandardOperations.maks zero + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = //zero - let eWiseAdd = elementWiseAddAtLeasOne clContext opAdd workGroupSize + let eWiseAdd = + elementWiseAddAtLeasOne clContext StandardOperations.mask workGroupSize let copyWithValue = maskWithValue clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (scalar: 'a) -> - let maskVector = copyWithValue processor maskVector scalar + let clScalar = clContext.CreateClCell scalar + + let maskVector = copyWithValue processor maskVector clScalar let resultVector = eWiseAdd processor leftVector maskVector processor.Post(Msg.CreateFreeMsg<_>(maskVector)) + processor.Post(Msg.CreateFreeMsg<_>(clScalar)) + resultVector let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = @@ -162,26 +158,21 @@ module DenseVector = if gid < length then match inputArray[gid] with - | Some _ -> - resultArray[gid] <- None | None -> resultArray[gid] <- Some defaultValue.Value + | _ -> () @> let kernel = clContext.Compile(complemented) + let create = ClArray.zeroCreate clContext workGroupSize + fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> let length = vector.Length - let resultArray = - clContext.CreateClArray( - length, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.Default - ) + let resultArray = create processor length let defaultValue = clContext.CreateClCell Unchecked.defaultof<'a> @@ -201,13 +192,15 @@ module DenseVector = resultArray) ) + processor.Post(Msg.CreateRunMsg(kernel)) + processor.Post(Msg.CreateFreeMsg(defaultValue)) resultArray - let getSomeBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + let getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let getSomeBitmap = + let getPositions = <@ fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray) -> @@ -221,7 +214,7 @@ module DenseVector = positions[gid] <- 0 @> - let kernel = clContext.Compile(getSomeBitmap) + let kernel = clContext.Compile(getPositions) fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> @@ -254,12 +247,12 @@ module DenseVector = let unzip = <@ - fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (prefixSumBuffer: ClArray) (bitmap: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> + fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (positions: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> let gid = ndRange.GlobalID0 - if gid < length && bitmap[gid] = 1 then - let index = prefixSumBuffer[gid] + if gid = length - 1 || gid < length && positions[gid] <> positions[gid + 1] then + let index = positions[gid] match denseVector[gid] with | Some value -> @@ -271,11 +264,8 @@ module DenseVector = let kernel = clContext.Compile(unzip) - let getBitmap = - getSomeBitmap clContext workGroupSize - - let copy = - ClArray.copy clContext workGroupSize + let getPositions = + getBitmap clContext workGroupSize let prefixSum = ClArray.prefixSumExcludeInplace clContext workGroupSize @@ -284,13 +274,11 @@ module DenseVector = fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - let bitmap = getBitmap processor vector - - let prefixSumArray = copy processor bitmap + let positions = getPositions processor vector let resultLengthGpu = clContext.CreateClCell 0 - let _, r = prefixSum processor prefixSumArray resultLengthGpu + let _, r = prefixSum processor positions resultLengthGpu let resultLength = let res = @@ -306,7 +294,7 @@ module DenseVector = hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default - ) + ) let resultIndices = clContext.CreateClArray( @@ -314,7 +302,7 @@ module DenseVector = hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default - ) + ) let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) @@ -327,47 +315,45 @@ module DenseVector = ndRange vector.Length vector - prefixSumArray - bitmap + positions resultValues resultIndices) ) processor.Post(Msg.CreateRunMsg(kernel)) - processor.Post(Msg.CreateFreeMsg<_>(bitmap)) - processor.Post(Msg.CreateFreeMsg<_>(prefixSumArray)) + processor.Post(Msg.CreateFreeMsg<_>(positions)) resultValues, resultIndices - let toCoo (clContext: ClContext) (workGroupSize: int) = + let toCoo<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let unzip = getValuesAndIndices clContext workGroupSize + let getValuesAndIndices = getValuesAndIndices clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - let values, indices = unzip processor vector + let values, indices = getValuesAndIndices processor vector { ClCooVector.Context = clContext Indices = indices Values = values Size = vector.Length } - let reduce + let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) zero = - let unzip = getValuesAndIndices clContext workGroupSize + let getValuesAndIndices = getValuesAndIndices clContext workGroupSize let reduce = Reduce.run clContext workGroupSize opAdd zero fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - let values, indices = unzip processor vector + let values, indices = getValuesAndIndices processor vector processor.Post(Msg.CreateFreeMsg<_>(indices)) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 8cb8260f..a7a9e80e 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -7,27 +7,22 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common module Vector = - let zeroCreate<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + let zeroCreate (clContext: ClContext) (workGroupSize: int) = let denseZeroCreate = ClArray.zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (size: int) (format: VectorFormat) -> match format with | COO -> - let indices = clContext.CreateClArray [| 0 |] - let values = clContext.CreateClArray<'a> [| Unchecked.defaultof<'a> |] - let vector = { ClCooVector.Context = clContext - Indices = indices - Values = values + Indices = clContext.CreateClArray [| 0 |] + Values = clContext.CreateClArray<'a> [| Unchecked.defaultof<'a> |] Size = 0 } ClVectorCOO vector | Dense -> - let resultValues = denseZeroCreate processor size - - ClVectorDense resultValues + ClVectorDense <| denseZeroCreate processor size let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = @@ -42,26 +37,21 @@ module Vector = let clIndices = clContext.CreateClArray indices let clValues = clContext.CreateClArray values + let resultLenght = (Array.max indices) + 1 + fun (processor: MailboxProcessor<_>) (format: VectorFormat) -> match format with | COO -> - let resultSize = elements.Length - let vector = { ClCooVector.Context = clContext Indices = clIndices Values = clValues - Size = resultSize } + Size = resultLenght } ClVectorCOO vector - | Dense -> - let size = (Array.max indices) + 1 - - let array = - toOptionArray processor clValues clIndices size - - ClVectorDense array + ClVectorDense + <| toOptionArray processor clValues clIndices resultLenght let copy (clContext: ClContext) (workGroupSize: int) = let copy = @@ -84,10 +74,7 @@ module Vector = ClVectorCOO vector | ClVectorDense vector -> - let array = - copyOptionData processor vector - - ClVectorDense array + ClVectorDense <| copyOptionData processor vector let mask = copy @@ -123,12 +110,12 @@ module Vector = ClVectorDense <| addDense processor left right | _ -> failwith "Vector formats are not matching." - let fillSubVector (clContext: ClContext) (workGroupSize: int) (zero: 'a) = + let fillSubVector (clContext: ClContext) (workGroupSize: int) = //TODO() remove zero let cooFillVector = - COOVector.fillSubVector clContext workGroupSize zero + COOVector.fillSubVector clContext workGroupSize let denseFillVector = - DenseVector.fillSubVector clContext workGroupSize zero + DenseVector.fillSubVector clContext workGroupSize let toCooVector = DenseVector.toCoo clContext workGroupSize @@ -136,33 +123,22 @@ module Vector = let toCooMask = DenseVector.toCoo clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> //TODO() + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> match vector, maskVector with | ClVectorCOO vector, ClVectorCOO mask -> - let res = - cooFillVector processor vector mask value - - ClVectorCOO res + ClVectorCOO <| cooFillVector processor vector mask value | ClVectorCOO vector, ClVectorDense mask -> let mask = toCooMask processor mask - let res = - cooFillVector processor vector mask value //TODO() - - ClVectorCOO res + ClVectorCOO <| cooFillVector processor vector mask value | ClVectorDense vector, ClVectorCOO mask -> let vector = toCooVector processor vector - let res = - cooFillVector processor vector mask value //TODO() - - ClVectorCOO res + ClVectorCOO <| cooFillVector processor vector mask value | ClVectorDense vector, ClVectorDense mask -> - let res = denseFillVector processor vector mask value //TODO() remove zero ? - - ClVectorDense res + ClVectorDense <| denseFillVector processor vector mask value - let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + let complemented (clContext: ClContext) (workGroupSize: int) = let cooComplemented = COOVector.complemented clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index a55cf447..e01e4c14 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -56,7 +56,6 @@ let testFixtures config wgSize q plus plusQ zero isEqual filter name = makeTest q reduce plus zero isEqual filter |> testPropertyWithConfig config (sprintf "Correctness on %s" name) - let tests = let config = defaultConfig diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 84e064f0..90081f37 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -32,7 +32,7 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index aa162d8f..ba297a16 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -550,19 +550,3 @@ module Utils = <| actual.[i] <| expected.[i] |> failtestf "%s" - - let createOptionArray elements = - - let indices, values = - elements - |> Array.ofList - |> Array.unzip - - let result = Array.zeroCreate <| (Array.max indices) + 1 - - for i in 0 .. indices.Length - 1 do - let index = indices[i] - - result[index] <- Some values[i] - - result diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index d9728f13..c9dde75a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -11,33 +11,29 @@ open GraphBLAS.FSharp.IO let allTests = testList "All tests" - [ - // [ Backend.BitonicSort.tests //TODO() - // Backend.PrefixSum.tests - // Backend.Convert.tests - // Backend.RemoveDuplicates.tests - // Backend.Copy.tests - // Backend.Replicate.tests - // Backend.EwiseAdd.tests - // Backend.EwiseAdd.tests2 //TODO() - // //Backend.EwiseAdd.tests3 - // Backend.Transpose.tests //TODO() - // //Matrix.GetTuples.tests - // //Matrix.Mxv.tests - // //Algo.Bfs.tests - //Backend.Vector.ZeroCreate.tests //TODO() - //Backend.Reduce.tests - //Backend.Vector.ZeroCreate.tests - //Backend.Vector.OfList.tests - //Backend.Vector.Copy.tests - //Backend.Vector.Convert.tests - //Backend.Vector.FillSubVector.tests - // Backend.Vector.ElementWiseAddAtLeastOne.addTests - // Backend.Vector.ElementWiseAddAtLeastOne.mulTests - //Backend.Vector.FillSubVector.tests - //Backend.Vector.Complemented.tests - Backend.Vector.Reduce.tests - ] + [ Backend.BitonicSort.tests + Backend.PrefixSum.tests + Backend.Convert.tests + Backend.RemoveDuplicates.tests + Backend.Copy.tests + Backend.Replicate.tests + Backend.EwiseAdd.tests + Backend.EwiseAdd.tests2 + //Backend.EwiseAdd.tests3 + Backend.Transpose.tests + //Matrix.GetTuples.tests + //Matrix.Mxv.tests + //Algo.Bfs.tests + Backend.Reduce.tests + Backend.Vector.ZeroCreate.tests + Backend.Vector.OfList.tests + Backend.Vector.Copy.tests + Backend.Vector.Convert.tests + Backend.Vector.ElementWiseAddAtLeastOne.addTests + Backend.Vector.ElementWiseAddAtLeastOne.mulTests + Backend.Vector.FillSubVector.tests + Backend.Vector.Complemented.tests + Backend.Vector.Reduce.tests ] |> testSequenced [] diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs index 5d18a13c..c4d0f002 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs @@ -4,14 +4,18 @@ open Expecto open Expecto.Logging open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils -open GraphBLAS.FSharp.Backend.Common -open StandardOperations -let logger = Log.create "Vector.Complemented.Tests" +open OpenCL.Net -let testArrayFilter array isZero = - Array.filter - <| (fun item -> not <| isZero item) - <| array +let logger = Log.create "Vector.fillSubVector.Tests" + +let NNZCountCount array isZero = + Array.filter (fun item -> not <| isZero item) array + |> Array.length + +let fFilter = + fun item -> System.Double.IsNaN item || System.Double.IsInfinity item + >> not + |> Array.filter let checkResult isEqual @@ -26,7 +30,7 @@ let checkResult Array.create expectedArrayLength 1 for i in 0 .. expectedArrayLength - 1 do - if isEqual vector[i] zero then + if not <| isEqual vector[i] zero then expectedArray[i] <- 0 match actual with @@ -36,7 +40,7 @@ let checkResult for i in 0 .. actual.Indices.Length - 1 do actualArray[actual.Indices[i]] <- 1 - $"arrays must have the same values and length" + $"arrays must have the same values and length, actual = %A{actualArray}, expected = %A{expectedArray}" |> compareArrays (=) actualArray expectedArray | _ -> failwith "Vector format must be COO." @@ -45,13 +49,16 @@ let correctnessGenericTest zero (complemented: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) + filter case (maskArray: 'a []) = - let rightFilteredArray = testArrayFilter maskArray (isEqual zero) + let maskArray = filter maskArray + + let maskNNZ = NNZCountCount maskArray (isEqual zero) - if rightFilteredArray.Length > 0 then + if maskNNZ > 0 && maskNNZ < maskArray.Length - 1 then let q = case.ClContext.Queue let context = case.ClContext.ClContext @@ -74,7 +81,7 @@ let correctnessGenericTest checkResult isEqual zero actual maskArray -let addTestFixtures (case: OperationCase) = +let testFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName dataType = @@ -88,7 +95,7 @@ let addTestFixtures (case: OperationCase) = let intComplemented = Vector.complemented context wgSize case - |> correctnessGenericTest (=) 0 intComplemented intToCoo + |> correctnessGenericTest (=) 0 intComplemented intToCoo id |> testPropertyWithConfig config (getCorrectnessTestName "int") let byteToCoo = Vector.toCoo context wgSize @@ -96,7 +103,7 @@ let addTestFixtures (case: OperationCase) = let byteComplemented = Vector.complemented context wgSize case - |> correctnessGenericTest (=) 0uy byteComplemented byteToCoo + |> correctnessGenericTest (=) 0uy byteComplemented byteToCoo id |> testPropertyWithConfig config (getCorrectnessTestName "byte") let floatToCoo = Vector.toCoo context wgSize @@ -104,7 +111,7 @@ let addTestFixtures (case: OperationCase) = let floatComplemented = Vector.complemented context wgSize case - |> correctnessGenericTest (=) 0.0 floatComplemented floatToCoo + |> correctnessGenericTest (=) 0.0 floatComplemented floatToCoo fFilter |> testPropertyWithConfig config (getCorrectnessTestName "float") let boolToCoo = Vector.toCoo context wgSize @@ -112,11 +119,22 @@ let addTestFixtures (case: OperationCase) = let boolComplemented = Vector.complemented context wgSize case - |> correctnessGenericTest (=) false boolComplemented boolToCoo + |> correctnessGenericTest (=) false boolComplemented boolToCoo id |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] let tests = testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) - |> List.collect addTestFixtures - |> testList "Backend.Vector.Complemented tests" + |> List.collect testFixtures + |> testList "Backend.Vector.fillSubVector tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs index c8868f37..c5048739 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs @@ -4,9 +4,10 @@ open Expecto open Expecto.Logging open Expecto.Logging.Message open GraphBLAS.FSharp.Tests.Utils - open GraphBLAS.FSharp.Backend -let logger = Log.create "Convert.Tests" +open OpenCL.Net + +let logger = Log.create "Backend.Vector.Convert.Tests" let config = defaultConfig let wgSize = 32 @@ -72,6 +73,17 @@ let testFixtures case = let tests = testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures - |> testList "Convert tests" + |> testList "Backend.Vector.Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs similarity index 70% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs index cfcf8a4e..b7ad9412 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAddAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs @@ -2,16 +2,22 @@ module Backend.Vector.ElementWiseAddAtLeastOne open Expecto open Expecto.Logging +open Expecto.Logging.Message open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils open GraphBLAS.FSharp.Backend.Common open StandardOperations +open OpenCL.Net let logger = Log.create "Vector.zeroCreate.Tests" -let testArrayFilter array isZero = - Array.filter - <| (fun item -> not <| isZero item) - <| array +let NNZCountCount array isZero = + Array.filter (fun item -> not <| isZero item) array + |> Array.length + +let fFilter = + fun item -> System.Double.IsNaN item || System.Double.IsInfinity item + >> not + |> Array.filter let checkResult (isEqual: 'c -> 'c -> bool) @@ -57,7 +63,7 @@ let checkResult actualArray[actual.Indices[i]] <- actual.Values[i] - $"arrays must have the same values" + $"arrays must have the same values, expected values = %A{expectedArray}, actual values = %A{actualArray}" |> compareArrays isEqual actualArray expectedArray | _ -> failwith "Vector format must be COO." @@ -65,22 +71,29 @@ let correctnessGenericTest leftIsEqual rightIsEqual resultIsEqual - (leftZero: 'a) - (rightZero: 'b) - (resultZero: 'c) - (op: 'a -> 'b -> 'c) + leftZero + rightZero + resultZero + op (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) (toCoo: MailboxProcessor<_> -> ClVector<'c> -> ClVector<'c>) + leftFilter + rightFilter case (leftArray: 'a []) (rightArray: 'b []) = - let leftFilteredArray = testArrayFilter leftArray (leftIsEqual leftZero) + let leftArray = leftFilter leftArray + let rightArray = rightFilter rightArray + + let leftNNZCount = + NNZCountCount leftArray (leftIsEqual leftZero) - let rightFilteredArray = testArrayFilter rightArray (rightIsEqual rightZero) + let rightNNZCount = + NNZCountCount rightArray (rightIsEqual rightZero) - if leftFilteredArray.Length > 0 && rightFilteredArray.Length > 0 then + if leftNNZCount > 0 && rightNNZCount > 0 then let q = case.ClContext.Queue let context = case.ClContext.ClContext @@ -94,19 +107,23 @@ let correctnessGenericTest let v1 = firstVector.ToDevice context let v2 = secondVector.ToDevice context - let res = addFun q v1 v2 + try + let res = addFun q v1 v2 - v1.Dispose q - v2.Dispose q + v1.Dispose q + v2.Dispose q - let cooRes = toCoo q res - res.Dispose q + let cooRes = toCoo q res + res.Dispose q - let actual = cooRes.ToHost q + let actual = cooRes.ToHost q - checkResult resultIsEqual leftZero rightZero resultZero op actual leftArray rightArray + checkResult resultIsEqual leftZero rightZero resultZero op actual leftArray rightArray + with + | :? OpenCL.Net.Cl.Exception as ex -> + logger.debug ( eventX $"exception: {ex.Message}") -let addTestFixtures (case: OperationCase) = +let addTestFixtures case = let config = defaultConfig let getCorrectnessTestName fstType sndType thrType = @@ -120,17 +137,17 @@ let addTestFixtures (case: OperationCase) = let intAddFun = Vector.elementWiseAddAtLeastOne context intSumAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo + |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") let toFloatCoo = Vector.toCoo context wgSize let floatAddFun = Vector.elementWiseAddAtLeastOne context floatSumAtLeastOne wgSize - let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute // infinity TODO() + let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y case - |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun toFloatCoo + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun toFloatCoo fFilter fFilter |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolToCoo = Vector.toCoo context wgSize @@ -138,7 +155,7 @@ let addTestFixtures (case: OperationCase) = let boolAddFun = Vector.elementWiseAddAtLeastOne context boolSumAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo + |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteToCoo = Vector.toCoo context wgSize @@ -146,16 +163,27 @@ let addTestFixtures (case: OperationCase) = let byteAddFun = Vector.elementWiseAddAtLeastOne context byteSumAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let addTests = - testCases + testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect addTestFixtures - |> testList "Backend.Vector.atLeastOneAdd tests" + |> testList "Backend.Vector.ElementWiseAtLeasOneAdd tests" -let mulTestFixtures (case: OperationCase) = +let mulTestFixtures case = let config = defaultConfig let getCorrectnessTestName fstType sndType thrType = @@ -164,22 +192,23 @@ let mulTestFixtures (case: OperationCase) = let wgSize = 32 let context = case.ClContext.ClContext + [ let toCoo = Vector.toCoo context wgSize let intMulFun = Vector.elementWiseAddAtLeastOne context intMulAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo + |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") let toFloatCoo = Vector.toCoo context wgSize let floatMulFun = Vector.elementWiseAddAtLeastOne context floatMulAtLeastOne wgSize - let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute // infinity TODO() + let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y case - |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun toFloatCoo + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun toFloatCoo fFilter fFilter |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolToCoo = Vector.toCoo context wgSize @@ -187,7 +216,7 @@ let mulTestFixtures (case: OperationCase) = let boolMulFun = Vector.elementWiseAddAtLeastOne context boolMulAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo + |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteToCoo = Vector.toCoo context wgSize @@ -195,11 +224,22 @@ let mulTestFixtures (case: OperationCase) = let byteMulFun = Vector.elementWiseAddAtLeastOne context byteMulAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let mulTests = - testCases + testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect mulTestFixtures - |> testList "Backend.Vector.atLeastOneMul tests" + |> testList "Backend.Vector.ElementWiseAtLeasOneMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs index d976c900..f857e0b6 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs @@ -6,8 +6,9 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils open Brahma.FSharp open FSharp.Quotations +open OpenCL.Net -let logger = Log.create "Vector.Complemented.Tests" +let logger = Log.create "Vector.Reduce.Tests" let zeroFilter array isZero = Array.filter @@ -65,7 +66,7 @@ let correctnessGenericTest checkResult zero op result array -let addTestFixtures (case: OperationCase) = +let testFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName dataType = @@ -73,6 +74,9 @@ let addTestFixtures (case: OperationCase) = let wgSize = 32 let context = case.ClContext.ClContext + let q = case.ClContext.Queue + + q.Error.Add(fun e -> failwithf "%A" e) let filterFloats = Array.filter (System.Double.IsNaN >> not) @@ -138,7 +142,18 @@ let addTestFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "bool and") ] let tests = - testCases + testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) - |> List.collect addTestFixtures - |> testList "Backend.Vector.Reduce tests" + |> List.collect testFixtures + |> testList "Backend.Vector.reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs index 75c7bc5e..20f962ee 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs @@ -2,17 +2,24 @@ module Backend.Vector.FillSubVector open Expecto open Expecto.Logging +open Expecto.Logging.Message open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils +open Brahma.FSharp +open OpenCL.Net -let logger = Log.create "Vector.zeroCreate.Tests" +let logger = Log.create "Vector.fillSubVector.Tests" let clContext = defaultContext.ClContext -let vectorFilter vector isZero = - Array.filter - <| (fun item -> not <| isZero item) - <| vector +let NNZCountCount array isZero = + Array.filter (fun item -> not <| isZero item) array + |> Array.length + +let fFilter = + fun item -> System.Double.IsNaN item || System.Double.IsInfinity item + >> not + |> Array.filter let checkResult (resultIsEqual: 'a -> 'a -> bool) @@ -25,20 +32,13 @@ let checkResult (value: 'a) = - let expectedArrayLength = - max vector.Length mask.Length - - let isVectorLess = - vector.Length < mask.Length - - let lowBound = - if isVectorLess then vector.Length else mask.Length + let expectedArrayLength = max vector.Length mask.Length let expectedArray = Array.create expectedArrayLength vectorZero for i in 0 .. expectedArrayLength - 1 do - if i < mask.Length && not (maskIsEqual mask[i] maskZero) then + if i < mask.Length && not <| maskIsEqual mask[i] maskZero then expectedArray[i] <- value elif i < vector.Length then expectedArray[i] <- vector[i] @@ -57,24 +57,35 @@ let checkResult let makeTest<'a, 'b when 'a: struct and 'b: struct> vectorIsZero maskIsEqual - (vectorZero: 'a ) - (maskZero: 'b) + vectorZero + maskZero (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) - (fillVector: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) + (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) (maskFormat: VectorFormat) + vectorFilter + maskFilter case (vector: 'a []) (mask: 'b []) (value: 'a) = - let filteredLeftVector = - vectorFilter vector (vectorIsZero vectorZero) + let vector = vectorFilter vector - let filteredMask = - vectorFilter mask (maskIsEqual maskZero) + let mask = maskFilter mask - if filteredLeftVector.Length > 0 && filteredMask.Length > 0 && not (vectorIsZero value vectorZero) then + let vectorNNZ = + NNZCountCount vector (vectorIsZero vectorZero) + + let maskNNZ = + NNZCountCount mask (maskIsEqual maskZero) + + let valueNNZCount = + Array.create 1 value + |> vectorFilter + |> Array.length + + if vectorNNZ > 0 && maskNNZ > 0 && valueNNZCount > 0 then let q = case.ClContext.Queue let context = case.ClContext.ClContext @@ -90,19 +101,23 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> let clMaskVector = maskVector.ToDevice context - let clActual = - fillVector q clLeftVector clMaskVector value + try + let clActual = + fillVector q clLeftVector clMaskVector value - let cooClActual = toCoo q clActual + let cooClActual = toCoo q 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 vectorIsZero maskIsEqual vectorZero maskZero actual vector mask value + checkResult vectorIsZero maskIsEqual vectorZero maskZero actual vector mask value + with + | :? OpenCL.Net.Cl.Exception as ex -> + logger.debug ( eventX $"exception: {ex.Message}") let testFixtures case = let config = defaultConfig @@ -114,74 +129,85 @@ let testFixtures case = let context = case.ClContext.ClContext let floatIsEqual x y = - abs (x - y) < Accuracy.medium.absolute + abs (x - y) < Accuracy.medium.absolute || x = y - [ let intFill = Vector.fillSubVector context wgSize 0 + [ let intFill = Vector.fillSubVector context wgSize let intToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.COO + |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.COO id id |> testPropertyWithConfig config (getCorrectnessTestName "int" "COO") - let floatFill = Vector.fillSubVector context wgSize 0.0 + let floatFill = Vector.fillSubVector context wgSize let floatToCoo = Vector.toCoo context wgSize case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.COO - |> testPropertyWithConfig config (getCorrectnessTestName "float" "COO") //TODO filt floats + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.COO fFilter fFilter + |> testPropertyWithConfig config (getCorrectnessTestName "float" "COO") - let byteFill = Vector.fillSubVector context wgSize 0uy + let byteFill = Vector.fillSubVector context wgSize let byteToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.COO + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.COO id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "COO") - let boolFill = Vector.fillSubVector context wgSize false + let boolFill = Vector.fillSubVector context wgSize let boolToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.COO + |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.COO id id |> testPropertyWithConfig config (getCorrectnessTestName "bool" "COO") - let intFill = Vector.fillSubVector context wgSize 0 + let intFill = Vector.fillSubVector context wgSize let intToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Dense + |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Dense id id |> testPropertyWithConfig config (getCorrectnessTestName "int" "Dense") - let floatFill = Vector.fillSubVector context wgSize 0.0 + let floatFill = Vector.fillSubVector context wgSize let floatToCoo = Vector.toCoo context wgSize case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Dense - |> testPropertyWithConfig config (getCorrectnessTestName "float" "Dense") //TODO filt floats + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Dense fFilter fFilter + |> testPropertyWithConfig config (getCorrectnessTestName "float" "Dense") - let byteFill = Vector.fillSubVector context wgSize 0uy + let byteFill = Vector.fillSubVector context wgSize let byteToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Dense + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Dense id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "Dense") - let boolFill = Vector.fillSubVector context wgSize false + let boolFill = Vector.fillSubVector context wgSize let boolToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense + |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense id id |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] let tests = testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures |> testList "Backend.Vector.fillSubVector tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs index 95ede4a5..4d4353a2 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs @@ -5,8 +5,9 @@ open Expecto.Logging open Brahma.FSharp open GraphBLAS.FSharp.Tests.Utils open GraphBLAS.FSharp.Backend +open OpenCL.Net -let logger = Log.create "Vector.zeroCreate.Tests" +let logger = Log.create "Vector.ofList.Tests" let filter elements = List.filter @@ -14,47 +15,25 @@ let filter elements = <| elements |> List.distinctBy fst - - -let checkResultDense - (isEqual: 'a -> 'a -> bool) - (expectedValues: 'a option []) - (actual: 'a option []) - = - - let actualSize = actual.Length - let expectedSize = expectedValues.Length - - Expect.equal actualSize expectedSize "lengths must be the same" - - let isEqual (left: 'a option) (right: 'a option) = - match left, right with - | Some left, Some right -> - isEqual left right - | None, None -> true - | _, _ -> false - - compareArrays isEqual actual expectedValues "values must be the same" - -let checkResultCOO +let checkResult (isEqual: 'a -> 'a -> bool) (expectedIndices: int []) (expectedValues: 'a []) - (actual: COOVector<'a>) + (actual: Vector<'a>) = - let actualSize = actual.Size - let expectedSize = expectedValues.Length - - Expect.equal actualSize expectedSize "lengths must be the same" - - compareArrays (=) actual.Indices expectedIndices "indices must be the same" + Expect.equal actual.Size (Array.max expectedIndices + 1) "lengths must be the same" - compareArrays isEqual actual.Values expectedValues "values must be the same" + match actual with + | VectorCOO actual -> + compareArrays (=) actual.Indices expectedIndices "indices must be the same" + compareArrays isEqual actual.Values expectedValues "values must be the same" + | _ -> failwith "Vector format must be COO." let correctnessGenericTest<'a when 'a: struct> (isEqual: 'a -> 'a -> bool) (ofList: (int * 'a) list -> MailboxProcessor -> VectorFormat -> ClVector<'a>) + (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) (elements: (int * 'a) list) = @@ -74,18 +53,14 @@ let correctnessGenericTest<'a when 'a: struct> let clActual = ofList elements q case.FormatCase - let actual = clActual.ToHost q + let clCooActual = toCoo q clActual - clActual.Dispose q + let actual = clCooActual.ToHost q - match actual with - | VectorDense actual -> - let expected = - createOptionArray elements + clActual.Dispose q + clCooActual.Dispose q - checkResultDense isEqual expected actual - | VectorCOO actual -> - checkResultCOO isEqual indices values actual + checkResult isEqual indices values actual let testFixtures (case: OperationCase) = [ let config = defaultConfig @@ -93,35 +68,59 @@ let testFixtures (case: OperationCase) = let wgSize = 32 let context = case.ClContext.ClContext + let q = case.ClContext.Queue + + q.Error.Add(fun e -> failwithf $"%A{e}") let getCorrectnessTestName datatype = sprintf "Correctness on %s, %A" datatype case.FormatCase - let boolOfList = - Vector.ofList context wgSize + let boolOfList = Vector.ofList context wgSize + + let toCoo = Vector.toCoo context wgSize case - |> correctnessGenericTest (=) boolOfList + |> correctnessGenericTest (=) boolOfList toCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool") + let intOfList = Vector.ofList context wgSize - let intOfList = - Vector.ofList context wgSize + let toCoo = Vector.toCoo context wgSize case - |> correctnessGenericTest (=) intOfList + |> correctnessGenericTest (=) intOfList toCoo |> testPropertyWithConfig config (getCorrectnessTestName "int") - let byteOfList = - Vector.ofList context wgSize + let byteOfList = Vector.ofList context wgSize + + let toCoo = Vector.toCoo context wgSize case - |> correctnessGenericTest (=) byteOfList - |> testPropertyWithConfig config (getCorrectnessTestName "byte")] + |> correctnessGenericTest (=) byteOfList toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "byte") + + let floatOfList = Vector.ofList context wgSize + + let toCoo = Vector.toCoo context wgSize + + case + |> correctnessGenericTest (=) floatOfList toCoo + |> testPropertyWithConfig config (getCorrectnessTestName "float") ] let tests = testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures |> testList "Backend.Vector.ofList tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs index 8b3bff85..ba58fa72 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs @@ -2,17 +2,15 @@ module Backend.Vector.ZeroCreate open Expecto open Expecto.Logging - open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils +open OpenCL.Net let logger = Log.create "Vector.zeroCreate.Tests" let checkResult size (actual: Vector<'a>) = - match actual with | VectorDense vector -> - Expect.equal actual.Size size "The size should be the same" Array.iter @@ -25,17 +23,15 @@ let checkResult size (actual: Vector<'a>) = Expect.equal vector.Indices [| 0 |] "The index array must contain the 0" let correctnessGenericTest<'a when 'a: struct and 'a: equality> - (wgSize: int) + (zeroCreate: MailboxProcessor<_> -> int -> VectorFormat -> ClVector<'a>) (case: OperationCase) (vectorSize: int) = if vectorSize > 0 then - let context = case.ClContext.ClContext let q = case.ClContext.Queue - let clVector = - Vector.zeroCreate<'a> context wgSize q vectorSize case.FormatCase + let (clVector: ClVector<'a>) = zeroCreate q vectorSize case.FormatCase let hostVector = clVector.ToHost q @@ -44,16 +40,56 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> checkResult vectorSize hostVector let testFixtures (case: OperationCase) = + let config = defaultConfig + + let getCorrectnessTestName dataType = + $"Correctness on %A{dataType}, %A{case.FormatCase}" - let config = { defaultConfig with maxTest = 1} let wgSize = 32 + let context = case.ClContext.ClContext + + let q = case.ClContext.Queue + + q.Error.Add(fun e -> failwithf "%A" e) + + [ let intZeroCreate = Vector.zeroCreate context wgSize + + case + |> correctnessGenericTest intZeroCreate + |> testPropertyWithConfig config (getCorrectnessTestName "int") - case - |> correctnessGenericTest wgSize - |> testPropertyWithConfig config (sprintf "Correctness on %A" case) + let byteZeroCreat = Vector.zeroCreate context wgSize + + case + |> correctnessGenericTest byteZeroCreat + |> testPropertyWithConfig config (getCorrectnessTestName "byte") + + + let floatZeroCreate = Vector.zeroCreate context wgSize + + case + |> correctnessGenericTest floatZeroCreate + |> testPropertyWithConfig config (getCorrectnessTestName "float") + + let boolZeroCreate = Vector.zeroCreate context wgSize + + case + |> correctnessGenericTest boolZeroCreate + |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] let tests = testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) - |> List.map testFixtures + |> List.collect testFixtures |> testList "Backend.Vector.zeroCreate tests" From eabf83734e7e21a108e13348b4a06fc83aec29a7 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 00:06:23 +0300 Subject: [PATCH 37/74] add: build pass localy --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 2 +- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 8 ++++---- src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs | 6 +++--- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 102043c5..53d8db26 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -463,7 +463,7 @@ module ClArray = if gid < length then let resultIndex = indices[gid] - outputArray[resultIndex] <- Some values[gid] + outputArray[resultIndex] <- Some(values.[gid]) @> let kernel = clContext.Compile(toOption) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 757d3e63..e71d9390 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -24,7 +24,7 @@ module Reduce = let i = (gid - lid) * 2 + lid if i + workGroupSize < length then - localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] + localValues[lid] <- ((%opAdd) inputArray[i] inputArray[i + workGroupSize]) elif i < length then localValues[lid] <- inputArray[i] else @@ -39,7 +39,7 @@ module Reduce = let firstValue = localValues[lid] let secondValue = localValues[lid + workGroupSize / step] - localValues[lid] <- (%opAdd) firstValue secondValue + localValues[lid] <- ((%opAdd) firstValue secondValue) step <- step <<< 1 @@ -89,7 +89,7 @@ module Reduce = let i = (gid - lid) * 2 + lid if i + workGroupSize < length then - localValues[lid] <- (%opAdd) inputArray[i] inputArray[i + workGroupSize] + localValues[lid] <- ((%opAdd) inputArray[i] inputArray[i + workGroupSize]) elif i < length then localValues[lid] <- inputArray[i] else @@ -235,7 +235,7 @@ module Reduce = barrierLocal () if lid = 0 then - atomic (%opAdd) totalSum.Value localValues[0] |> ignore + (atomic %opAdd totalSum.Value localValues[0]) |> ignore @> let kernel = clContext.Compile(reduce) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index bd5edc45..c45babfc 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -208,7 +208,7 @@ module COOVector = if gid < length - 1 && allIndices[gid] = allIndices[gid + 1] then positions[gid] <- 0 - match (%opAdd) (Both (leftValues[gid], rightValues[gid + 1])) with + match (%opAdd) (Both(leftValues[gid], rightValues[gid + 1])) with | Some value -> allValues[gid + 1] <- value positions[gid + 1] <- 1 @@ -216,14 +216,14 @@ module COOVector = positions[gid + 1] <- 0 elif (gid < length && gid > 0 && allIndices[gid - 1] <> allIndices[gid]) || gid = 0 then if isLeft[gid] = 1 then - match (%opAdd) (Left leftValues[gid]) with + match (%opAdd) (Left(leftValues[gid])) with | Some value -> allValues[gid] <- value positions[gid] <- 1 | None -> positions[gid] <- 0 else - match (%opAdd) (Right rightValues[gid]) with + match (%opAdd) (Right(rightValues[gid])) with | Some value -> allValues[gid] <- value positions[gid] <- 1 From 3eb9c52883f4ab343be196405a0741075b45c249 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 00:22:46 +0300 Subject: [PATCH 38/74] add: dot in index --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index e71d9390..fad23451 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -24,7 +24,7 @@ module Reduce = let i = (gid - lid) * 2 + lid if i + workGroupSize < length then - localValues[lid] <- ((%opAdd) inputArray[i] inputArray[i + workGroupSize]) + localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] elif i < length then localValues[lid] <- inputArray[i] else @@ -89,7 +89,7 @@ module Reduce = let i = (gid - lid) * 2 + lid if i + workGroupSize < length then - localValues[lid] <- ((%opAdd) inputArray[i] inputArray[i + workGroupSize]) + localValues[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] elif i < length then localValues[lid] <- inputArray[i] else @@ -235,7 +235,7 @@ module Reduce = barrierLocal () if lid = 0 then - (atomic %opAdd totalSum.Value localValues[0]) |> ignore + atomic %opAdd totalSum.Value localValues.[0] |> ignore @> let kernel = clContext.Compile(reduce) From 2e2e0361acfda9ea514ac915d1444ad9907ce282 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 00:48:38 +0300 Subject: [PATCH 39/74] add: dots index fix --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 6 +- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 36 ++++---- .../Vector/COOVector/COOVector.fs | 90 +++++++++---------- .../Vector/DenseVector/DenseVector.fs | 44 ++++----- .../ComplementedTests.fs | 6 +- .../ElementWiseAtLeastOne.fs | 12 +-- .../VectorOperationsTests/ReduceTests.fs | 2 +- .../fillSubVectorTest.fs | 8 +- 8 files changed, 102 insertions(+), 102 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 53d8db26..d8897cd9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -461,9 +461,9 @@ module ClArray = let gid = ndRange.GlobalID0 if gid < length then - let resultIndex = indices[gid] + let resultIndex = indices.[gid] - outputArray[resultIndex] <- Some(values.[gid]) + outputArray.[resultIndex] <- Some values.[gid] @> let kernel = clContext.Compile(toOption) @@ -502,7 +502,7 @@ module ClArray = let gid = ndRange.GlobalID0 if gid < inputArrayLength && gid < resultLength then - resultArray[gid] <- inputArray[gid] + resultArray.[gid] <- inputArray.[gid] @> let kernel = clContext.Compile(copy) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index fad23451..9df373c6 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -26,9 +26,9 @@ module Reduce = if i + workGroupSize < length then localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] elif i < length then - localValues[lid] <- inputArray[i] + localValues.[lid] <- inputArray.[i] else - localValues[lid] <- zero + localValues.[lid] <- zero barrierLocal () @@ -36,16 +36,16 @@ module Reduce = while step <= workGroupSize do if lid < workGroupSize / step then - let firstValue = localValues[lid] - let secondValue = localValues[lid + workGroupSize / step] + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + workGroupSize / step] - localValues[lid] <- ((%opAdd) firstValue secondValue) + localValues.[lid] <- ((%opAdd) firstValue secondValue) step <- step <<< 1 barrierLocal () - resultArray[gid / workGroupSize] <- localValues[0] + resultArray.[gid / workGroupSize] <- localValues.[0] @> let kernel = clContext.Compile(scan) @@ -89,11 +89,11 @@ module Reduce = let i = (gid - lid) * 2 + lid if i + workGroupSize < length then - localValues[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] + localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] elif i < length then - localValues[lid] <- inputArray[i] + localValues.[lid] <- inputArray.[i] else - localValues[lid] <- zero + localValues.[lid] <- zero barrierLocal () @@ -101,16 +101,16 @@ module Reduce = while step <= workGroupSize do if lid < workGroupSize / step then - let firstValue = localValues[lid] - let secondValue = localValues[lid + workGroupSize / step] + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + workGroupSize / step] - localValues[lid] <- (%opAdd) firstValue secondValue + localValues.[lid] <- (%opAdd) firstValue secondValue step <- step <<< 1 barrierLocal () - resultCell.Value <- localValues[0] + resultCell.Value <- localValues.[0] @> let kernel = clContext.Compile(scan) @@ -215,9 +215,9 @@ module Reduce = let localValues = localArray<'a> workGroupSize if gid < length then - localValues[lid] <- inputArray[gid] + localValues.[lid] <- inputArray.[gid] else - localValues[lid] <- zero + localValues.[lid] <- zero barrierLocal () @@ -225,10 +225,10 @@ module Reduce = while step <= workGroupSize do if lid < workGroupSize / step then - let firstValue = localValues[lid] - let secondValue = localValues[lid + workGroupSize / step] + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + workGroupSize / step] - localValues[lid] <- (%opAdd) firstValue secondValue + localValues.[lid] <- (%opAdd) firstValue secondValue step <- step <<< 1 diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index c45babfc..e100ce12 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -37,10 +37,10 @@ module COOVector = while leftEdge <= rightEdge do let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer[middleIdx] + let firstIndex = firstIndicesBuffer.[middleIdx] let secondIndex = - secondIndicesBuffer[diagonalNumber - middleIdx] + secondIndicesBuffer.[diagonalNumber - middleIdx] if firstIndex <= secondIndex then leftEdge <- middleIdx + 1 @@ -70,10 +70,10 @@ module COOVector = let localIndices = localArray workGroupSize if localID < firstLocalLength then - localIndices[localID] <- firstIndicesBuffer[beginIdx + localID] + localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] if localID < secondLocalLength then - localIndices[firstLocalLength + localID] <- secondIndicesBuffer[i - beginIdx] + localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] barrierLocal () @@ -88,10 +88,10 @@ module COOVector = while leftEdge <= rightEdge do let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices[middleIdx] + let firstIndex = localIndices.[middleIdx] let secondIndex = - localIndices[firstLocalLength + localID - middleIdx] + localIndices.[firstLocalLength + localID - middleIdx] if firstIndex <= secondIndex then leftEdge <- middleIdx + 1 @@ -108,21 +108,21 @@ module COOVector = let mutable fstIdx = 0 if isValidX then - fstIdx <- localIndices[boundaryX] + fstIdx <- localIndices.[boundaryX] let mutable sndIdx = 0 if isValidY then - sndIdx <- localIndices[firstLocalLength + boundaryY] + sndIdx <- localIndices.[firstLocalLength + boundaryY] if not isValidX || isValidY && fstIdx <= sndIdx then - allIndicesBuffer[i] <- sndIdx - secondResultValues[i] <- secondValuesBuffer[i - localID - beginIdx + boundaryY] - isLeftBitMap[i] <- 0 + 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 + allIndicesBuffer.[i] <- fstIdx + firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitMap.[i] <- 1 @> let kernel = clContext.Compile(merge) @@ -205,30 +205,30 @@ module COOVector = let gid = ndRange.GlobalID0 - if gid < length - 1 && allIndices[gid] = allIndices[gid + 1] then - positions[gid] <- 0 + if gid < length - 1 && allIndices.[gid] = allIndices.[gid + 1] then + positions.[gid] <- 0 - match (%opAdd) (Both(leftValues[gid], rightValues[gid + 1])) with + match (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) with | Some value -> - allValues[gid + 1] <- value - positions[gid + 1] <- 1 + allValues.[gid + 1] <- value + positions.[gid + 1] <- 1 | None -> - positions[gid + 1] <- 0 - elif (gid < length && gid > 0 && allIndices[gid - 1] <> allIndices[gid]) || gid = 0 then - if isLeft[gid] = 1 then - match (%opAdd) (Left(leftValues[gid])) with + positions.[gid + 1] <- 0 + elif (gid < length && gid > 0 && allIndices.[gid - 1] <> allIndices.[gid]) || gid = 0 then + if isLeft.[gid] = 1 then + match (%opAdd) (Left(leftValues.[gid])) with | Some value -> - allValues[gid] <- value - positions[gid] <- 1 + allValues.[gid] <- value + positions.[gid] <- 1 | None -> - positions[gid] <- 0 + positions.[gid] <- 0 else - match (%opAdd) (Right(rightValues[gid])) with + match (%opAdd) (Right(rightValues.[gid])) with | Some value -> - allValues[gid] <- value - positions[gid] <- 1 + allValues.[gid] <- value + positions.[gid] <- 1 | None -> - positions[gid] <- 0 + positions.[gid] <- 0 @> let kernel = clContext.Compile(preparePositions) @@ -285,12 +285,12 @@ module COOVector = if i = prefixSumArrayLength - 1 || i < prefixSumArrayLength - && prefixSumBuffer[i] - <> prefixSumBuffer[i + 1] then - let index = prefixSumBuffer[i] + && prefixSumBuffer.[i] + <> prefixSumBuffer.[i + 1] then + let index = prefixSumBuffer.[i] - resultValues[index] <- allValues[i] - resultIndices[index] <- allIndices[i] + resultValues.[index] <- allValues.[i] + resultIndices.[index] <- allIndices.[i] @> let kernel = clContext.Compile(setPositions) @@ -314,10 +314,10 @@ module COOVector = processor.Post(Msg.CreateFreeMsg<_>(r)) - res[0] + res.[0] let resultValues = - clContext.CreateClArray<'a>( + clContext.CreateClArray( resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, @@ -445,9 +445,9 @@ module COOVector = let gid = ndRange.GlobalID0 if gid < indicesArrayLength then - let index = inputIndices[gid] + let index = inputIndices.[gid] - positions[index] <- 0 + positions.[index] <- 0 @> let kernel = clContext.Compile(preparePositions) @@ -486,11 +486,11 @@ module COOVector = if gid = length - 1 || gid < length - && positions[gid] - <> positions[gid + 1] then - let index = positions[gid] + && positions.[gid] + <> positions.[gid + 1] then + let index = positions.[gid] - resultIndices[index] <- gid + resultIndices.[index] <- gid @> let kernel = clContext.Compile(setPositions) @@ -513,10 +513,10 @@ module COOVector = processor.Post(Msg.CreateFreeMsg<_>(r)) - res[0] + res.[0] let resultIndices = - clContext.CreateClArray( + clContext.CreateClArray( resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 9153fb8a..4890a748 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -18,11 +18,11 @@ module DenseVector = let gid = ndRange.GlobalID0 if gid < length then - match maskArray[gid] with + match maskArray.[gid] with | Some _ -> - resultArray[gid] <- Some scalar.Value + resultArray.[gid] <- Some scalar.Value | None -> - resultArray[gid] <- None + resultArray.[gid] <- None @> let kernel = clContext.Compile(fillVector) @@ -72,21 +72,21 @@ module DenseVector = let mutable rightItem = None if gid < leftVectorLength then - leftItem <- leftVector[gid] + leftItem <- leftVector.[gid] if gid < rightVectorLength then - rightItem <- rightVector[gid] + rightItem <- rightVector.[gid] if gid < resultLength then match leftItem, rightItem with | Some left, Some right -> - resultVector[gid] <- (%opAdd) (Both (left, right)) + resultVector.[gid] <- (%opAdd) (Both (left, right)) | Some left, None -> - resultVector[gid] <- (%opAdd) (Left left) + resultVector.[gid] <- (%opAdd) (Left left) | None, Some right -> - resultVector[gid] <- (%opAdd) (Right right) + resultVector.[gid] <- (%opAdd) (Right right) | None, None -> - resultVector[gid] <- None + resultVector.[gid] <- None @> let kernel = clContext.Compile(eWiseAdd) @@ -157,9 +157,9 @@ module DenseVector = let gid = ndRange.GlobalID0 if gid < length then - match inputArray[gid] with + match inputArray.[gid] with | None -> - resultArray[gid] <- Some defaultValue.Value + resultArray.[gid] <- Some defaultValue.Value | _ -> () @> @@ -207,11 +207,11 @@ module DenseVector = let gid = ndRange.GlobalID0 if gid < length then - match vector[gid] with + match vector.[gid] with | Some _ -> - positions[gid] <- 1 + positions.[gid] <- 1 | None -> - positions[gid] <- 0 + positions.[gid] <- 0 @> let kernel = clContext.Compile(getPositions) @@ -251,13 +251,13 @@ module DenseVector = let gid = ndRange.GlobalID0 - if gid = length - 1 || gid < length && positions[gid] <> positions[gid + 1] then - let index = positions[gid] + if gid = length - 1 || gid < length && positions.[gid] <> positions.[gid + 1] then + let index = positions.[gid] - match denseVector[gid] with + match denseVector.[gid] with | Some value -> - resultValues[index] <- value - resultIndices[index] <- gid + resultValues.[index] <- value + resultIndices.[index] <- gid | None -> () @> @@ -286,10 +286,10 @@ module DenseVector = processor.Post(Msg.CreateFreeMsg<_>(r)) - res[0] + res.[0] let resultValues = - clContext.CreateClArray( + clContext.CreateClArray<'a>( resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, @@ -297,7 +297,7 @@ module DenseVector = ) let resultIndices = - clContext.CreateClArray( + clContext.CreateClArray( resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs index c4d0f002..ae4897d2 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs @@ -30,15 +30,15 @@ let checkResult Array.create expectedArrayLength 1 for i in 0 .. expectedArrayLength - 1 do - if not <| isEqual vector[i] zero then - expectedArray[i] <- 0 + if not <| isEqual vector.[i] zero then + expectedArray.[i] <- 0 match actual with | VectorCOO actual -> let actualArray = Array.create expectedArrayLength 0 for i in 0 .. actual.Indices.Length - 1 do - actualArray[actual.Indices[i]] <- 1 + actualArray.[actual.Indices.[i]] <- 1 $"arrays must have the same values and length, actual = %A{actualArray}, expected = %A{expectedArray}" |> compareArrays (=) actualArray expectedArray diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs index b7ad9412..b248ebce 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs @@ -45,23 +45,23 @@ let checkResult for i in 0 .. expectedArrayLength - 1 do let item = if i < lowBound then - op leftArray[i] rightArray[i] + op leftArray.[i] rightArray.[i] elif isLeftLess then - op leftZero rightArray[i] + op leftZero rightArray.[i] else - op leftArray[i] rightZero + op leftArray.[i] rightZero - expectedArray[i] <- item + expectedArray.[i] <- item match actual with | VectorCOO actual -> let actualArray = Array.create expectedArrayLength resultZero for i in 0 .. actual.Indices.Length - 1 do - if isEqual actual.Values[i] resultZero then + if isEqual actual.Values.[i] resultZero then failwith "Resulting zeroes should be filtered." - actualArray[actual.Indices[i]] <- actual.Values[i] + actualArray.[actual.Indices.[i]] <- actual.Values.[i] $"arrays must have the same values, expected values = %A{expectedArray}, actual values = %A{actualArray}" |> compareArrays isEqual actualArray expectedArray diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs index f857e0b6..b5395901 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs @@ -62,7 +62,7 @@ let correctnessGenericTest q.Post(Msg.CreateFreeMsg<_>(resultCell)) - res[0] + res.[0] checkResult zero op result array diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs index 20f962ee..cb747aa6 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs @@ -38,17 +38,17 @@ let checkResult Array.create expectedArrayLength vectorZero for i in 0 .. expectedArrayLength - 1 do - if i < mask.Length && not <| maskIsEqual mask[i] maskZero then - expectedArray[i] <- value + if i < mask.Length && not <| maskIsEqual mask.[i] maskZero then + expectedArray.[i] <- value elif i < vector.Length then - expectedArray[i] <- vector[i] + expectedArray.[i] <- vector.[i] match actual with | VectorCOO actual -> let actualArray = Array.create expectedArrayLength vectorZero for i in 0 .. actual.Indices.Length - 1 do - actualArray[actual.Indices[i]] <- actual.Values[i] + actualArray.[actual.Indices.[i]] <- actual.Values.[i] "arrays must have the same values and length" |> compareArrays resultIsEqual actualArray expectedArray From f668dc1c64ff63bfc03f67338ddb0b892e6877c2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 01:16:02 +0300 Subject: [PATCH 40/74] fantomas formatting --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 49 +-- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 188 ++++----- .../Common/StandardOperations.fs | 15 +- .../Vector/COOVector/COOVector.fs | 369 ++++++++---------- .../Vector/DenseVector/DenseVector.fs | 200 ++++------ src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 92 ++--- .../BackendCommonTests/ReduceTests.fs | 9 +- .../GraphBLAS-sharp.Tests.fsproj | 16 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 19 +- .../Complemented.fs} | 14 +- .../Convert.fs} | 13 +- .../copyTests.fs => VectorOperations/Copy.fs} | 9 +- .../ElementWiseAtLeastOne.fs | 56 ++- .../FillSubVector.fs} | 23 +- .../OfList.fs} | 12 +- .../Reduce.fs} | 0 .../ZeroCreate.fs} | 2 +- 17 files changed, 471 insertions(+), 615 deletions(-) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests/ComplementedTests.fs => VectorOperations/Complemented.fs} (94%) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests/ConvertTest.fs => VectorOperations/Convert.fs} (90%) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests/copyTests.fs => VectorOperations/Copy.fs} (91%) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests => VectorOperations}/ElementWiseAtLeastOne.fs (81%) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests/fillSubVectorTest.fs => VectorOperations/FillSubVector.fs} (91%) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests/ofListTests.fs => VectorOperations/OfList.fs} (92%) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests/ReduceTests.fs => VectorOperations/Reduce.fs} (100%) rename tests/GraphBLAS-sharp.Tests/{VectorOperationsTests/zeroCreateTests.fs => VectorOperations/ZeroCreate.fs} (99%) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index d8897cd9..79b01e72 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -456,15 +456,13 @@ module ClArray = let toOptionArray (clContext: ClContext) (workGroupSize: int) = let toOption = - <@ - fun (ndRange: Range1D) (length: int) (values: ClArray<'a>) (indices: ClArray) (outputArray: ClArray<'a option>) -> - let gid = ndRange.GlobalID0 + <@ fun (ndRange: Range1D) (length: int) (values: ClArray<'a>) (indices: ClArray) (outputArray: ClArray<'a option>) -> + let gid = ndRange.GlobalID0 - if gid < length then - let resultIndex = indices.[gid] + if gid < length then + let resultIndex = indices.[gid] - outputArray.[resultIndex] <- Some values.[gid] - @> + outputArray.[resultIndex] <- Some values.[gid] @> let kernel = clContext.Compile(toOption) @@ -479,15 +477,8 @@ module ClArray = let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - indices.Length - values - indices - resultArray) - ) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange indices.Length values indices resultArray) + ) processor.Post(Msg.CreateRunMsg<_, _> kernel) @@ -496,35 +487,27 @@ module ClArray = let copyTo (clContext: ClContext) (workGroupSize: int) = let copy = - <@ - fun (ndRange: Range1D) inputArrayLength resultLength (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> + <@ fun (ndRange: Range1D) inputArrayLength resultLength (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < inputArrayLength && gid < resultLength then - resultArray.[gid] <- inputArray.[gid] - @> + if gid < inputArrayLength && gid < resultLength then + resultArray.[gid] <- inputArray.[gid] @> let kernel = clContext.Compile(copy) fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> - let ndRange = Range1D.CreateValid(resultArray.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(resultArray.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - inputArray.Length - resultArray.Length - inputArray - resultArray) - ) + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange inputArray.Length resultArray.Length inputArray resultArray) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) resultArray - diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 9df373c6..14abfeed 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -13,58 +13,51 @@ module Reduce = = let scan = - <@ - fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 - let localValues = localArray<'a> workGroupSize + let localValues = localArray<'a> workGroupSize - let i = (gid - lid) * 2 + lid + let i = (gid - lid) * 2 + lid - if i + workGroupSize < length then - localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] - elif i < length then - localValues.[lid] <- inputArray.[i] - else - localValues.[lid] <- zero + if i + workGroupSize < length then + localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] + elif i < length then + localValues.[lid] <- inputArray.[i] + else + localValues.[lid] <- zero - barrierLocal () + barrierLocal () - let mutable step = 2 + let mutable step = 2 - while step <= workGroupSize do - if lid < workGroupSize / step then - let firstValue = localValues.[lid] - let secondValue = localValues.[lid + workGroupSize / step] + while step <= workGroupSize do + if lid < workGroupSize / step then + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + workGroupSize / step] - localValues.[lid] <- ((%opAdd) firstValue secondValue) + localValues.[lid] <- ((%opAdd) firstValue secondValue) - step <- step <<< 1 + step <- step <<< 1 - barrierLocal () + barrierLocal () - resultArray.[gid / workGroupSize] <- localValues.[0] - @> + resultArray.[gid / workGroupSize] <- localValues.[0] @> let kernel = clContext.Compile(scan) fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> - let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(valuesArray.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - valuesLength - valuesArray - resultArray) - ) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultArray) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -78,74 +71,59 @@ module Reduce = = let scan = - <@ - fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultCell: ClCell<'a>) -> + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultCell: ClCell<'a>) -> - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 - let localValues = localArray<'a> workGroupSize + let localValues = localArray<'a> workGroupSize - let i = (gid - lid) * 2 + lid + let i = (gid - lid) * 2 + lid - if i + workGroupSize < length then - localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] - elif i < length then - localValues.[lid] <- inputArray.[i] - else - localValues.[lid] <- zero + if i + workGroupSize < length then + localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] + elif i < length then + localValues.[lid] <- inputArray.[i] + else + localValues.[lid] <- zero - barrierLocal () + barrierLocal () - let mutable step = 2 + let mutable step = 2 - while step <= workGroupSize do - if lid < workGroupSize / step then - let firstValue = localValues.[lid] - let secondValue = localValues.[lid + workGroupSize / step] + while step <= workGroupSize do + if lid < workGroupSize / step then + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + workGroupSize / step] - localValues.[lid] <- (%opAdd) firstValue secondValue + localValues.[lid] <- (%opAdd) firstValue secondValue - step <- step <<< 1 + step <- step <<< 1 - barrierLocal () + barrierLocal () - resultCell.Value <- localValues.[0] - @> + resultCell.Value <- localValues.[0] @> let kernel = clContext.Compile(scan) fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength -> - let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(valuesArray.Length, workGroupSize) let resultCell = clContext.CreateClCell zero let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - valuesLength - valuesArray - resultCell) - ) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultCell)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) resultCell - let run<'a when 'a: struct> - (clContext: ClContext) - (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) - (zero: 'a) - = + let run<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) (zero: 'a) = - let scan = - scan clContext workGroupSize opAdd zero + let scan = scan clContext workGroupSize opAdd zero let scanToCell = scanToCell clContext workGroupSize opAdd zero @@ -154,7 +132,8 @@ module Reduce = let scan = scan processor - let firstLength = (inputArray.Length - 1) / workGroupSize + 1 + let firstLength = + (inputArray.Length - 1) / workGroupSize + 1 let firstVerticesArray = clContext.CreateClArray( @@ -191,7 +170,9 @@ module Reduce = verticesLength <- (verticesLength - 1) / workGroupSize + 1 let fstVertices = fst verticesArrays - let result = scanToCell processor fstVertices verticesLength + + let result = + scanToCell processor fstVertices verticesLength processor.Post(Msg.CreateFreeMsg(firstVerticesArray)) processor.Post(Msg.CreateFreeMsg(secondVerticesArray)) @@ -206,58 +187,51 @@ module Reduce = = let reduce = - <@ - fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 - let localValues = localArray<'a> workGroupSize + let localValues = localArray<'a> workGroupSize - if gid < length then - localValues.[lid] <- inputArray.[gid] - else - localValues.[lid] <- zero + if gid < length then + localValues.[lid] <- inputArray.[gid] + else + localValues.[lid] <- zero - barrierLocal () + barrierLocal () - let mutable step = 2 + let mutable step = 2 - while step <= workGroupSize do - if lid < workGroupSize / step then - let firstValue = localValues.[lid] - let secondValue = localValues.[lid + workGroupSize / step] + while step <= workGroupSize do + if lid < workGroupSize / step then + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + workGroupSize / step] - localValues.[lid] <- (%opAdd) firstValue secondValue + localValues.[lid] <- (%opAdd) firstValue secondValue - step <- step <<< 1 + step <- step <<< 1 - barrierLocal () + barrierLocal () - if lid = 0 then - atomic %opAdd totalSum.Value localValues.[0] |> ignore - @> + if lid = 0 then + atomic %opAdd totalSum.Value localValues.[0] + |> ignore @> let kernel = clContext.Compile(reduce) fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) -> - let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(valuesArray.Length, workGroupSize) - let totalSum = - clContext.CreateClCell(zero) + let totalSum = clContext.CreateClCell(zero) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - valuesArray.Length - valuesArray - totalSum) - ) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesArray.Length valuesArray totalSum) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index d6aca676..8e7fba41 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -96,13 +96,8 @@ module StandardOperations = let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f let mask<'a when 'a: struct> = - <@ - fun (value: AtLeastOne<'a, 'a>) -> - match value with - | Both (_, right) -> - Some right - | Left left -> - Some left - | Right right -> - Some right - @> + <@ fun (value: AtLeastOne<'a, 'a>) -> + match value with + | Both (_, right) -> Some right + | Left left -> Some left + | Right right -> Some right @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index e100ce12..ab8f7b39 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -10,120 +10,118 @@ module COOVector = let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = 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) -> + <@ 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 i = ndRange.GlobalID0 - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 - if localID < 2 then - let mutable x = localID * (workGroupSize - 1) + i - 1 + if localID < 2 then + let mutable x = localID * (workGroupSize - 1) + i - 1 - if x >= sumOfSides then - x <- sumOfSides - 1 + if x >= sumOfSides then + x <- sumOfSides - 1 - let diagonalNumber = x + let diagonalNumber = x - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 + let mutable leftEdge = diagonalNumber + 1 - secondSide + if leftEdge < 0 then leftEdge <- 0 - let mutable rightEdge = firstSide - 1 + let mutable rightEdge = firstSide - 1 - if rightEdge > diagonalNumber then - rightEdge <- diagonalNumber + if rightEdge > diagonalNumber then + rightEdge <- diagonalNumber - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = firstIndicesBuffer.[middleIdx] - let secondIndex = - secondIndicesBuffer.[diagonalNumber - 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 + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 else - endIdxLocal <- leftEdge + rightEdge <- middleIdx - 1 - barrierLocal () + // Here localID equals either 0 or 1 + if localID = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength + barrierLocal () - if endIdx = firstSide then - x <- secondSide - i + localID + beginIdx + let beginIdx = beginIdxLocal + let endIdx = endIdxLocal + let firstLocalLength = endIdx - beginIdx + let mutable x = workGroupSize - firstLocalLength - let secondLocalLength = x + if endIdx = firstSide then + x <- secondSide - i + localID + beginIdx - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize + let secondLocalLength = x - if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] + //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 < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] + if localID < firstLocalLength then + localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] - barrierLocal () + if localID < secondLocalLength then + localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 + barrierLocal () - let mutable rightEdge = firstLocalLength - 1 + if i < sumOfSides then + let mutable leftEdge = localID + 1 - secondLocalLength + if leftEdge < 0 then leftEdge <- 0 - if rightEdge > localID then - rightEdge <- localID + let mutable rightEdge = firstLocalLength - 1 - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] + if rightEdge > localID then + rightEdge <- localID - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 + let secondIndex = + localIndices.[firstLocalLength + localID - middleIdx] - let boundaryX = rightEdge - let boundaryY = localID - leftEdge + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 - // 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 boundaryX = rightEdge + let boundaryY = localID - leftEdge - let mutable fstIdx = 0 + // 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 isValidX then - fstIdx <- localIndices.[boundaryX] + let mutable fstIdx = 0 - let mutable sndIdx = 0 + if isValidX then + fstIdx <- localIndices.[boundaryX] - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] + let mutable sndIdx = 0 - 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 - @> + 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) @@ -133,7 +131,8 @@ module COOVector = let secondSide = secondIndices.Length - let sumOfSides = firstIndices.Length + secondIndices.Length + let sumOfSides = + firstIndices.Length + secondIndices.Length let allIndices = clContext.CreateClArray( @@ -167,13 +166,14 @@ module COOVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(sumOfSides, workGroupSize) + let ndRange = + Range1D.CreateValid(sumOfSides, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange firstSide @@ -200,36 +200,35 @@ module COOVector = = let preparePositions = - <@ - 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 - positions.[gid] <- 0 - - match (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) with + <@ 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 + positions.[gid] <- 0 + + match (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) with + | Some value -> + allValues.[gid + 1] <- value + positions.[gid + 1] <- 1 + | None -> positions.[gid + 1] <- 0 + elif (gid < length + && gid > 0 + && allIndices.[gid - 1] <> allIndices.[gid]) + || gid = 0 then + if isLeft.[gid] = 1 then + match (%opAdd) (Left(leftValues.[gid])) with | Some value -> - allValues.[gid + 1] <- value - positions.[gid + 1] <- 1 - | None -> - positions.[gid + 1] <- 0 - elif (gid < length && gid > 0 && allIndices.[gid - 1] <> allIndices.[gid]) || gid = 0 then - if isLeft.[gid] = 1 then - match (%opAdd) (Left(leftValues.[gid])) with - | Some value -> - allValues.[gid] <- value - positions.[gid] <- 1 - | None -> - positions.[gid] <- 0 - else - match (%opAdd) (Right(rightValues.[gid])) with - | Some value -> - allValues.[gid] <- value - positions.[gid] <- 1 - | None -> - positions.[gid] <- 0 - @> + allValues.[gid] <- value + positions.[gid] <- 1 + | None -> positions.[gid] <- 0 + else + match (%opAdd) (Right(rightValues.[gid])) with + | Some value -> + allValues.[gid] <- value + positions.[gid] <- 1 + | None -> positions.[gid] <- 0 @> let kernel = clContext.Compile(preparePositions) @@ -253,23 +252,16 @@ module COOVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(length, workGroupSize) + 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) - ) + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -278,20 +270,17 @@ module COOVector = let private setPositions<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let setPositions = - <@ - fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> + <@ fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> - let i = ndRange.GlobalID0 + let i = ndRange.GlobalID0 - if i = prefixSumArrayLength - 1 - || i < prefixSumArrayLength - && prefixSumBuffer.[i] - <> prefixSumBuffer.[i + 1] then - let index = prefixSumBuffer.[i] + if i = prefixSumArrayLength - 1 + || i < prefixSumArrayLength + && prefixSumBuffer.[i] <> prefixSumBuffer.[i + 1] then + let index = prefixSumBuffer.[i] - resultValues.[index] <- allValues.[i] - resultIndices.[index] <- allIndices.[i] - @> + resultValues.[index] <- allValues.[i] + resultIndices.[index] <- allIndices.[i] @> let kernel = clContext.Compile(setPositions) @@ -332,7 +321,8 @@ module COOVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(prefixSumArrayLength, workGroupSize) + let ndRange = + Range1D.CreateValid(prefixSumArrayLength, workGroupSize) let kernel = kernel.GetKernel() @@ -347,7 +337,7 @@ module COOVector = positions resultValues resultIndices) - ) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -364,38 +354,25 @@ module COOVector = let merge = merge clContext workGroupSize - let prepare = preparePositionsAtLeasOne clContext opAdd workGroupSize + let prepare = + preparePositionsAtLeasOne clContext opAdd workGroupSize let setPositions = setPositions clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClCooVector<'a>) (rightVector: ClCooVector<'b>) -> let allIndices, leftValues, rightValues, isLeft = - merge - processor - leftVector.Indices - leftVector.Values - rightVector.Indices - rightVector.Values + merge processor leftVector.Indices leftVector.Values rightVector.Indices rightVector.Values let allValues, positions = - prepare - processor - allIndices - leftValues - rightValues - isLeft + 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 - allValues - allIndices - positions + setPositions processor allValues allIndices positions processor.Post(Msg.CreateFreeMsg<_>(allIndices)) processor.Post(Msg.CreateFreeMsg<_>(allValues)) @@ -429,7 +406,8 @@ module COOVector = Values = maskValues Size = rightVector.Size } - let res = eWiseAdd processor leftVector rightVector + let res = + eWiseAdd processor leftVector rightVector processor.Post(Msg.CreateFreeMsg(maskValues)) processor.Post(Msg.CreateFreeMsg(maskIndices)) @@ -439,38 +417,31 @@ module COOVector = let preparePositionsComplemented (clContext: ClContext) (workGroupSize: int) = let preparePositions = - <@ - fun (ndRange: Range1D) indicesArrayLength (inputIndices: ClArray) (positions: ClArray) -> + <@ fun (ndRange: Range1D) indicesArrayLength (inputIndices: ClArray) (positions: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < indicesArrayLength then - let index = inputIndices.[gid] + if gid < indicesArrayLength then + let index = inputIndices.[gid] - positions.[index] <- 0 - @> + positions.[index] <- 0 @> let kernel = clContext.Compile(preparePositions) - let creat = ClArray.create clContext workGroupSize + let creat = ClArray.create clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputIndices: ClArray) (vectorSize: int) -> let positions = creat processor vectorSize 1 - let ndRange = Range1D.CreateValid(inputIndices.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(inputIndices.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - inputIndices.Length - inputIndices - positions) - ) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputIndices.Length inputIndices positions) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -479,23 +450,21 @@ module COOVector = let setPositionsComplemented (clContext: ClContext) (workGroupSize: int) = let setPositions = - <@ - fun (ndRange: Range1D) length (positions: ClArray) (resultIndices: ClArray) -> + <@ fun (ndRange: Range1D) length (positions: ClArray) (resultIndices: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid = length - 1 - || gid < length - && positions.[gid] - <> positions.[gid + 1] then - let index = positions.[gid] + if gid = length - 1 + || gid < length + && positions.[gid] <> positions.[gid + 1] then + let index = positions.[gid] - resultIndices.[index] <- gid - @> + resultIndices.[index] <- gid @> let kernel = clContext.Compile(setPositions) - let sum = ClArray.prefixSumExcludeInplace clContext workGroupSize + let sum = + ClArray.prefixSumExcludeInplace clContext workGroupSize let resultLength = Array.zeroCreate 1 @@ -523,19 +492,14 @@ module COOVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(prefixArrayLenght, workGroupSize) + let ndRange = + Range1D.CreateValid(prefixArrayLenght, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - prefixArrayLenght - positions - resultIndices) - ) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange prefixArrayLenght positions resultIndices) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -570,14 +534,9 @@ module COOVector = Values = ResultValues Size = vector.Size } - let reduce<'a when 'a: struct> - (clContext: ClContext) - (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) - zero - = + let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) zero = - let reduce = Reduce.run clContext workGroupSize opAdd zero + let reduce = + Reduce.run clContext workGroupSize opAdd zero - fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> - reduce processor vector.Values + fun (processor: MailboxProcessor<_>) (vector: ClCooVector<'a>) -> reduce processor vector.Values diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 4890a748..cdf3c436 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -6,24 +6,17 @@ open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Quotations module DenseVector = - let private maskWithValue<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) - (workGroupSize: int) - = + let private maskWithValue<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = let fillVector = - <@ - fun (ndRange: Range1D) length (maskArray: ClArray<'a option>) (scalar: ClCell<'b>) (resultArray: ClArray<'b option>)-> + <@ fun (ndRange: Range1D) length (maskArray: ClArray<'a option>) (scalar: ClCell<'b>) (resultArray: ClArray<'b option>) -> let gid = ndRange.GlobalID0 if gid < length then match maskArray.[gid] with - | Some _ -> - resultArray.[gid] <- Some scalar.Value - | None -> - resultArray.[gid] <- None - @> + | Some _ -> resultArray.[gid] <- Some scalar.Value + | None -> resultArray.[gid] <- None @> let kernel = clContext.Compile(fillVector) @@ -37,20 +30,15 @@ module DenseVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(maskVector.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(maskVector.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - maskVector.Length - maskVector - scalarCell - resultArray) - ) + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange maskVector.Length maskVector scalarCell resultArray) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -63,38 +51,31 @@ module DenseVector = = let eWiseAdd = - <@ - fun (ndRange: Range1D) leftVectorLength rightVectorLength resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + <@ fun (ndRange: Range1D) leftVectorLength rightVectorLength resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - let mutable leftItem = None - let mutable rightItem = None + let mutable leftItem = None + let mutable rightItem = None - if gid < leftVectorLength then + if gid < leftVectorLength then leftItem <- leftVector.[gid] - if gid < rightVectorLength then + if gid < rightVectorLength then rightItem <- rightVector.[gid] - if gid < resultLength then - match leftItem, rightItem with - | Some left, Some right -> - resultVector.[gid] <- (%opAdd) (Both (left, right)) - | Some left, None -> - resultVector.[gid] <- (%opAdd) (Left left) - | None, Some right -> - resultVector.[gid] <- (%opAdd) (Right right) - | None, None -> - resultVector.[gid] <- None - @> + if gid < resultLength then + match leftItem, rightItem with + | Some left, Some right -> resultVector.[gid] <- (%opAdd) (Both(left, right)) + | Some left, None -> resultVector.[gid] <- (%opAdd) (Left left) + | None, Some right -> resultVector.[gid] <- (%opAdd) (Right right) + | None, None -> resultVector.[gid] <- None @> let kernel = clContext.Compile(eWiseAdd) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> - let resultLength = - max leftVector.Length rightVector.Length + let resultLength = max leftVector.Length rightVector.Length let resultVector = clContext.CreateClArray( @@ -110,8 +91,8 @@ module DenseVector = let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange leftVector.Length @@ -120,7 +101,7 @@ module DenseVector = leftVector rightVector resultVector) - ) + ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -135,38 +116,36 @@ module DenseVector = fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (scalar: 'a) -> - let clScalar = clContext.CreateClCell scalar + let clScalar = clContext.CreateClCell scalar - let maskVector = copyWithValue processor maskVector clScalar + let maskVector = + copyWithValue processor maskVector clScalar - let resultVector = - eWiseAdd processor leftVector maskVector + let resultVector = eWiseAdd processor leftVector maskVector - processor.Post(Msg.CreateFreeMsg<_>(maskVector)) + processor.Post(Msg.CreateFreeMsg<_>(maskVector)) - processor.Post(Msg.CreateFreeMsg<_>(clScalar)) + processor.Post(Msg.CreateFreeMsg<_>(clScalar)) - resultVector + resultVector let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let complemented = - <@ - fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (defaultValue: ClCell<'a>) (resultArray: ClArray<'a option>) -> + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (defaultValue: ClCell<'a>) (resultArray: ClArray<'a option>) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < length then - match inputArray.[gid] with - | None -> - resultArray.[gid] <- Some defaultValue.Value - | _ -> () - @> + if gid < length then + match inputArray.[gid] with + | None -> resultArray.[gid] <- Some defaultValue.Value + | _ -> () @> let kernel = clContext.Compile(complemented) - let create = ClArray.zeroCreate clContext workGroupSize + let create = + ClArray.zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> @@ -177,20 +156,14 @@ module DenseVector = let defaultValue = clContext.CreateClCell Unchecked.defaultof<'a> - let ndRange = Range1D.CreateValid(length, workGroupSize) + let ndRange = + Range1D.CreateValid(length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - length - vector - defaultValue - resultArray) - ) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange length vector defaultValue resultArray) + ) processor.Post(Msg.CreateRunMsg(kernel)) @@ -201,18 +174,14 @@ module DenseVector = let getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let getPositions = - <@ - fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray) -> + <@ fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < length then - match vector.[gid] with - | Some _ -> - positions.[gid] <- 1 - | None -> - positions.[gid] <- 0 - @> + if gid < length then + match vector.[gid] with + | Some _ -> positions.[gid] <- 1 + | None -> positions.[gid] <- 0 @> let kernel = clContext.Compile(getPositions) @@ -226,18 +195,12 @@ module DenseVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(vector.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - vector.Length - vector - positions)) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange vector.Length vector positions)) processor.Post(Msg.CreateRunMsg(kernel)) @@ -246,26 +209,25 @@ module DenseVector = let getValuesAndIndices<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let unzip = - <@ - fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (positions: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> + <@ fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (positions: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid = length - 1 || gid < length && positions.[gid] <> positions.[gid + 1] then - let index = positions.[gid] + if gid = length - 1 + || gid < length + && positions.[gid] <> positions.[gid + 1] then + let index = positions.[gid] - match denseVector.[gid] with - | Some value -> - resultValues.[index] <- value - resultIndices.[index] <- gid - | None -> () - @> + match denseVector.[gid] with + | Some value -> + resultValues.[index] <- value + resultIndices.[index] <- gid + | None -> () @> let kernel = clContext.Compile(unzip) - let getPositions = - getBitmap clContext workGroupSize + let getPositions = getBitmap clContext workGroupSize let prefixSum = ClArray.prefixSumExcludeInplace clContext workGroupSize @@ -278,7 +240,8 @@ module DenseVector = let resultLengthGpu = clContext.CreateClCell 0 - let _, r = prefixSum processor positions resultLengthGpu + let _, r = + prefixSum processor positions resultLengthGpu let resultLength = let res = @@ -304,21 +267,15 @@ module DenseVector = allocationMode = AllocationMode.Default ) - let ndRange = Range1D.CreateValid(vector.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(vector.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments( - fun () -> - kernel.KernelFunc - ndRange - vector.Length - vector - positions - resultValues - resultIndices) - ) + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange vector.Length vector positions resultValues resultIndices) + ) processor.Post(Msg.CreateRunMsg(kernel)) @@ -328,7 +285,8 @@ module DenseVector = let toCoo<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let getValuesAndIndices = getValuesAndIndices clContext workGroupSize + let getValuesAndIndices = + getValuesAndIndices clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> @@ -339,14 +297,10 @@ module DenseVector = Values = values Size = vector.Length } - let reduce<'a when 'a: struct> - (clContext: ClContext) - (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) - zero - = + let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) zero = - let getValuesAndIndices = getValuesAndIndices clContext workGroupSize + let getValuesAndIndices = + getValuesAndIndices clContext workGroupSize let reduce = Reduce.run clContext workGroupSize opAdd zero diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index a7a9e80e..b07b7217 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -9,7 +9,8 @@ open GraphBLAS.FSharp.Backend.Common module Vector = let zeroCreate (clContext: ClContext) (workGroupSize: int) = - let denseZeroCreate = ClArray.zeroCreate clContext workGroupSize + let denseZeroCreate = + ClArray.zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (size: int) (format: VectorFormat) -> match format with @@ -21,12 +22,12 @@ module Vector = Size = 0 } ClVectorCOO vector - | Dense -> - ClVectorDense <| denseZeroCreate processor size + | Dense -> ClVectorDense <| denseZeroCreate processor size let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = - let toOptionArray = ClArray.toOptionArray clContext workGroupSize + let toOptionArray = + ClArray.toOptionArray clContext workGroupSize let indices, values = elements @@ -43,10 +44,10 @@ module Vector = match format with | COO -> let vector = - { ClCooVector.Context = clContext - Indices = clIndices - Values = clValues - Size = resultLenght } + { ClCooVector.Context = clContext + Indices = clIndices + Values = clValues + Size = resultLenght } ClVectorCOO vector | Dense -> @@ -54,47 +55,38 @@ module Vector = <| toOptionArray processor clValues clIndices resultLenght let copy (clContext: ClContext) (workGroupSize: int) = - let copy = - ClArray.copy clContext workGroupSize + let copy = ClArray.copy clContext workGroupSize - let copyData = - ClArray.copy clContext workGroupSize + let copyData = ClArray.copy clContext workGroupSize - let copyOptionData = - ClArray.copy clContext workGroupSize + let copyOptionData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> - match vector with - | ClVectorCOO vector -> - let vector = - { ClCooVector.Context = clContext - Indices = copy processor vector.Indices - Values = copyData processor vector.Values - Size = vector.Size } + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + match vector with + | ClVectorCOO vector -> + let vector = + { ClCooVector.Context = clContext + Indices = copy processor vector.Indices + Values = copyData processor vector.Values + Size = vector.Size } - ClVectorCOO vector - | ClVectorDense vector -> - ClVectorDense <| copyOptionData processor vector + ClVectorCOO vector + | ClVectorDense vector -> ClVectorDense <| copyOptionData processor vector let mask = copy let toCoo (clContext: ClContext) (workGroupSize: int) = - let toCoo = DenseVector.toCoo clContext workGroupSize + let toCoo = + DenseVector.toCoo clContext workGroupSize let copy = copy clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorDense vector -> - ClVectorCOO <| toCoo processor vector - | ClVectorCOO _ -> - copy processor vector + | ClVectorDense vector -> ClVectorCOO <| toCoo processor vector + | ClVectorCOO _ -> copy processor vector - let elementWiseAddAtLeastOne - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - workGroupSize - = + let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let addCoo = COOVector.elementWiseAddAtLeastOne clContext opAdd workGroupSize @@ -104,10 +96,8 @@ module Vector = fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with - | ClVectorCOO left, ClVectorCOO right -> - ClVectorCOO <| addCoo processor left right - | ClVectorDense left, ClVectorDense right -> - ClVectorDense <| addDense processor left right + | ClVectorCOO left, ClVectorCOO right -> ClVectorCOO <| addCoo processor left right + | ClVectorDense left, ClVectorDense right -> ClVectorDense <| addDense processor left right | _ -> failwith "Vector formats are not matching." let fillSubVector (clContext: ClContext) (workGroupSize: int) = //TODO() remove zero @@ -126,17 +116,21 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> match vector, maskVector with | ClVectorCOO vector, ClVectorCOO mask -> - ClVectorCOO <| cooFillVector processor vector mask value + ClVectorCOO + <| cooFillVector processor vector mask value | ClVectorCOO vector, ClVectorDense mask -> let mask = toCooMask processor mask - ClVectorCOO <| cooFillVector processor vector mask value + ClVectorCOO + <| cooFillVector processor vector mask value | ClVectorDense vector, ClVectorCOO mask -> let vector = toCooVector processor vector - ClVectorCOO <| cooFillVector processor vector mask value + ClVectorCOO + <| cooFillVector processor vector mask value | ClVectorDense vector, ClVectorDense mask -> - ClVectorDense <| denseFillVector processor vector mask value + ClVectorDense + <| denseFillVector processor vector mask value let complemented (clContext: ClContext) (workGroupSize: int) = let cooComplemented = @@ -147,10 +141,10 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorCOO vector -> - ClVectorCOO <| cooComplemented processor vector + | ClVectorCOO vector -> ClVectorCOO <| cooComplemented processor vector | ClVectorDense vector -> - ClVectorDense <| denseComplemented processor vector + ClVectorDense + <| denseComplemented processor vector let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) (zero: 'a) = let cooReduce = @@ -161,7 +155,5 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorCOO vector -> - cooReduce processor vector - | ClVectorDense vector -> - denseReduce processor vector + | ClVectorCOO vector -> cooReduce processor vector + | ClVectorDense vector -> denseReduce processor vector diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index e01e4c14..5425f385 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -27,18 +27,18 @@ let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> let total = reduce clArray let actualSum = [| zero |] + 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) ) - let expectedSum = - Array.fold plus zero array + let expectedSum = Array.fold plus zero array logger.debug ( eventX "Expected is {expected}\n" @@ -50,8 +50,7 @@ let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> let testFixtures config wgSize q plus plusQ zero isEqual filter name = - let reduce = - Reduce.run context wgSize plusQ + let reduce = Reduce.run context wgSize plusQ makeTest q reduce plus zero isEqual filter |> testPropertyWithConfig config (sprintf "Correctness on %s" name) diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 90081f37..026eea23 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -28,14 +28,14 @@ - - - - - - - - + + + + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index ba297a16..db7d525a 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -514,18 +514,15 @@ module Utils = |> List.collect (fun x -> secondList |> List.map (fun y -> x, y)) let testCases<'a> = - let avaliableCotextes = - avaliableContexts "" - |> List.ofSeq + let avaliableCotextes = avaliableContexts "" |> List.ofSeq - let listOfUnionCases = - listOfUnionCases<'a> - |> List.ofSeq + let listOfUnionCases = listOfUnionCases<'a> |> List.ofSeq cartesian avaliableCotextes listOfUnionCases - |> List.map (fun pair -> - { ClContext = fst pair - FormatCase = snd pair }) + |> List.map + (fun pair -> + { ClContext = fst pair + FormatCase = snd pair }) let createMatrixFromArray2D matrixCase array isZero = match matrixCase with @@ -535,7 +532,9 @@ module Utils = let createVectorFromArray vectorCase array isZero = match vectorCase with | VectorFormat.COO -> VectorCOO <| COOVector.FromArray(array, isZero) - | VectorFormat.Dense -> VectorDense <| ArraysExtensions.FromArray(array, isZero) + | VectorFormat.Dense -> + VectorDense + <| ArraysExtensions.FromArray(array, isZero) let compareArrays areEqual (actual: 'a []) (expected: 'a []) message = sprintf "%s. Lengths should be equal. Actual is %A, expected %A" message actual expected diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs similarity index 94% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs index ae4897d2..ed87bedb 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ComplementedTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs @@ -13,21 +13,17 @@ let NNZCountCount array isZero = |> Array.length let fFilter = - fun item -> System.Double.IsNaN item || System.Double.IsInfinity item + fun item -> + System.Double.IsNaN item + || System.Double.IsInfinity item >> not |> Array.filter -let checkResult - isEqual - zero - (actual: Vector<'a>) - (vector: 'a []) - = +let checkResult isEqual zero (actual: Vector<'a>) (vector: 'a []) = let expectedArrayLength = vector.Length - let expectedArray = - Array.create expectedArrayLength 1 + let expectedArray = Array.create expectedArrayLength 1 for i in 0 .. expectedArrayLength - 1 do if not <| isEqual vector.[i] zero then diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs similarity index 90% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs index c5048739..aa5c26fe 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ConvertTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs @@ -7,17 +7,13 @@ open GraphBLAS.FSharp.Tests.Utils open GraphBLAS.FSharp.Backend open OpenCL.Net -let logger = Log.create "Backend.Vector.Convert.Tests" +let logger = + Log.create "Backend.Vector.Convert.Tests" let config = defaultConfig let wgSize = 32 -let makeTestDense - isZero - context - q - (toCOO: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) - (array: 'a []) = +let makeTestDense isZero context q (toCOO: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (array: 'a []) = if array.Length > 0 then let vector = createVectorFromArray VectorFormat.Dense array isZero @@ -35,7 +31,8 @@ let makeTestDense >> setField "actual" (sprintf "%A" actual) ) - let expected = createVectorFromArray VectorFormat.COO array isZero + let expected = + createVectorFromArray VectorFormat.COO array isZero Expect.equal actual expected "Vectors must be the same" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs similarity index 91% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs index 195d9d8e..b269c81c 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/copyTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs @@ -18,14 +18,13 @@ let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vect | VectorDense actual, VectorDense expected -> let isEqual left right = match left, right with - | Some left, Some right -> - isEqual left right + | Some left, Some right -> isEqual left right | None, None -> true | _, _ -> false compareArrays isEqual actual expected "The values array must contain the default value" | VectorCOO actual, VectorCOO expected -> - compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" + compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" compareArrays (=) actual.Indices expected.Indices "The index array must contain the 0" | _, _ -> failwith "Copy format must be the same" @@ -62,7 +61,7 @@ let testFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + sprintf "Correctness on %s, %A" datatype case.FormatCase let wgSize = 32 let context = case.ClContext.ClContext @@ -96,7 +95,7 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let tests = - testCases + testCases |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures |> testList "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs similarity index 81% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs index b248ebce..764db5a5 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Tests.Utils open GraphBLAS.FSharp.Backend.Common open StandardOperations open OpenCL.Net + let logger = Log.create "Vector.zeroCreate.Tests" let NNZCountCount array isZero = @@ -15,7 +16,9 @@ let NNZCountCount array isZero = |> Array.length let fFilter = - fun item -> System.Double.IsNaN item || System.Double.IsInfinity item + fun item -> + System.Double.IsNaN item + || System.Double.IsInfinity item >> not |> Array.filter @@ -24,20 +27,21 @@ let checkResult leftZero rightZero resultZero - (op: 'a -> 'b -> 'c ) + (op: 'a -> 'b -> 'c) (actual: Vector<'c>) (leftArray: 'a []) (rightArray: 'b []) = - let expectedArrayLength = - max leftArray.Length rightArray.Length + let expectedArrayLength = max leftArray.Length rightArray.Length - let isLeftLess = - leftArray.Length < rightArray.Length + let isLeftLess = leftArray.Length < rightArray.Length let lowBound = - if isLeftLess then leftArray.Length else rightArray.Length + if isLeftLess then + leftArray.Length + else + rightArray.Length let expectedArray = Array.create expectedArrayLength resultZero @@ -45,7 +49,7 @@ let checkResult for i in 0 .. expectedArrayLength - 1 do let item = if i < lowBound then - op leftArray.[i] rightArray.[i] + op leftArray.[i] rightArray.[i] elif isLeftLess then op leftZero rightArray.[i] else @@ -55,7 +59,8 @@ let checkResult match actual with | VectorCOO actual -> - let actualArray = Array.create expectedArrayLength resultZero + let actualArray = + Array.create expectedArrayLength resultZero for i in 0 .. actual.Indices.Length - 1 do if isEqual actual.Values.[i] resultZero then @@ -120,8 +125,7 @@ let correctnessGenericTest checkResult resultIsEqual leftZero rightZero resultZero op actual leftArray rightArray with - | :? OpenCL.Net.Cl.Exception as ex -> - logger.debug ( eventX $"exception: {ex.Message}") + | :? OpenCL.Net.Cl.Exception as ex -> logger.debug (eventX $"exception: {ex.Message}") let addTestFixtures case = let config = defaultConfig @@ -134,7 +138,8 @@ let addTestFixtures case = [ let toCoo = Vector.toCoo context wgSize - let intAddFun = Vector.elementWiseAddAtLeastOne context intSumAtLeastOne wgSize + let intAddFun = + Vector.elementWiseAddAtLeastOne context intSumAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo id id @@ -142,9 +147,11 @@ let addTestFixtures case = let toFloatCoo = Vector.toCoo context wgSize - let floatAddFun = Vector.elementWiseAddAtLeastOne context floatSumAtLeastOne wgSize + let floatAddFun = + Vector.elementWiseAddAtLeastOne context floatSumAtLeastOne wgSize - let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y + let fIsEqual = + fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y case |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun toFloatCoo fFilter fFilter @@ -152,7 +159,8 @@ let addTestFixtures case = let boolToCoo = Vector.toCoo context wgSize - let boolAddFun = Vector.elementWiseAddAtLeastOne context boolSumAtLeastOne wgSize + let boolAddFun = + Vector.elementWiseAddAtLeastOne context boolSumAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo id id @@ -160,7 +168,8 @@ let addTestFixtures case = let byteToCoo = Vector.toCoo context wgSize - let byteAddFun = Vector.elementWiseAddAtLeastOne context byteSumAtLeastOne wgSize + let byteAddFun = + Vector.elementWiseAddAtLeastOne context byteSumAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo id id @@ -195,7 +204,8 @@ let mulTestFixtures case = [ let toCoo = Vector.toCoo context wgSize - let intMulFun = Vector.elementWiseAddAtLeastOne context intMulAtLeastOne wgSize + let intMulFun = + Vector.elementWiseAddAtLeastOne context intMulAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo id id @@ -203,9 +213,11 @@ let mulTestFixtures case = let toFloatCoo = Vector.toCoo context wgSize - let floatMulFun = Vector.elementWiseAddAtLeastOne context floatMulAtLeastOne wgSize + let floatMulFun = + Vector.elementWiseAddAtLeastOne context floatMulAtLeastOne wgSize - let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y + let fIsEqual = + fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y case |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun toFloatCoo fFilter fFilter @@ -213,7 +225,8 @@ let mulTestFixtures case = let boolToCoo = Vector.toCoo context wgSize - let boolMulFun = Vector.elementWiseAddAtLeastOne context boolMulAtLeastOne wgSize + let boolMulFun = + Vector.elementWiseAddAtLeastOne context boolMulAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo id id @@ -221,7 +234,8 @@ let mulTestFixtures case = let byteToCoo = Vector.toCoo context wgSize - let byteMulFun = Vector.elementWiseAddAtLeastOne context byteMulAtLeastOne wgSize + let byteMulFun = + Vector.elementWiseAddAtLeastOne context byteMulAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo id id diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs similarity index 91% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs index cb747aa6..b243cb3e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/fillSubVectorTest.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs @@ -17,7 +17,9 @@ let NNZCountCount array isZero = |> Array.length let fFilter = - fun item -> System.Double.IsNaN item || System.Double.IsInfinity item + fun item -> + System.Double.IsNaN item + || System.Double.IsInfinity item >> not |> Array.filter @@ -38,14 +40,16 @@ let checkResult Array.create expectedArrayLength vectorZero for i in 0 .. expectedArrayLength - 1 do - if i < mask.Length && not <| maskIsEqual mask.[i] maskZero then + if i < mask.Length + && not <| maskIsEqual mask.[i] maskZero then expectedArray.[i] <- value elif i < vector.Length then expectedArray.[i] <- vector.[i] match actual with | VectorCOO actual -> - let actualArray = Array.create expectedArrayLength vectorZero + let actualArray = + Array.create expectedArrayLength vectorZero for i in 0 .. actual.Indices.Length - 1 do actualArray.[actual.Indices.[i]] <- actual.Values.[i] @@ -95,11 +99,9 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> let maskVector = createVectorFromArray maskFormat mask (maskIsEqual maskZero) - let clLeftVector = - leftVector.ToDevice context + let clLeftVector = leftVector.ToDevice context - let clMaskVector = - maskVector.ToDevice context + let clMaskVector = maskVector.ToDevice context try let clActual = @@ -116,14 +118,13 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> checkResult vectorIsZero maskIsEqual vectorZero maskZero actual vector mask value with - | :? OpenCL.Net.Cl.Exception as ex -> - logger.debug ( eventX $"exception: {ex.Message}") + | :? OpenCL.Net.Cl.Exception as ex -> logger.debug (eventX $"exception: {ex.Message}") let testFixtures case = let config = defaultConfig let getCorrectnessTestName datatype maskFormat = - $"Correctness on %s{datatype}, vector: %A{case.FormatCase}, mask: %s{maskFormat}" + $"Correctness on %s{datatype}, vector: %A{case.FormatCase}, mask: %s{maskFormat}" let wgSize = 32 let context = case.ClContext.ClContext @@ -196,7 +197,7 @@ let testFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] let tests = - testCases + testCases |> List.filter (fun case -> let mutable e = ErrorCode.Unknown diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs similarity index 92% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index 4d4353a2..ae498f94 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ofListTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -15,12 +15,7 @@ let filter elements = <| elements |> List.distinctBy fst -let checkResult - (isEqual: 'a -> 'a -> bool) - (expectedIndices: int []) - (expectedValues: 'a []) - (actual: Vector<'a>) - = +let checkResult (isEqual: 'a -> 'a -> bool) (expectedIndices: int []) (expectedValues: 'a []) (actual: Vector<'a>) = Expect.equal actual.Size (Array.max expectedIndices + 1) "lengths must be the same" @@ -50,8 +45,7 @@ let correctnessGenericTest<'a when 'a: struct> |> Array.sortBy fst |> Array.unzip - let clActual = - ofList elements q case.FormatCase + let clActual = ofList elements q case.FormatCase let clCooActual = toCoo q clActual @@ -73,7 +67,7 @@ let testFixtures (case: OperationCase) = q.Error.Add(fun e -> failwithf $"%A{e}") let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + sprintf "Correctness on %s, %A" datatype case.FormatCase let boolOfList = Vector.ofList context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/ReduceTests.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs similarity index 99% rename from tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs rename to tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs index ba58fa72..e7f134bc 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperationsTests/zeroCreateTests.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs @@ -78,7 +78,7 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] let tests = - testCases + testCases |> List.filter (fun case -> let mutable e = ErrorCode.Unknown From ce4a41cd5ba5fa82a1a2523997e2bcbe55905b70 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 01:20:29 +0300 Subject: [PATCH 41/74] fix: formatting --- .../VectorOperations/Reduce.fs | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs index b5395901..4229070b 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs @@ -15,15 +15,9 @@ let zeroFilter array isZero = <| (fun item -> not <| isZero item) <| array -let checkResult - zero - op - (actual: 'a) - (vector: 'a []) - = +let checkResult zero op (actual: 'a) (vector: 'a []) = - let expected = - Array.fold op zero vector + let expected = Array.fold op zero vector "Results should be the same" |> Expect.equal actual expected @@ -33,7 +27,7 @@ let correctnessGenericTest zero op opQ - (reduce: Expr<'a -> 'a -> 'a> -> 'a -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) + (reduce: Expr<'a -> 'a -> 'a> -> 'a -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) filter case (array: 'a []) @@ -41,14 +35,14 @@ let correctnessGenericTest let array = filter array - let filteredArray = - zeroFilter array (isEqual zero) + let filteredArray = zeroFilter array (isEqual zero) if filteredArray.Length > 0 then let q = case.ClContext.Queue let context = case.ClContext.ClContext - let vector = createVectorFromArray case.FormatCase array (isEqual zero) + let vector = + createVectorFromArray case.FormatCase array (isEqual zero) let clVector = vector.ToDevice context From a867ff05ca9ef92161cd428582fd96ebcb96da8c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 01:24:35 +0300 Subject: [PATCH 42/74] fix: fantomas formatting --- tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index 5425f385..68e1521e 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -31,7 +31,7 @@ let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> let sum = q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) - sum [ 0 ] + sum.[ 0 ] logger.debug ( eventX "Actual is {actual}\n" From cf235bed1c8ee1ed7bee3eeb3061b3a6082e80f2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 01:28:58 +0300 Subject: [PATCH 43/74] fix: fantomas formatting --- tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index 68e1521e..26a60cc7 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -31,7 +31,7 @@ let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> let sum = q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) - sum.[ 0 ] + sum.[0] logger.debug ( eventX "Actual is {actual}\n" From 126e9254d5e18460de0681eba8ab1c4ba19706cf Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 12:36:02 +0300 Subject: [PATCH 44/74] build pass locally --- .../Common/StandardOperations.fs | 2 +- .../GraphBLAS-sharp.Backend.fsproj | 2 - .../Vector/COOVector/COOVector.fs | 2 +- .../Vector/DenseVector/DenseVector.fs | 2 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 40 +++++++++---------- .../MatrixElementwiseTests.fs | 2 +- .../VectorOperations/Complemented.fs | 10 ++--- .../VectorOperations/Convert.fs | 2 +- .../VectorOperations/Copy.fs | 4 +- .../VectorOperations/ElementWiseAtLeastOne.fs | 9 +++-- .../VectorOperations/FillSubVector.fs | 20 +++++----- .../VectorOperations/OfList.fs | 4 +- .../VectorOperations/Reduce.fs | 2 +- .../VectorOperations/ZeroCreate.fs | 2 +- 14 files changed, 51 insertions(+), 52 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 8e7fba41..0c8085a2 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -95,7 +95,7 @@ module StandardOperations = let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f - let mask<'a when 'a: struct> = + let maskAtLeastOne<'a when 'a: struct> = <@ fun (value: AtLeastOne<'a, 'a>) -> match value with | Both (_, right) -> Some right diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 802b695e..94a9c808 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -29,8 +29,6 @@ - - diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index 02704697..f6f24ea9 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -391,7 +391,7 @@ module COOVector = let create = ClArray.create clContext workGroupSize let eWiseAdd = - elementWiseAddAtLeastOne clContext StandardOperations.mask workGroupSize + elementWiseAddAtLeastOne clContext StandardOperations.maskAtLeastOne workGroupSize let copy = ClArray.copy clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 49b1ffb5..7b28a7e6 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -110,7 +110,7 @@ module DenseVector = let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = //zero let eWiseAdd = - elementWiseAddAtLeasOne clContext StandardOperations.mask workGroupSize + elementWiseAddAtLeasOne clContext StandardOperations.maskAtLeastOne workGroupSize let copyWithValue = maskWithValue clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index b07b7217..ba9dc4e2 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -14,14 +14,14 @@ module Vector = fun (processor: MailboxProcessor<_>) (size: int) (format: VectorFormat) -> match format with - | COO -> + | Sparse -> let vector = - { ClCooVector.Context = clContext + { Context = clContext Indices = clContext.CreateClArray [| 0 |] Values = clContext.CreateClArray<'a> [| Unchecked.defaultof<'a> |] Size = 0 } - ClVectorCOO vector + ClVectorSparse vector | Dense -> ClVectorDense <| denseZeroCreate processor size let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = @@ -42,14 +42,14 @@ module Vector = fun (processor: MailboxProcessor<_>) (format: VectorFormat) -> match format with - | COO -> + | Sparse -> let vector = - { ClCooVector.Context = clContext + { Context = clContext Indices = clIndices Values = clValues Size = resultLenght } - ClVectorCOO vector + ClVectorSparse vector | Dense -> ClVectorDense <| toOptionArray processor clValues clIndices resultLenght @@ -63,14 +63,14 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorCOO vector -> + | ClVectorSparse vector -> let vector = - { ClCooVector.Context = clContext + { Context = clContext Indices = copy processor vector.Indices Values = copyData processor vector.Values Size = vector.Size } - ClVectorCOO vector + ClVectorSparse vector | ClVectorDense vector -> ClVectorDense <| copyOptionData processor vector let mask = copy @@ -83,8 +83,8 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorDense vector -> ClVectorCOO <| toCoo processor vector - | ClVectorCOO _ -> copy processor vector + | ClVectorDense vector -> ClVectorSparse <| toCoo processor vector + | ClVectorSparse _ -> copy processor vector let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = @@ -96,7 +96,7 @@ module Vector = fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with - | ClVectorCOO left, ClVectorCOO right -> ClVectorCOO <| addCoo processor left right + | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addCoo processor left right | ClVectorDense left, ClVectorDense right -> ClVectorDense <| addDense processor left right | _ -> failwith "Vector formats are not matching." @@ -115,18 +115,18 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> match vector, maskVector with - | ClVectorCOO vector, ClVectorCOO mask -> - ClVectorCOO + | ClVectorSparse vector, ClVectorSparse mask -> + ClVectorSparse <| cooFillVector processor vector mask value - | ClVectorCOO vector, ClVectorDense mask -> + | ClVectorSparse vector, ClVectorDense mask -> let mask = toCooMask processor mask - ClVectorCOO + ClVectorSparse <| cooFillVector processor vector mask value - | ClVectorDense vector, ClVectorCOO mask -> + | ClVectorDense vector, ClVectorSparse mask -> let vector = toCooVector processor vector - ClVectorCOO + ClVectorSparse <| cooFillVector processor vector mask value | ClVectorDense vector, ClVectorDense mask -> ClVectorDense @@ -141,7 +141,7 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorCOO vector -> ClVectorCOO <| cooComplemented processor vector + | ClVectorSparse vector -> ClVectorSparse <| cooComplemented processor vector | ClVectorDense vector -> ClVectorDense <| denseComplemented processor vector @@ -155,5 +155,5 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorCOO vector -> cooReduce processor vector + | ClVectorSparse vector -> cooReduce processor vector | ClVectorDense vector -> denseReduce processor vector diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs index 7586b8d2..973cd34e 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs @@ -275,7 +275,7 @@ let elementwiseAddAtLeastOneToCOOTests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.MatrixCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixturesEWiseAddAtLeastOneToCOO |> testList "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs index ed87bedb..fcb70c4c 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs @@ -6,7 +6,7 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils open OpenCL.Net -let logger = Log.create "Vector.fillSubVector.Tests" +let logger = Log.create "Vector.complemented.Tests" let NNZCountCount array isZero = Array.filter (fun item -> not <| isZero item) array @@ -30,15 +30,15 @@ let checkResult isEqual zero (actual: Vector<'a>) (vector: 'a []) = expectedArray.[i] <- 0 match actual with - | VectorCOO actual -> + | VectorSparse actual -> let actualArray = Array.create expectedArrayLength 0 for i in 0 .. actual.Indices.Length - 1 do actualArray.[actual.Indices.[i]] <- 1 - $"arrays must have the same values and length, actual = %A{actualArray}, expected = %A{expectedArray}" + $"arrays must have the same values and length" |> compareArrays (=) actualArray expectedArray - | _ -> failwith "Vector format must be COO." + | _ -> failwith "Vector format must be Sparse." let correctnessGenericTest isEqual @@ -133,4 +133,4 @@ let tests = deviceType = DeviceType.Gpu) |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) |> List.collect testFixtures - |> testList "Backend.Vector.fillSubVector tests" + |> testList "Backend.Vector.complemented tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs index aa5c26fe..8ae2f1ed 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs @@ -32,7 +32,7 @@ let makeTestDense isZero context q (toCOO: MailboxProcessor<_> -> ClVector<'a> - ) let expected = - createVectorFromArray VectorFormat.COO array isZero + createVectorFromArray VectorFormat.Sparse array isZero Expect.equal actual expected "Vectors must be the same" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs index b269c81c..ab12c54f 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs @@ -6,7 +6,7 @@ open Expecto.Logging open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests.Utils -let logger = Log.create "Vector.zeroCreate.Tests" +let logger = Log.create "Vector.copy.Tests" let clContext = defaultContext.ClContext @@ -23,7 +23,7 @@ let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vect | _, _ -> false compareArrays isEqual actual expected "The values array must contain the default value" - | VectorCOO actual, VectorCOO expected -> + | VectorSparse actual, VectorSparse expected -> compareArrays isEqual actual.Values expected.Values "The values array must contain the default value" compareArrays (=) actual.Indices expected.Indices "The index array must contain the 0" | _, _ -> failwith "Copy format must be the same" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs index 764db5a5..cb5abb1a 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs @@ -9,7 +9,8 @@ open GraphBLAS.FSharp.Backend.Common open StandardOperations open OpenCL.Net -let logger = Log.create "Vector.zeroCreate.Tests" +let logger = + Log.create "Vector.ElementWiseAtLeasOneMul.Tests" let NNZCountCount array isZero = Array.filter (fun item -> not <| isZero item) array @@ -58,7 +59,7 @@ let checkResult expectedArray.[i] <- item match actual with - | VectorCOO actual -> + | VectorSparse actual -> let actualArray = Array.create expectedArrayLength resultZero @@ -68,9 +69,9 @@ let checkResult actualArray.[actual.Indices.[i]] <- actual.Values.[i] - $"arrays must have the same values, expected values = %A{expectedArray}, actual values = %A{actualArray}" + "arrays must have the same values" |> compareArrays isEqual actualArray expectedArray - | _ -> failwith "Vector format must be COO." + | _ -> failwith "Vector format must be Sparse." let correctnessGenericTest leftIsEqual diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs index b243cb3e..0ced525c 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs @@ -47,7 +47,7 @@ let checkResult expectedArray.[i] <- vector.[i] match actual with - | VectorCOO actual -> + | VectorSparse actual -> let actualArray = Array.create expectedArrayLength vectorZero @@ -56,7 +56,7 @@ let checkResult "arrays must have the same values and length" |> compareArrays resultIsEqual actualArray expectedArray - | _ -> failwith "Vector format must be COO." + | _ -> failwith "Vector format must be Sparse." let makeTest<'a, 'b when 'a: struct and 'b: struct> vectorIsZero @@ -137,32 +137,32 @@ let testFixtures case = let intToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.COO id id - |> testPropertyWithConfig config (getCorrectnessTestName "int" "COO") + |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Sparse id id + |> testPropertyWithConfig config (getCorrectnessTestName "int" "Sparse") let floatFill = Vector.fillSubVector context wgSize let floatToCoo = Vector.toCoo context wgSize case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.COO fFilter fFilter - |> testPropertyWithConfig config (getCorrectnessTestName "float" "COO") + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Sparse fFilter fFilter + |> testPropertyWithConfig config (getCorrectnessTestName "float" "Sparse") let byteFill = Vector.fillSubVector context wgSize let byteToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.COO id id - |> testPropertyWithConfig config (getCorrectnessTestName "byte" "COO") + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Sparse id id + |> testPropertyWithConfig config (getCorrectnessTestName "byte" "Sparse") let boolFill = Vector.fillSubVector context wgSize let boolToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.COO id id - |> testPropertyWithConfig config (getCorrectnessTestName "bool" "COO") + |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Sparse id id + |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Sparse") let intFill = Vector.fillSubVector context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index ae498f94..f42a3973 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -20,10 +20,10 @@ let checkResult (isEqual: 'a -> 'a -> bool) (expectedIndices: int []) (expectedV Expect.equal actual.Size (Array.max expectedIndices + 1) "lengths must be the same" match actual with - | VectorCOO actual -> + | VectorSparse actual -> compareArrays (=) actual.Indices expectedIndices "indices must be the same" compareArrays isEqual actual.Values expectedValues "values must be the same" - | _ -> failwith "Vector format must be COO." + | _ -> failwith "Vector format must be Sparse." let correctnessGenericTest<'a when 'a: struct> (isEqual: 'a -> 'a -> bool) diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs index 4229070b..8c8ba315 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs @@ -8,7 +8,7 @@ open Brahma.FSharp open FSharp.Quotations open OpenCL.Net -let logger = Log.create "Vector.Reduce.Tests" +let logger = Log.create "Vector.reduce.Tests" let zeroFilter array isZero = Array.filter diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs index e7f134bc..39330173 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs @@ -16,7 +16,7 @@ let checkResult size (actual: Vector<'a>) = Array.iter <| (fun item -> Expect.equal item None "values must be None") <| vector - | VectorCOO vector -> + | VectorSparse vector -> Expect.equal actual.Size 0 "The size should be the 0" Expect.equal vector.Values [| Unchecked.defaultof<'a> |] "The values array must contain the default value" From dd64f640820b780a827d7d265aa6bc8c94ba48a9 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 13:05:10 +0300 Subject: [PATCH 45/74] refactor: Utils --- src/GraphBLAS-sharp.Backend/Common/Utils.fs | 4 ---- .../GraphBLAS-sharp.Tests.fsproj | 18 +++++++++--------- 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Utils.fs b/src/GraphBLAS-sharp.Backend/Common/Utils.fs index 1c70d5b3..5efc0a98 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Utils.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Utils.fs @@ -21,7 +21,3 @@ module internal Utils = >> fun x -> x ||| (x >>> 8) >> fun x -> x ||| (x >>> 16) >> fun x -> x + 1 - - let toHost (processor: MailboxProcessor<_>) (src: ClArray<_>) = - let dst = Array.zeroCreate src.Length - processor.PostAndReply(fun ch -> Msg.CreateToHostMsg(src, dst, ch)) diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 95459ad9..1f04d97b 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -28,15 +28,15 @@ - - - - - - - - - + + + + + + + + + From 5bb71abcf2359bcfcb71abf235f56b4333bb4db8 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 13:24:03 +0300 Subject: [PATCH 46/74] refactor: Bennchmark --- .../BenchmarksMxv.fs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs index 6c5967b9..19756f84 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs @@ -8,15 +8,15 @@ open BenchmarkDotNet.Columns open System.IO open GraphBLAS.FSharp.IO -// [)>] -// type MxvBenchmarks() = -// let rand = System.Random() -// -// let mutable matrix = Unchecked.defaultof> -// let mutable vector = Unchecked.defaultof> -// let semiring = Predefined.AddMult.float -// -// //TODO fix me +[)>] +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 = From a9fdfeecd08992069f3375b32384716801d0db54 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 20:56:31 +0300 Subject: [PATCH 47/74] remove: redudant ClArray functions --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 28 ------------------- 1 file changed, 28 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 79b01e72..c4a7344d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -483,31 +483,3 @@ module ClArray = processor.Post(Msg.CreateRunMsg<_, _> kernel) resultArray - - let copyTo (clContext: ClContext) (workGroupSize: int) = - - let copy = - <@ fun (ndRange: Range1D) inputArrayLength resultLength (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> - - let gid = ndRange.GlobalID0 - - if gid < inputArrayLength && gid < resultLength then - resultArray.[gid] <- inputArray.[gid] @> - - let kernel = clContext.Compile(copy) - - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> - - let ndRange = - Range1D.CreateValid(resultArray.Length, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange inputArray.Length resultArray.Length inputArray resultArray) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - resultArray From b250012abd937fa40d2e6bc015db74de1461d08c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 31 Oct 2022 22:08:25 +0300 Subject: [PATCH 48/74] refactor: Vector, Helpers --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 60 ------------------- .../Objects/ArrayExtensions.fs | 31 ---------- .../Vector/COOVector/COOVector.fs | 4 +- .../Vector/DenseVector/DenseVector.fs | 19 +++--- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- .../BackendCommonTests/ConvertTests.fs | 6 +- .../MatrixElementwiseTests.fs | 12 ++-- .../BackendCommonTests/TransposeTests.fs | 8 +-- .../GraphBLAS-sharp.Tests.fsproj | 1 - tests/GraphBLAS-sharp.Tests/Helpers.fs | 7 +-- .../VectorOperations/Complemented.fs | 6 +- .../VectorOperations/Convert.fs | 4 +- .../VectorOperations/Copy.fs | 6 +- .../VectorOperations/ElementWiseAtLeastOne.fs | 12 ++-- .../VectorOperations/FillSubVector.fs | 6 +- .../VectorOperations/OfList.fs | 6 +- .../VectorOperations/Reduce.fs | 6 +- .../VectorOperations/ZeroCreate.fs | 12 ++-- 18 files changed, 57 insertions(+), 151 deletions(-) delete mode 100644 src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 14abfeed..b70397c0 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -61,8 +61,6 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - () - let private scanToCell<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) @@ -178,61 +176,3 @@ module Reduce = processor.Post(Msg.CreateFreeMsg(secondVerticesArray)) result - - let atomicRun<'a when 'a: struct> - (clContext: ClContext) - (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) - (zero: 'a) - = - - let reduce = - <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> - - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 - - let localValues = localArray<'a> workGroupSize - - if gid < length then - localValues.[lid] <- inputArray.[gid] - else - localValues.[lid] <- zero - - barrierLocal () - - let mutable step = 2 - - while step <= workGroupSize do - if lid < workGroupSize / step then - let firstValue = localValues.[lid] - let secondValue = localValues.[lid + workGroupSize / step] - - localValues.[lid] <- (%opAdd) firstValue secondValue - - step <- step <<< 1 - - barrierLocal () - - if lid = 0 then - atomic %opAdd totalSum.Value localValues.[0] - |> ignore @> - - let kernel = clContext.Compile(reduce) - - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) -> - - let ndRange = - Range1D.CreateValid(valuesArray.Length, workGroupSize) - - let totalSum = clContext.CreateClCell(zero) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesArray.Length valuesArray totalSum) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - totalSum diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs deleted file mode 100644 index 4ab7d221..00000000 --- a/src/GraphBLAS-sharp.Backend/Objects/ArrayExtensions.fs +++ /dev/null @@ -1,31 +0,0 @@ -namespace GraphBLAS.FSharp.Backend - -open Brahma.FSharp - -module ArraysExtensions = - - type ClArray<'a> with - member this.Dispose(q: MailboxProcessor) = - q.Post(Msg.CreateFreeMsg this) - q.PostAndReply(Msg.MsgNotifyMe) - - member this.ToHost(q: MailboxProcessor) = - let dst = Array.zeroCreate this.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) - - member this.Size = this.Length - - type 'a ``[]`` with - member this.Size = this.Length - - member this.ToString() = - [ sprintf "Dense Vector\n" - sprintf "Size: %i \n" this.Length - sprintf "Values: %A \n" this ] - |> String.concat "" - - member this.ToDevice(context: ClContext) = context.CreateClArray this - - let FromArray (array: 'a [], isZero: 'a -> bool) = - array - |> Array.map (fun v -> if isZero v then None else Some v) diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs index f6f24ea9..1b10d64c 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs @@ -378,7 +378,7 @@ module COOVector = processor.Post(Msg.CreateFreeMsg<_>(allValues)) processor.Post(Msg.CreateFreeMsg<_>(positions)) - { ClSparseVector.Context = clContext + { Context = clContext Values = resultValues Indices = resultIndices Size = max leftVector.Size rightVector.Size } @@ -386,7 +386,7 @@ module COOVector = ///. ///. ///Should be a power of 2 and greater than 1. - let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = // zero + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = let create = ClArray.create clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 7b28a7e6..ca693484 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -6,9 +6,9 @@ open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Quotations module DenseVector = - let private maskWithValue<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = + let private fillMask<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = - let fillVector = + let fillMask = <@ fun (ndRange: Range1D) length (maskArray: ClArray<'a option>) (scalar: ClCell<'b>) (resultArray: ClArray<'b option>) -> let gid = ndRange.GlobalID0 @@ -18,7 +18,7 @@ module DenseVector = | Some _ -> resultArray.[gid] <- Some scalar.Value | None -> resultArray.[gid] <- None @> - let kernel = clContext.Compile(fillVector) + let kernel = clContext.Compile(fillMask) fun (processor: MailboxProcessor<_>) (maskVector: ClArray<'a option>) (scalarCell: ClCell<'b>) -> @@ -112,7 +112,7 @@ module DenseVector = let eWiseAdd = elementWiseAddAtLeasOne clContext StandardOperations.maskAtLeastOne workGroupSize - let copyWithValue = maskWithValue clContext workGroupSize + let copyWithValue = fillMask clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (scalar: 'a) -> @@ -208,7 +208,7 @@ module DenseVector = let getValuesAndIndices<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let unzip = + let getValuesAndIndices = <@ fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (positions: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> let gid = ndRange.GlobalID0 @@ -225,7 +225,7 @@ module DenseVector = | None -> () @> - let kernel = clContext.Compile(unzip) + let kernel = clContext.Compile(getValuesAndIndices) let getPositions = getBitmap clContext workGroupSize @@ -292,7 +292,7 @@ module DenseVector = let values, indices = getValuesAndIndices processor vector - { ClSparseVector.Context = clContext + { Context = clContext Indices = indices Values = values Size = vector.Length } @@ -309,6 +309,9 @@ module DenseVector = let values, indices = getValuesAndIndices processor vector + let result = reduce processor values + processor.Post(Msg.CreateFreeMsg<_>(indices)) + processor.Post(Msg.CreateFreeMsg<_>(values)) - reduce processor values + result diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index ba9dc4e2..eabb9729 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -19,7 +19,7 @@ module Vector = { Context = clContext Indices = clContext.CreateClArray [| 0 |] Values = clContext.CreateClArray<'a> [| Unchecked.defaultof<'a> |] - Size = 0 } + Size = size } ClVectorSparse vector | Dense -> ClVectorDense <| denseZeroCreate processor size diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs index 32007b32..f2755baa 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs @@ -61,7 +61,7 @@ let makeTestCOO context q toCSR isZero (array: 'a [,]) = let testFixtures case = let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + sprintf "Correctness on %s, %A" datatype case.Format let filterFloat x = System.Double.IsNaN x @@ -71,7 +71,7 @@ let testFixtures case = let q = case.ClContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - match case.FormatCase with + match case.Format with | COO -> [ let toCSR = Matrix.toCSR context wgSize @@ -126,6 +126,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs index 973cd34e..f185c4ae 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs @@ -57,10 +57,10 @@ let correctnessGenericTest = let mtx1 = - createMatrixFromArray2D case.FormatCase leftMatrix (isEqual zero) + createMatrixFromArray2D case.Format leftMatrix (isEqual zero) let mtx2 = - createMatrixFromArray2D case.FormatCase rightMatrix (isEqual zero) + createMatrixFromArray2D case.Format rightMatrix (isEqual zero) if mtx1.NNZCount > 0 && mtx2.NNZCount > 0 then try @@ -147,7 +147,7 @@ let elementwiseAddTests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixturesEWiseAdd |> testList "Backend.Matrix.EWiseAdd tests" @@ -211,7 +211,7 @@ let elementwiseAddAtLeastOneTests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixturesEWiseAddAtLeastOne |> testList "Backend.Matrix.EWiseAddAtLeastOne tests" @@ -275,7 +275,7 @@ let elementwiseAddAtLeastOneToCOOTests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixturesEWiseAddAtLeastOneToCOO |> testList "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" @@ -339,6 +339,6 @@ let elementwiseMulAtLeastOneTests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixturesEWiseMulAtLeastOne |> testList "Backend.Matrix.eWiseMulAtLeastOne tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs index 2273756a..6e45421d 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs @@ -54,7 +54,7 @@ let checkResult areEqual zero actual (expected2D: 'a [,]) = let makeTestRegular context q transposeFun areEqual zero case (array: 'a [,]) = let mtx = - createMatrixFromArray2D case.FormatCase array (areEqual zero) + createMatrixFromArray2D case.Format array (areEqual zero) if mtx.NNZCount > 0 then let actual = @@ -81,7 +81,7 @@ let makeTestRegular context q transposeFun areEqual zero case (array: 'a [,]) = let makeTestTwiceTranspose context q transposeFun areEqual zero case (array: 'a [,]) = let mtx = - createMatrixFromArray2D case.FormatCase array (areEqual zero) + createMatrixFromArray2D case.Format array (areEqual zero) if mtx.NNZCount > 0 then let actual = @@ -103,7 +103,7 @@ let makeTestTwiceTranspose context q transposeFun areEqual zero case (array: 'a let testFixtures case = let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + sprintf "Correctness on %s, %A" datatype case.Format let areEqualFloat x y = System.Double.IsNaN x && System.Double.IsNaN y @@ -167,6 +167,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Transpose tests" diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 1f04d97b..ba35ff07 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -37,7 +37,6 @@ - diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 3839d42b..129fa174 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -5,7 +5,6 @@ open Brahma.FSharp.OpenCL.Translator open FsCheck open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp -open MathNet.Numerics.LinearAlgebra.Complex32 open Microsoft.FSharp.Reflection open Brahma.FSharp open Brahma.FSharp.ClContextExtensions @@ -505,9 +504,7 @@ module Utils = { ClContext = context; Queue = queue } - type OperationCase<'a> = - { ClContext: TestContext - FormatCase: 'a } + type OperationCase<'a> = { ClContext: TestContext; Format: 'a } let cartesian firstList secondList = firstList @@ -523,7 +520,7 @@ module Utils = |> List.map (fun pair -> { ClContext = fst pair - FormatCase = snd pair }) + Format = snd pair }) let createMatrixFromArray2D matrixCase array isZero = match matrixCase with diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs index fcb70c4c..4705a411 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs @@ -59,7 +59,7 @@ let correctnessGenericTest let context = case.ClContext.ClContext let secondVector = - createVectorFromArray case.FormatCase maskArray (isEqual zero) + createVectorFromArray case.Format maskArray (isEqual zero) let clVector = secondVector.ToDevice context @@ -81,7 +81,7 @@ let testFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName dataType = - $"Correctness on %A{dataType}, %A{case.FormatCase}" + $"Correctness on %A{dataType}, %A{case.Format}" let wgSize = 32 let context = case.ClContext.ClContext @@ -131,6 +131,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Backend.Vector.complemented tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs index 8ae2f1ed..2e91c0a7 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs @@ -38,7 +38,7 @@ let makeTestDense isZero context q (toCOO: MailboxProcessor<_> -> ClVector<'a> - let testFixtures case = let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + sprintf "Correctness on %s, %A" datatype case.Format let filterFloat x = System.Double.IsNaN x @@ -81,6 +81,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Backend.Vector.Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs index ab12c54f..79a887b0 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs @@ -43,7 +43,7 @@ let correctnessGenericTest<'a when 'a: struct> let context = case.ClContext.ClContext let expected = - createVectorFromArray case.FormatCase array isZero + createVectorFromArray case.Format array isZero let clVector = expected.ToDevice context let clVectorCopy = copy q clVector @@ -61,7 +61,7 @@ let testFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + sprintf "Correctness on %s, %A" datatype case.Format let wgSize = 32 let context = case.ClContext.ClContext @@ -96,6 +96,6 @@ let testFixtures (case: OperationCase) = let tests = testCases - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs index cb5abb1a..a08e7558 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs @@ -105,10 +105,10 @@ let correctnessGenericTest let context = case.ClContext.ClContext let firstVector = - createVectorFromArray case.FormatCase leftArray (leftIsEqual leftZero) + createVectorFromArray case.Format leftArray (leftIsEqual leftZero) let secondVector = - createVectorFromArray case.FormatCase rightArray (rightIsEqual rightZero) + createVectorFromArray case.Format rightArray (rightIsEqual rightZero) let v1 = firstVector.ToDevice context let v2 = secondVector.ToDevice context @@ -132,7 +132,7 @@ let addTestFixtures case = let config = defaultConfig let getCorrectnessTestName fstType sndType thrType = - $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, {case.FormatCase}" + $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, {case.Format}" let wgSize = 32 let context = case.ClContext.ClContext @@ -189,7 +189,7 @@ let addTests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect addTestFixtures |> testList "Backend.Vector.ElementWiseAtLeasOneAdd tests" @@ -197,7 +197,7 @@ let mulTestFixtures case = let config = defaultConfig let getCorrectnessTestName fstType sndType thrType = - $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, {case.FormatCase}" + $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, {case.Format}" let wgSize = 32 let context = case.ClContext.ClContext @@ -255,6 +255,6 @@ let mulTests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect mulTestFixtures |> testList "Backend.Vector.ElementWiseAtLeasOneMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs index 0ced525c..76478370 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs @@ -94,7 +94,7 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> let context = case.ClContext.ClContext let leftVector = - createVectorFromArray case.FormatCase vector (vectorIsZero vectorZero) + createVectorFromArray case.Format vector (vectorIsZero vectorZero) let maskVector = createVectorFromArray maskFormat mask (maskIsEqual maskZero) @@ -124,7 +124,7 @@ let testFixtures case = let config = defaultConfig let getCorrectnessTestName datatype maskFormat = - $"Correctness on %s{datatype}, vector: %A{case.FormatCase}, mask: %s{maskFormat}" + $"Correctness on %s{datatype}, vector: %A{case.Format}, mask: %s{maskFormat}" let wgSize = 32 let context = case.ClContext.ClContext @@ -209,6 +209,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Backend.Vector.fillSubVector tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index f42a3973..e32d509f 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -45,7 +45,7 @@ let correctnessGenericTest<'a when 'a: struct> |> Array.sortBy fst |> Array.unzip - let clActual = ofList elements q case.FormatCase + let clActual = ofList elements q case.Format let clCooActual = toCoo q clActual @@ -67,7 +67,7 @@ let testFixtures (case: OperationCase) = q.Error.Add(fun e -> failwithf $"%A{e}") let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.FormatCase + sprintf "Correctness on %s, %A" datatype case.Format let boolOfList = Vector.ofList context wgSize @@ -115,6 +115,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Backend.Vector.ofList tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs index 8c8ba315..d11e0a39 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs @@ -42,7 +42,7 @@ let correctnessGenericTest let context = case.ClContext.ClContext let vector = - createVectorFromArray case.FormatCase array (isEqual zero) + createVectorFromArray case.Format array (isEqual zero) let clVector = vector.ToDevice context @@ -64,7 +64,7 @@ let testFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName dataType = - $"Correctness on %A{dataType}, %A{case.FormatCase}" + $"Correctness on %A{dataType}, %A{case.Format}" let wgSize = 32 let context = case.ClContext.ClContext @@ -148,6 +148,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Backend.Vector.reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs index 39330173..12d5bdd9 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs @@ -9,16 +9,14 @@ open OpenCL.Net let logger = Log.create "Vector.zeroCreate.Tests" let checkResult size (actual: Vector<'a>) = + Expect.equal actual.Size size "The size should be the same" + match actual with | VectorDense vector -> - Expect.equal actual.Size size "The size should be the same" - Array.iter <| (fun item -> Expect.equal item None "values must be None") <| vector | VectorSparse vector -> - Expect.equal actual.Size 0 "The size should be the 0" - 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" @@ -31,7 +29,7 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> if vectorSize > 0 then let q = case.ClContext.Queue - let (clVector: ClVector<'a>) = zeroCreate q vectorSize case.FormatCase + let (clVector: ClVector<'a>) = zeroCreate q vectorSize case.Format let hostVector = clVector.ToHost q @@ -43,7 +41,7 @@ let testFixtures (case: OperationCase) = let config = defaultConfig let getCorrectnessTestName dataType = - $"Correctness on %A{dataType}, %A{case.FormatCase}" + $"Correctness on %A{dataType}, %A{case.Format}" let wgSize = 32 let context = case.ClContext.ClContext @@ -90,6 +88,6 @@ let tests = .CastTo() deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.FormatCase) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) |> List.collect testFixtures |> testList "Backend.Vector.zeroCreate tests" From ac31ea1d41142ddd1e4fc54ac230970b44306409 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 5 Nov 2022 16:52:15 +0300 Subject: [PATCH 49/74] refactor: COO -> Sparse, Reduce, paths, maskAtLeasOne --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 31 ----- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 108 +++++------------- .../Common/StandardOperations.fs | 7 +- .../GraphBLAS-sharp.Backend.fsproj | 9 +- .../Vector/DenseVector/DenseVector.fs | 57 ++------- .../SparseVector.fs} | 48 +++----- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 73 ++++++------ .../BackendCommonTests/ReduceTests.fs | 40 ++++--- .../GraphBLAS-sharp.Tests.fsproj | 18 +-- tests/GraphBLAS-sharp.Tests/Helpers.fs | 20 +++- .../VectorOperations/OfList.fs | 14 +-- .../VectorOperations/Reduce.fs | 14 +-- 12 files changed, 151 insertions(+), 288 deletions(-) rename src/GraphBLAS-sharp.Backend/Vector/{COOVector/COOVector.fs => SparseVector/SparseVector.fs} (92%) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index c4a7344d..69655267 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -452,34 +452,3 @@ module ClArray = setPositions processor workGroupSize inputArray positions resultLength outputArray - - let toOptionArray (clContext: ClContext) (workGroupSize: int) = - - let toOption = - <@ fun (ndRange: Range1D) (length: int) (values: ClArray<'a>) (indices: ClArray) (outputArray: ClArray<'a option>) -> - let gid = ndRange.GlobalID0 - - if gid < length then - let resultIndex = indices.[gid] - - outputArray.[resultIndex] <- Some values.[gid] @> - - let kernel = clContext.Compile(toOption) - - let zeroCreate = zeroCreate clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (indices: ClArray) (size: int) -> - - let resultArray = zeroCreate processor size - - let ndRange = Range1D.CreateValid(size, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange indices.Length values indices resultArray) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - resultArray diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index b70397c0..2cf50d5d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -9,7 +9,6 @@ module Reduce = (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) - (zero: 'a) = let scan = @@ -20,31 +19,34 @@ module Reduce = let localValues = localArray<'a> workGroupSize - let i = (gid - lid) * 2 + lid + // let i = (gid - lid) * 2 + lid - if i + workGroupSize < length then - localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] - elif i < length then - localValues.[lid] <- inputArray.[i] - else - localValues.[lid] <- zero + // if i + workGroupSize < length then + // localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] + // elif i < length then + // localValues.[lid] <- inputArray.[i] + + if gid < length then + localValues[lid] <- inputArray[gid] barrierLocal () let mutable step = 2 - while step <= workGroupSize do - if lid < workGroupSize / step then - let firstValue = localValues.[lid] - let secondValue = localValues.[lid + workGroupSize / step] + if gid < length then + while step <= workGroupSize do + if (gid + workGroupSize / step) < length && lid < workGroupSize / step then + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + workGroupSize / step] - localValues.[lid] <- ((%opAdd) firstValue secondValue) + localValues.[lid] <- (%opAdd) firstValue secondValue - step <- step <<< 1 + step <- step <<< 1 - barrierLocal () + barrierLocal () - resultArray.[gid / workGroupSize] <- localValues.[0] @> + if lid = 0 then + resultArray.[gid / workGroupSize] <- localValues.[0] @> let kernel = clContext.Compile(scan) @@ -61,70 +63,9 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let private scanToCell<'a when 'a: struct> - (clContext: ClContext) - (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) - (zero: 'a) - = - - let scan = - <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultCell: ClCell<'a>) -> - - let gid = ndRange.GlobalID0 - let lid = ndRange.LocalID0 - - let localValues = localArray<'a> workGroupSize - - let i = (gid - lid) * 2 + lid - - if i + workGroupSize < length then - localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] - elif i < length then - localValues.[lid] <- inputArray.[i] - else - localValues.[lid] <- zero - - barrierLocal () - - let mutable step = 2 - - while step <= workGroupSize do - if lid < workGroupSize / step then - let firstValue = localValues.[lid] - let secondValue = localValues.[lid + workGroupSize / step] - - localValues.[lid] <- (%opAdd) firstValue secondValue - - step <- step <<< 1 - - barrierLocal () - - resultCell.Value <- localValues.[0] @> - - let kernel = clContext.Compile(scan) - - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength -> - - let ndRange = - Range1D.CreateValid(valuesArray.Length, workGroupSize) - - let resultCell = clContext.CreateClCell zero - - let kernel = kernel.GetKernel() - - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultCell)) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - resultCell + let run<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = - let run<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) (zero: 'a) = - - let scan = scan clContext workGroupSize opAdd zero - - let scanToCell = - scanToCell clContext workGroupSize opAdd zero + let scan = scan clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> @@ -170,7 +111,14 @@ module Reduce = let fstVertices = fst verticesArrays let result = - scanToCell processor fstVertices verticesLength + clContext.CreateClArray( + 1, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + scan fstVertices verticesLength result processor.Post(Msg.CreateFreeMsg(firstVerticesArray)) processor.Post(Msg.CreateFreeMsg(secondVerticesArray)) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 0c8085a2..a19fa58f 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -95,9 +95,8 @@ module StandardOperations = let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f - let maskAtLeastOne<'a when 'a: struct> = - <@ fun (value: AtLeastOne<'a, 'a>) -> + let maskAtLeastOne<'a, 'b when 'a: struct and 'b: struct> res = + <@ fun (value: AtLeastOne<'a, 'b>) -> match value with - | Both (_, right) -> Some right | Left left -> Some left - | Right right -> Some right @> + | _ -> Some res @> diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 94a9c808..5d79220f 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -17,7 +17,7 @@ - + @@ -29,10 +29,9 @@ - - - - + + + diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index ca693484..4c1baa69 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -6,45 +6,7 @@ open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Quotations module DenseVector = - let private fillMask<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = - - let fillMask = - <@ fun (ndRange: Range1D) length (maskArray: ClArray<'a option>) (scalar: ClCell<'b>) (resultArray: ClArray<'b option>) -> - - let gid = ndRange.GlobalID0 - - if gid < length then - match maskArray.[gid] with - | Some _ -> resultArray.[gid] <- Some scalar.Value - | None -> resultArray.[gid] <- None @> - - let kernel = clContext.Compile(fillMask) - - fun (processor: MailboxProcessor<_>) (maskVector: ClArray<'a option>) (scalarCell: ClCell<'b>) -> - - let resultArray = - clContext.CreateClArray( - maskVector.Length, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.Default - ) - - let ndRange = - Range1D.CreateValid(maskVector.Length, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange maskVector.Length maskVector scalarCell resultArray) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - resultArray - - let elementWiseAddAtLeasOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + let elementWiseAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) @@ -107,20 +69,15 @@ module DenseVector = resultVector - let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = //zero + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) (scalar: 'a) = let eWiseAdd = - elementWiseAddAtLeasOne clContext StandardOperations.maskAtLeastOne workGroupSize - - let copyWithValue = fillMask clContext workGroupSize + elementWiseAtLeastOne clContext (StandardOperations.maskAtLeastOne scalar) workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (scalar: 'a) -> + fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) -> let clScalar = clContext.CreateClCell scalar - let maskVector = - copyWithValue processor maskVector clScalar - let resultVector = eWiseAdd processor leftVector maskVector processor.Post(Msg.CreateFreeMsg<_>(maskVector)) @@ -206,7 +163,7 @@ module DenseVector = positions - let getValuesAndIndices<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + let private getValuesAndIndices<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let getValuesAndIndices = <@ fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (positions: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> @@ -297,13 +254,13 @@ module DenseVector = Values = values Size = vector.Length } - let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) zero = + let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let getValuesAndIndices = getValuesAndIndices clContext workGroupSize let reduce = - Reduce.run clContext workGroupSize opAdd zero + Reduce.run clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs similarity index 92% rename from src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs rename to src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 1b10d64c..10612674 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/COOVector/COOVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -6,7 +6,7 @@ open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations -module COOVector = +module SparseVector = let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = let merge = @@ -270,14 +270,15 @@ module COOVector = let private setPositions<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let setPositions = - <@ fun (ndRange: Range1D) prefixSumArrayLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> + <@ fun (ndRange: Range1D) prefixSumArrayLength resultLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> let i = ndRange.GlobalID0 + let index = prefixSumBuffer[i] - if i = prefixSumArrayLength - 1 - || i < prefixSumArrayLength - && prefixSumBuffer.[i] <> prefixSumBuffer.[i + 1] then - let index = prefixSumBuffer.[i] + if i < prefixSumArrayLength - 1 + && index <> prefixSumBuffer.[i + 1] + || (i = prefixSumArrayLength - 1 + && index < resultLength) then resultValues.[index] <- allValues.[i] resultIndices.[index] <- allIndices.[i] @> @@ -332,6 +333,7 @@ module COOVector = kernel.KernelFunc ndRange prefixSumArrayLength + resultLength allValues allIndices positions @@ -346,7 +348,7 @@ module COOVector = ///. ///. ///Should be a power of 2 and greater than 1. - let elementWiseAddAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + let elementWiseAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) @@ -386,33 +388,13 @@ module COOVector = ///. ///. ///Should be a power of 2 and greater than 1. - let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = - - let create = ClArray.create clContext workGroupSize + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) (scalar: 'a) = let eWiseAdd = - elementWiseAddAtLeastOne clContext StandardOperations.maskAtLeastOne workGroupSize - - let copy = ClArray.copy clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (leftVector: ClSparseVector<'a>) (rightVector: ClSparseVector<'b>) (scalar: 'a) -> - - let maskValues = create processor rightVector.Size scalar - let maskIndices = copy processor rightVector.Indices + elementWiseAtLeastOne clContext (StandardOperations.maskAtLeastOne scalar) workGroupSize - let rightVector = - { Context = clContext - Indices = copy processor rightVector.Indices - Values = maskValues - Size = rightVector.Size } - - let res = - eWiseAdd processor leftVector rightVector - - processor.Post(Msg.CreateFreeMsg(maskValues)) - processor.Post(Msg.CreateFreeMsg(maskIndices)) - - res + fun (processor: MailboxProcessor<_>) (leftVector: ClSparseVector<'a>) (rightVector: ClSparseVector<'b>) -> + eWiseAdd processor leftVector rightVector let preparePositionsComplemented (clContext: ClContext) (workGroupSize: int) = @@ -534,9 +516,9 @@ module COOVector = Values = ResultValues Size = vector.Size } - let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) zero = + let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let reduce = - Reduce.run clContext workGroupSize opAdd zero + Reduce.run clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClSparseVector<'a>) -> reduce processor vector.Values diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index eabb9729..817ab88d 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -9,7 +9,7 @@ open GraphBLAS.FSharp.Backend.Common module Vector = let zeroCreate (clContext: ClContext) (workGroupSize: int) = - let denseZeroCreate = + let zeroCreate = ClArray.zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (size: int) (format: VectorFormat) -> @@ -17,42 +17,35 @@ module Vector = | Sparse -> let vector = { Context = clContext - Indices = clContext.CreateClArray [| 0 |] - Values = clContext.CreateClArray<'a> [| Unchecked.defaultof<'a> |] + Indices = clContext.CreateClArray [| 0 |] + Values = clContext.CreateClArray [| Unchecked.defaultof<'a> |] Size = size } ClVectorSparse vector - | Dense -> ClVectorDense <| denseZeroCreate processor size + | Dense -> ClVectorDense <| zeroCreate processor size - let ofList (clContext: ClContext) (workGroupSize: int) (elements: (int * 'a) list) = + let ofList (clContext: ClContext) = + fun (format: VectorFormat) (elements: (int * 'a) list) -> + let indices, values = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip - let toOptionArray = - ClArray.toOptionArray clContext workGroupSize + let resultLenght = (Array.max indices) + 1 - let indices, values = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip - - let clIndices = clContext.CreateClArray indices - let clValues = clContext.CreateClArray values - - let resultLenght = (Array.max indices) + 1 - - fun (processor: MailboxProcessor<_>) (format: VectorFormat) -> match format with | Sparse -> - let vector = - { Context = clContext - Indices = clIndices - Values = clValues - Size = resultLenght } - - ClVectorSparse vector + SparseVector.FromTuples(indices, values, resultLenght) + .ToDevice clContext + |> ClVectorSparse | Dense -> - ClVectorDense - <| toOptionArray processor clValues clIndices resultLenght + let res = Array.zeroCreate resultLenght + + for i in 0 .. indices.Length - 1 do + res[indices[i]] <- Some values[i] + + ClVectorDense <| clContext.CreateClArray res let copy (clContext: ClContext) (workGroupSize: int) = let copy = ClArray.copy clContext workGroupSize @@ -89,10 +82,10 @@ module Vector = let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let addCoo = - COOVector.elementWiseAddAtLeastOne clContext opAdd workGroupSize + SparseVector.elementWiseAtLeastOne clContext opAdd workGroupSize let addDense = - DenseVector.elementWiseAddAtLeasOne clContext opAdd workGroupSize + DenseVector.elementWiseAtLeastOne clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with @@ -100,9 +93,9 @@ module Vector = | ClVectorDense left, ClVectorDense right -> ClVectorDense <| addDense processor left right | _ -> failwith "Vector formats are not matching." - let fillSubVector (clContext: ClContext) (workGroupSize: int) = //TODO() remove zero + let fillSubVector (clContext: ClContext) (workGroupSize: int) = let cooFillVector = - COOVector.fillSubVector clContext workGroupSize + SparseVector.fillSubVector clContext workGroupSize let denseFillVector = DenseVector.fillSubVector clContext workGroupSize @@ -117,24 +110,24 @@ module Vector = match vector, maskVector with | ClVectorSparse vector, ClVectorSparse mask -> ClVectorSparse - <| cooFillVector processor vector mask value + <| cooFillVector value processor vector mask | ClVectorSparse vector, ClVectorDense mask -> let mask = toCooMask processor mask ClVectorSparse - <| cooFillVector processor vector mask value + <| cooFillVector value processor vector mask | ClVectorDense vector, ClVectorSparse mask -> let vector = toCooVector processor vector ClVectorSparse - <| cooFillVector processor vector mask value + <| cooFillVector value processor vector mask | ClVectorDense vector, ClVectorDense mask -> ClVectorDense - <| denseFillVector processor vector mask value + <| denseFillVector value processor vector mask let complemented (clContext: ClContext) (workGroupSize: int) = let cooComplemented = - COOVector.complemented clContext workGroupSize + SparseVector.complemented clContext workGroupSize let denseComplemented = DenseVector.complemented clContext workGroupSize @@ -146,12 +139,12 @@ module Vector = ClVectorDense <| denseComplemented processor vector - let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) (zero: 'a) = + let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let cooReduce = - COOVector.reduce clContext workGroupSize opAdd zero + SparseVector.reduce clContext workGroupSize opAdd let denseReduce = - DenseVector.reduce clContext workGroupSize opAdd zero + DenseVector.reduce clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index 26a60cc7..9c4853e7 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -11,11 +11,19 @@ let logger = Log.create "Reduce.Tests" let context = defaultContext.ClContext -let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> 'a []) (array: 'a []) = // TODO remove isEqual - if array.Length > 0 then - let array = filter array +let makeTest + (q: MailboxProcessor<_>) + (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClArray<'a>) + plus + zero + (filter: 'a [] -> 'a []) + (array: 'a []) + = + + let array = filter array - let reduce = reduce zero q + if array.Length > 0 then + let reduce = reduce q logger.debug ( eventX "Filtered array is {array}\n" @@ -49,10 +57,10 @@ let makeTest (q: MailboxProcessor<_>) reduce plus zero isEqual (filter: 'a [] -> |> Expect.equal actualSum expectedSum -let testFixtures config wgSize q plus plusQ zero isEqual filter name = +let testFixtures config wgSize q plus plusQ zero filter name = let reduce = Reduce.run context wgSize plusQ - makeTest q reduce plus zero isEqual filter + makeTest q reduce plus zero filter |> testPropertyWithConfig config (sprintf "Correctness on %s" name) let tests = @@ -65,14 +73,14 @@ let tests = let filterFloats = Array.filter (System.Double.IsNaN >> not) - [ testFixtures config wgSize q (+) <@ (+) @> 0 (=) id "int add" - testFixtures config wgSize q (+) <@ (+) @> 0uy (=) id "byte add" - testFixtures config wgSize q max <@ max @> 0 (=) id "int max" - testFixtures config wgSize q max <@ max @> 0.0 (=) filterFloats "float max" - testFixtures config wgSize q max <@ max @> 0uy (=) id "byte max" - testFixtures config wgSize q min <@ min @> System.Int32.MaxValue (=) id "int min" - testFixtures config wgSize q min <@ min @> System.Double.MaxValue (=) filterFloats "float min" - testFixtures config wgSize q min <@ min @> System.Byte.MaxValue (=) id "byte min" - testFixtures config wgSize q (||) <@ (||) @> false (=) id "bool logic-or" - testFixtures config wgSize q (&&) <@ (&&) @> true (=) id "bool logic-and" ] + [ testFixtures config wgSize q (+) <@ (+) @> 0 id "int add" + testFixtures config wgSize q (+) <@ (+) @> 0uy id "byte add" + testFixtures config wgSize q max <@ max @> System.Int32.MinValue id "int max" + testFixtures config wgSize q max <@ max @> System.Double.MinValue filterFloats "float max" + testFixtures config wgSize q max <@ max @> System.Byte.MinValue id "byte max" + testFixtures config wgSize q min <@ min @> System.Int32.MaxValue id "int min" + testFixtures config wgSize q min <@ min @> System.Double.MaxValue filterFloats "float min" + testFixtures config wgSize q min <@ min @> System.Byte.MaxValue id "byte min" + testFixtures config wgSize q (||) <@ (||) @> false id "bool logic-or" + testFixtures config wgSize q (&&) <@ (&&) @> true id "bool logic-and" ] |> testList "Backend.Common.Reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index ba35ff07..42d91766 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -20,7 +20,7 @@ - + @@ -28,14 +28,14 @@ - - - - - - - - + + + + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 129fa174..740a8b48 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -424,6 +424,18 @@ module Utils = typeof typeof ] } + let rec cartesian listOfLists = + match listOfLists with + | [ x ] -> List.fold (fun acc elem -> [ elem ] :: acc) [] x + | h :: t -> + List.fold + (fun cacc celem -> + (List.fold (fun acc elem -> (elem :: celem) :: acc) [] h) + @ cacc) + [] + (cartesian t) + | _ -> [] + let listOfUnionCases<'a> = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) @@ -506,17 +518,13 @@ module Utils = type OperationCase<'a> = { ClContext: TestContext; Format: 'a } - let cartesian firstList secondList = - firstList - |> List.collect (fun x -> secondList |> List.map (fun y -> x, y)) - let testCases<'a> = let availableContexts = availableContexts "" |> List.ofSeq let listOfUnionCases = listOfUnionCases<'a> |> List.ofSeq - cartesian availableContexts listOfUnionCases - + availableContexts + |> List.collect (fun x -> listOfUnionCases |> List.map (fun y -> x, y)) |> List.map (fun pair -> { ClContext = fst pair diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index e32d509f..c7880c0e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -11,7 +11,7 @@ let logger = Log.create "Vector.ofList.Tests" let filter elements = List.filter - <| (fun item -> fst item > 0) + <| (fun item -> fst item >= 0) <| elements |> List.distinctBy fst @@ -27,7 +27,7 @@ let checkResult (isEqual: 'a -> 'a -> bool) (expectedIndices: int []) (expectedV let correctnessGenericTest<'a when 'a: struct> (isEqual: 'a -> 'a -> bool) - (ofList: (int * 'a) list -> MailboxProcessor -> VectorFormat -> ClVector<'a>) + (ofList: VectorFormat -> (int * 'a) list -> ClVector<'a>) (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) (elements: (int * 'a) list) @@ -45,7 +45,7 @@ let correctnessGenericTest<'a when 'a: struct> |> Array.sortBy fst |> Array.unzip - let clActual = ofList elements q case.Format + let clActual = ofList case.Format elements let clCooActual = toCoo q clActual @@ -69,7 +69,7 @@ let testFixtures (case: OperationCase) = let getCorrectnessTestName datatype = sprintf "Correctness on %s, %A" datatype case.Format - let boolOfList = Vector.ofList context wgSize + let boolOfList = Vector.ofList context let toCoo = Vector.toCoo context wgSize @@ -77,7 +77,7 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) boolOfList toCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool") - let intOfList = Vector.ofList context wgSize + let intOfList = Vector.ofList context let toCoo = Vector.toCoo context wgSize @@ -86,7 +86,7 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "int") - let byteOfList = Vector.ofList context wgSize + let byteOfList = Vector.ofList context let toCoo = Vector.toCoo context wgSize @@ -94,7 +94,7 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) byteOfList toCoo |> testPropertyWithConfig config (getCorrectnessTestName "byte") - let floatOfList = Vector.ofList context wgSize + let floatOfList = Vector.ofList context let toCoo = Vector.toCoo context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs index d11e0a39..3a7263e7 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs @@ -27,7 +27,7 @@ let correctnessGenericTest zero op opQ - (reduce: Expr<'a -> 'a -> 'a> -> 'a -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) + (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClArray<'a>) filter case (array: 'a []) @@ -35,9 +35,9 @@ let correctnessGenericTest let array = filter array - let filteredArray = zeroFilter array (isEqual zero) + let arrayWithoutZeros = zeroFilter array (isEqual zero) - if filteredArray.Length > 0 then + if arrayWithoutZeros.Length > 0 then let q = case.ClContext.Queue let context = case.ClContext.ClContext @@ -46,7 +46,7 @@ let correctnessGenericTest let clVector = vector.ToDevice context - let resultCell = reduce opQ zero q clVector + let resultCell = reduce opQ q clVector let result = Array.zeroCreate 1 @@ -90,19 +90,19 @@ let testFixtures (case: OperationCase) = let intMaxReduce = Vector.reduce context wgSize case - |> correctnessGenericTest (=) 0 max <@ max @> intMaxReduce id + |> correctnessGenericTest (=) System.Int32.MinValue max <@ max @> intMaxReduce id |> testPropertyWithConfig config (getCorrectnessTestName "int max") let floatMaxReduce = Vector.reduce context wgSize case - |> correctnessGenericTest (=) 0.0 max <@ max @> floatMaxReduce filterFloats + |> correctnessGenericTest (=) System.Double.MinValue max <@ max @> floatMaxReduce filterFloats |> testPropertyWithConfig config (getCorrectnessTestName "float max") let byteMaxReduce = Vector.reduce context wgSize case - |> correctnessGenericTest (=) 0uy max <@ max @> byteMaxReduce id + |> correctnessGenericTest (=) System.Byte.MinValue max <@ max @> byteMaxReduce id |> testPropertyWithConfig config (getCorrectnessTestName "byte max") let intMinReduce = Vector.reduce context wgSize From 33bcb1fda32db18142ab5bee98e9072b7e9634b2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 5 Nov 2022 17:10:13 +0300 Subject: [PATCH 50/74] add: getTestFromTestFixuter, refactor: Tests --- .../BackendCommonTests/ConvertTests.fs | 17 +---- .../MatrixElementwiseTests.fs | 65 ++----------------- .../BackendCommonTests/TransposeTests.fs | 17 +---- tests/GraphBLAS-sharp.Tests/Helpers.fs | 17 +++++ .../VectorOperations/Complemented.fs | 17 +---- .../VectorOperations/Convert.fs | 17 +---- .../VectorOperations/Copy.fs | 6 +- .../VectorOperations/ElementWiseAtLeastOne.fs | 34 +--------- .../VectorOperations/FillSubVector.fs | 17 +---- .../VectorOperations/OfList.fs | 17 +---- .../VectorOperations/Reduce.fs | 17 +---- .../VectorOperations/ZeroCreate.fs | 17 +---- 12 files changed, 32 insertions(+), 226 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs index f2755baa..e612fd14 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ConvertTests.fs @@ -113,19 +113,4 @@ let testFixtures case = makeTestCSR context q toCOO ((=) false) |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Convert tests" +let tests = getTestFromFixtures testFixtures "Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs index f185c4ae..7a2a343a 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs @@ -134,22 +134,7 @@ let testFixturesEWiseAdd case = |> correctnessGenericTest 0uy (+) byteAdd byteToCOO (=) q |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] -let elementwiseAddTests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixturesEWiseAdd - |> testList "Backend.Matrix.EWiseAdd tests" +let elementwiseAddTests = getTestFromFixtures testFixturesEWiseAdd "Backend.Matrix.EWiseAdd tests" let testFixturesEWiseAddAtLeastOne case = [ let config = defaultConfig @@ -199,21 +184,7 @@ let testFixturesEWiseAddAtLeastOne case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddAtLeastOneTests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixturesEWiseAddAtLeastOne - |> testList "Backend.Matrix.EWiseAddAtLeastOne tests" + getTestFromFixtures testFixturesEWiseAddAtLeastOne "Backend.Matrix.EWiseAddAtLeastOne tests" let testFixturesEWiseAddAtLeastOneToCOO case = [ let config = defaultConfig @@ -263,21 +234,7 @@ let testFixturesEWiseAddAtLeastOneToCOO case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddAtLeastOneToCOOTests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixturesEWiseAddAtLeastOneToCOO - |> testList "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" + getTestFromFixtures testFixturesEWiseAddAtLeastOneToCOO "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" let testFixturesEWiseMulAtLeastOne case = [ let config = defaultConfig @@ -327,18 +284,4 @@ let testFixturesEWiseMulAtLeastOne case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseMulAtLeastOneTests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixturesEWiseMulAtLeastOne - |> testList "Backend.Matrix.eWiseMulAtLeastOne tests" + getTestFromFixtures testFixturesEWiseMulAtLeastOne "Backend.Matrix.eWiseMulAtLeastOne tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs index 6e45421d..940dda3b 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs @@ -154,19 +154,4 @@ let testFixtures case = |> makeTestTwiceTranspose context q transposeFun (=) false |> testPropertyWithConfig config (getCorrectnessTestName "bool (twice transpose)") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Transpose tests" +let tests = getTestFromFixtures testFixtures "Transpose tests" diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 740a8b48..e791872b 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -557,3 +557,20 @@ module Utils = <| actual.[i] <| expected.[i] |> failtestf "%s" + + let getTestFromFixtures testFixtures name = + testCases + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.ClContext.ClDevice.Device + + let deviceType = + Cl + .GetDeviceInfo(device, DeviceInfo.Type, &e) + .CastTo() + + deviceType = DeviceType.Gpu) + |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) + |> List.collect testFixtures + |> testList name diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs index 4705a411..f351af29 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs @@ -118,19 +118,4 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) false boolComplemented boolToCoo id |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Backend.Vector.complemented tests" +let tests = getTestFromFixtures testFixtures "Backend.Vector.complemented tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs index 2e91c0a7..6ecb73a4 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs @@ -68,19 +68,4 @@ let testFixtures case = makeTestDense ((=) false) context q toCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Backend.Vector.Convert tests" +let tests = getTestFromFixtures testFixtures "Backend.Vector.Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs index 79a887b0..0cbc2ecb 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs @@ -94,8 +94,4 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest id (=) isZero floatCopy |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] -let tests = - testCases - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Backend.Vector.copy tests" +let tests = getTestFromFixtures testFixtures "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs index a08e7558..f44ee740 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs @@ -176,22 +176,7 @@ let addTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let addTests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect addTestFixtures - |> testList "Backend.Vector.ElementWiseAtLeasOneAdd tests" +let addTests = getTestFromFixtures addTestFixtures "Backend.Vector.ElementWiseAtLeasOneAdd tests" let mulTestFixtures case = let config = defaultConfig @@ -242,19 +227,4 @@ let mulTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let mulTests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect mulTestFixtures - |> testList "Backend.Vector.ElementWiseAtLeasOneMul tests" +let mulTests = getTestFromFixtures mulTestFixtures "Backend.Vector.ElementWiseAtLeasOneMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs index 76478370..476a825e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs @@ -196,19 +196,4 @@ let testFixtures case = |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense id id |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Backend.Vector.fillSubVector tests" +let tests = getTestFromFixtures testFixtures "Backend.Vector.fillSubVector tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index c7880c0e..fdf2731e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -102,19 +102,4 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) floatOfList toCoo |> testPropertyWithConfig config (getCorrectnessTestName "float") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Backend.Vector.ofList tests" +let tests = getTestFromFixtures testFixtures "Backend.Vector.ofList tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs index 3a7263e7..f687394b 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs @@ -135,19 +135,4 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) true (&&) <@ (&&) @> boolAndReduce id |> testPropertyWithConfig config (getCorrectnessTestName "bool and") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Backend.Vector.reduce tests" +let tests = getTestFromFixtures testFixtures "Backend.Vector.reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs index 12d5bdd9..e9ed5497 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs @@ -75,19 +75,4 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest boolZeroCreate |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -let tests = - testCases - |> List.filter - (fun case -> - let mutable e = ErrorCode.Unknown - let device = case.ClContext.ClContext.ClDevice.Device - - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - deviceType = DeviceType.Gpu) - |> List.distinctBy (fun case -> case.ClContext.ClContext.ClDevice.DeviceType, case.Format) - |> List.collect testFixtures - |> testList "Backend.Vector.zeroCreate tests" +let tests = getTestFromFixtures testFixtures "Backend.Vector.zeroCreate tests" From 1f18c2a6eabdbea7c040ecfd0b03f5967de15481 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 5 Nov 2022 17:56:12 +0300 Subject: [PATCH 51/74] refactor: VectorFormat in Vector.Convert test --- tests/GraphBLAS-sharp.Tests/Helpers.fs | 4 ++-- tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index e791872b..c36f73a4 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -558,8 +558,8 @@ module Utils = <| expected.[i] |> failtestf "%s" - let getTestFromFixtures testFixtures name = - testCases + let getTestFromFixtures<'a when 'a : equality> testFixtures name = + testCases<'a> |> List.filter (fun case -> let mutable e = ErrorCode.Unknown diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs index 6ecb73a4..ee5e60ec 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs @@ -68,4 +68,5 @@ let testFixtures case = makeTestDense ((=) false) context q toCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -let tests = getTestFromFixtures testFixtures "Backend.Vector.Convert tests" +let tests = + getTestFromFixtures testFixtures "Backend.Vector.Convert tests" From 1994a812ad224cec43a48c9fb5d21410f0c33fe6 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 5 Nov 2022 18:17:13 +0300 Subject: [PATCH 52/74] fix GraphBLAS-sharp.Test proj file --- .../GraphBLAS-sharp.Tests.fsproj | 36 ++----------------- 1 file changed, 2 insertions(+), 34 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 476f8011..a95956e3 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -17,16 +17,15 @@ + + - - - @@ -40,34 +39,3 @@ - - - Exe - net5.0 - false - - - - - - - - - - - - - - - - - - - - - - - - - - \ No newline at end of file From 210672deabc4e415e5c86dcbb69efed8043c693b Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 5 Nov 2022 19:01:25 +0300 Subject: [PATCH 53/74] fix: build --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 11 ++++------- .../Vector/DenseVector/DenseVector.fs | 3 +-- .../Vector/SparseVector/SparseVector.fs | 11 +++++------ src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 5 +++-- .../BackendCommonTests/MatrixElementwiseTests.fs | 3 ++- .../BackendCommonTests/TransposeTests.fs | 3 ++- tests/GraphBLAS-sharp.Tests/Helpers.fs | 2 +- .../VectorOperations/Complemented.fs | 3 ++- tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs | 3 ++- .../VectorOperations/ElementWiseAtLeastOne.fs | 6 ++++-- .../VectorOperations/FillSubVector.fs | 3 ++- .../GraphBLAS-sharp.Tests/VectorOperations/OfList.fs | 3 ++- .../GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs | 3 ++- .../VectorOperations/ZeroCreate.fs | 3 ++- 14 files changed, 34 insertions(+), 28 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 2cf50d5d..b9546593 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -5,11 +5,7 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations module Reduce = - let private scan<'a when 'a: struct> - (clContext: ClContext) - (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) - = + let private scan<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let scan = <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> @@ -27,7 +23,7 @@ module Reduce = // localValues.[lid] <- inputArray.[i] if gid < length then - localValues[lid] <- inputArray[gid] + localValues.[lid] <- inputArray.[gid] barrierLocal () @@ -35,7 +31,8 @@ module Reduce = if gid < length then while step <= workGroupSize do - if (gid + workGroupSize / step) < length && lid < workGroupSize / step then + if (gid + workGroupSize / step) < length + && lid < workGroupSize / step then let firstValue = localValues.[lid] let secondValue = localValues.[lid + workGroupSize / step] diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 4c1baa69..dab70ab1 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -259,8 +259,7 @@ module DenseVector = let getValuesAndIndices = getValuesAndIndices clContext workGroupSize - let reduce = - Reduce.run clContext workGroupSize opAdd + let reduce = Reduce.run clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 10612674..26e0156c 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -273,12 +273,12 @@ module SparseVector = <@ fun (ndRange: Range1D) prefixSumArrayLength resultLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> let i = ndRange.GlobalID0 - let index = prefixSumBuffer[i] + let index = prefixSumBuffer.[i] if i < prefixSumArrayLength - 1 - && index <> prefixSumBuffer.[i + 1] - || (i = prefixSumArrayLength - 1 - && index < resultLength) then + && index <> prefixSumBuffer.[i + 1] + || (i = prefixSumArrayLength - 1 + && index < resultLength) then resultValues.[index] <- allValues.[i] resultIndices.[index] <- allIndices.[i] @> @@ -518,7 +518,6 @@ module SparseVector = let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = - let reduce = - Reduce.run clContext workGroupSize opAdd + let reduce = Reduce.run clContext workGroupSize opAdd fun (processor: MailboxProcessor<_>) (vector: ClSparseVector<'a>) -> reduce processor vector.Values diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 817ab88d..3ff8d993 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -36,14 +36,15 @@ module Vector = match format with | Sparse -> - SparseVector.FromTuples(indices, values, resultLenght) + SparseVector + .FromTuples(indices, values, resultLenght) .ToDevice clContext |> ClVectorSparse | Dense -> let res = Array.zeroCreate resultLenght for i in 0 .. indices.Length - 1 do - res[indices[i]] <- Some values[i] + res.[indices.[i]] <- Some(values.[i]) ClVectorDense <| clContext.CreateClArray res diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs index 7a2a343a..1e2eb5f7 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs @@ -134,7 +134,8 @@ let testFixturesEWiseAdd case = |> correctnessGenericTest 0uy (+) byteAdd byteToCOO (=) q |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] -let elementwiseAddTests = getTestFromFixtures testFixturesEWiseAdd "Backend.Matrix.EWiseAdd tests" +let elementwiseAddTests = + getTestFromFixtures testFixturesEWiseAdd "Backend.Matrix.EWiseAdd tests" let testFixturesEWiseAddAtLeastOne case = [ let config = defaultConfig diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs index 7cab0e95..3d474ed9 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs @@ -172,4 +172,5 @@ let testFixtures case = |> makeTestTwiceTranspose context q transposeFun (=) false |> testPropertyWithConfig config (getCorrectnessTestName "bool (twice transpose)") ] -let tests = getTestFromFixtures testFixtures "Transpose tests" +let tests = + getTestFromFixtures testFixtures "Transpose tests" diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c9141897..d82fdcd7 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -689,7 +689,7 @@ module Utils = <| expected.[i] |> failtestf "%s" - let getTestFromFixtures<'a when 'a : equality> testFixtures name = + let getTestFromFixtures<'a when 'a: equality> testFixtures name = testCases<'a> |> List.filter (fun case -> diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs index f351af29..c575163c 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs @@ -118,4 +118,5 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) false boolComplemented boolToCoo id |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -let tests = getTestFromFixtures testFixtures "Backend.Vector.complemented tests" +let tests = + getTestFromFixtures testFixtures "Backend.Vector.complemented tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs index 0cbc2ecb..5fcde86b 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs @@ -94,4 +94,5 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest id (=) isZero floatCopy |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] -let tests = getTestFromFixtures testFixtures "Backend.Vector.copy tests" +let tests = + getTestFromFixtures testFixtures "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs index f44ee740..19d16c51 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs @@ -176,7 +176,8 @@ let addTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let addTests = getTestFromFixtures addTestFixtures "Backend.Vector.ElementWiseAtLeasOneAdd tests" +let addTests = + getTestFromFixtures addTestFixtures "Backend.Vector.ElementWiseAtLeasOneAdd tests" let mulTestFixtures case = let config = defaultConfig @@ -227,4 +228,5 @@ let mulTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo id id |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let mulTests = getTestFromFixtures mulTestFixtures "Backend.Vector.ElementWiseAtLeasOneMul tests" +let mulTests = + getTestFromFixtures mulTestFixtures "Backend.Vector.ElementWiseAtLeasOneMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs index 476a825e..ab4bf2e4 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs @@ -196,4 +196,5 @@ let testFixtures case = |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense id id |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] -let tests = getTestFromFixtures testFixtures "Backend.Vector.fillSubVector tests" +let tests = + getTestFromFixtures testFixtures "Backend.Vector.fillSubVector tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index fdf2731e..f133f2d3 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -102,4 +102,5 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) floatOfList toCoo |> testPropertyWithConfig config (getCorrectnessTestName "float") ] -let tests = getTestFromFixtures testFixtures "Backend.Vector.ofList tests" +let tests = + getTestFromFixtures testFixtures "Backend.Vector.ofList tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs index f687394b..51852258 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs @@ -135,4 +135,5 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest (=) true (&&) <@ (&&) @> boolAndReduce id |> testPropertyWithConfig config (getCorrectnessTestName "bool and") ] -let tests = getTestFromFixtures testFixtures "Backend.Vector.reduce tests" +let tests = + getTestFromFixtures testFixtures "Backend.Vector.reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs index e9ed5497..1919bb7e 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs @@ -75,4 +75,5 @@ let testFixtures (case: OperationCase) = |> correctnessGenericTest boolZeroCreate |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -let tests = getTestFromFixtures testFixtures "Backend.Vector.zeroCreate tests" +let tests = + getTestFromFixtures testFixtures "Backend.Vector.zeroCreate tests" From 4908361d79b3b12d7f01fc841732f42a0530cd40 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 6 Nov 2022 12:28:20 +0300 Subject: [PATCH 54/74] fix: length in VectorDense.elementwiseAtLeastOne --- .../Vector/DenseVector/DenseVector.fs | 23 ++----- tests/GraphBLAS-sharp.Tests/Helpers.fs | 60 ++++++++++++++++++- .../VectorOperations/ElementWiseAtLeastOne.fs | 31 ++++------ .../VectorOperations/FillSubVector.fs | 43 ++++--------- .../VectorOperations/OfList.fs | 13 ++-- 5 files changed, 95 insertions(+), 75 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index dab70ab1..6de2419a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -13,42 +13,31 @@ module DenseVector = = let eWiseAdd = - <@ fun (ndRange: Range1D) leftVectorLength rightVectorLength resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> let gid = ndRange.GlobalID0 - let mutable leftItem = None - let mutable rightItem = None - - if gid < leftVectorLength then - leftItem <- leftVector.[gid] - - if gid < rightVectorLength then - rightItem <- rightVector.[gid] - if gid < resultLength then - match leftItem, rightItem with + match leftVector[gid], rightVector[gid] with | Some left, Some right -> resultVector.[gid] <- (%opAdd) (Both(left, right)) | Some left, None -> resultVector.[gid] <- (%opAdd) (Left left) | None, Some right -> resultVector.[gid] <- (%opAdd) (Right right) - | None, None -> resultVector.[gid] <- None @> + | _ -> resultVector.[gid] <- None @> let kernel = clContext.Compile(eWiseAdd) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> - let resultLength = max leftVector.Length rightVector.Length - let resultVector = clContext.CreateClArray( - resultLength, + leftVector.Length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, allocationMode = AllocationMode.Default ) let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) + Range1D.CreateValid(leftVector.Length, workGroupSize) let kernel = kernel.GetKernel() @@ -58,8 +47,6 @@ module DenseVector = kernel.KernelFunc ndRange leftVector.Length - rightVector.Length - resultLength leftVector rightVector resultVector) diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index d82fdcd7..bbfe4b17 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -534,6 +534,63 @@ module Generators = <| Arb.generate |> Arb.fromGen + type PairOfVectorsOfEqualSize() = + static let pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) = + gen { + let! length = Gen.sized <| fun size -> Gen.choose (1, size) + + let! leftArray = Gen.arrayOfLength length valuesGenerator + + let! rightArray = Gen.arrayOfLength length valuesGenerator + + return (leftArray, rightArray) + } + + static member IntType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfVectorsOfEqualSize + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> 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 module Utils = type TestContext = @@ -552,7 +609,8 @@ module Utils = typeof typeof typeof - typeof ] } + typeof + typeof ] } let rec cartesian listOfLists = match listOfLists with diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs index 19d16c51..dad367f7 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs @@ -83,16 +83,10 @@ let correctnessGenericTest op (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) (toCoo: MailboxProcessor<_> -> ClVector<'c> -> ClVector<'c>) - leftFilter - rightFilter case - (leftArray: 'a []) - (rightArray: 'b []) + (leftArray: 'a [], rightArray: 'b []) = - let leftArray = leftFilter leftArray - let rightArray = rightFilter rightArray - let leftNNZCount = NNZCountCount leftArray (leftIsEqual leftZero) @@ -126,7 +120,8 @@ let correctnessGenericTest checkResult resultIsEqual leftZero rightZero resultZero op actual leftArray rightArray with - | :? OpenCL.Net.Cl.Exception as ex -> logger.debug (eventX $"exception: {ex.Message}") + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let addTestFixtures case = let config = defaultConfig @@ -143,10 +138,10 @@ let addTestFixtures case = Vector.elementWiseAddAtLeastOne context intSumAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo id id + |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") - let toFloatCoo = Vector.toCoo context wgSize + let floatToCoo = Vector.toCoo context wgSize let floatAddFun = Vector.elementWiseAddAtLeastOne context floatSumAtLeastOne wgSize @@ -155,7 +150,7 @@ let addTestFixtures case = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y case - |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun toFloatCoo fFilter fFilter + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun floatToCoo |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolToCoo = Vector.toCoo context wgSize @@ -164,7 +159,7 @@ let addTestFixtures case = Vector.elementWiseAddAtLeastOne context boolSumAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo id id + |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteToCoo = Vector.toCoo context wgSize @@ -173,7 +168,7 @@ let addTestFixtures case = Vector.elementWiseAddAtLeastOne context byteSumAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo id id + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let addTests = @@ -195,10 +190,10 @@ let mulTestFixtures case = Vector.elementWiseAddAtLeastOne context intMulAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo id id + |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") - let toFloatCoo = Vector.toCoo context wgSize + let floatToCoo = Vector.toCoo context wgSize let floatMulFun = Vector.elementWiseAddAtLeastOne context floatMulAtLeastOne wgSize @@ -207,7 +202,7 @@ let mulTestFixtures case = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y case - |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun toFloatCoo fFilter fFilter + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun floatToCoo |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolToCoo = Vector.toCoo context wgSize @@ -216,7 +211,7 @@ let mulTestFixtures case = Vector.elementWiseAddAtLeastOne context boolMulAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo id id + |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteToCoo = Vector.toCoo context wgSize @@ -225,7 +220,7 @@ let mulTestFixtures case = Vector.elementWiseAddAtLeastOne context byteMulAtLeastOne wgSize case - |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo id id + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let mulTests = diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs index ab4bf2e4..1455673a 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs @@ -16,13 +16,6 @@ let NNZCountCount array isZero = Array.filter (fun item -> not <| isZero item) array |> Array.length -let fFilter = - fun item -> - System.Double.IsNaN item - || System.Double.IsInfinity item - >> not - |> Array.filter - let checkResult (resultIsEqual: 'a -> 'a -> bool) (maskIsEqual: 'b -> 'b -> bool) @@ -66,30 +59,19 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) (maskFormat: VectorFormat) - vectorFilter - maskFilter + (isValueValid: 'a -> bool) case - (vector: 'a []) - (mask: 'b []) + (vector: 'a [], mask: 'b []) (value: 'a) = - let vector = vectorFilter vector - - let mask = maskFilter mask - let vectorNNZ = NNZCountCount vector (vectorIsZero vectorZero) let maskNNZ = NNZCountCount mask (maskIsEqual maskZero) - let valueNNZCount = - Array.create 1 value - |> vectorFilter - |> Array.length - - if vectorNNZ > 0 && maskNNZ > 0 && valueNNZCount > 0 then + if vectorNNZ > 0 && maskNNZ > 0 && isValueValid value then let q = case.ClContext.Queue let context = case.ClContext.ClContext @@ -118,7 +100,8 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> checkResult vectorIsZero maskIsEqual vectorZero maskZero actual vector mask value with - | :? OpenCL.Net.Cl.Exception as ex -> logger.debug (eventX $"exception: {ex.Message}") + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let testFixtures case = let config = defaultConfig @@ -137,7 +120,7 @@ let testFixtures case = let intToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Sparse id id + |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Sparse (fun item -> true) |> testPropertyWithConfig config (getCorrectnessTestName "int" "Sparse") let floatFill = Vector.fillSubVector context wgSize @@ -145,7 +128,7 @@ let testFixtures case = let floatToCoo = Vector.toCoo context wgSize case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Sparse fFilter fFilter + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Sparse System.Double.IsNormal |> testPropertyWithConfig config (getCorrectnessTestName "float" "Sparse") let byteFill = Vector.fillSubVector context wgSize @@ -153,7 +136,7 @@ let testFixtures case = let byteToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Sparse id id + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Sparse (fun item -> true) |> testPropertyWithConfig config (getCorrectnessTestName "byte" "Sparse") let boolFill = Vector.fillSubVector context wgSize @@ -161,7 +144,7 @@ let testFixtures case = let boolToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Sparse id id + |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Sparse (fun item -> true) |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Sparse") let intFill = Vector.fillSubVector context wgSize @@ -169,7 +152,7 @@ let testFixtures case = let intToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Dense id id + |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Dense (fun item -> true) |> testPropertyWithConfig config (getCorrectnessTestName "int" "Dense") let floatFill = Vector.fillSubVector context wgSize @@ -177,7 +160,7 @@ let testFixtures case = let floatToCoo = Vector.toCoo context wgSize case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Dense fFilter fFilter + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Dense System.Double.IsNormal |> testPropertyWithConfig config (getCorrectnessTestName "float" "Dense") let byteFill = Vector.fillSubVector context wgSize @@ -185,7 +168,7 @@ let testFixtures case = let byteToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Dense id id + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Dense (fun item -> true) |> testPropertyWithConfig config (getCorrectnessTestName "byte" "Dense") let boolFill = Vector.fillSubVector context wgSize @@ -193,7 +176,7 @@ let testFixtures case = let boolToCoo = Vector.toCoo context wgSize case - |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense id id + |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense (fun item -> true) |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] let tests = diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index f133f2d3..ee8e4e2c 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -9,12 +9,6 @@ open OpenCL.Net let logger = Log.create "Vector.ofList.Tests" -let filter elements = - List.filter - <| (fun item -> fst item >= 0) - <| elements - |> List.distinctBy fst - let checkResult (isEqual: 'a -> 'a -> bool) (expectedIndices: int []) (expectedValues: 'a []) (actual: Vector<'a>) = Expect.equal actual.Size (Array.max expectedIndices + 1) "lengths must be the same" @@ -30,10 +24,13 @@ let correctnessGenericTest<'a when 'a: struct> (ofList: VectorFormat -> (int * 'a) list -> ClVector<'a>) (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) - (elements: (int * 'a) list) + (elements: (int * 'a) []) = - let elements = filter elements + let elements = + elements + |> Array.distinctBy fst + |> List.ofArray if elements.Length > 0 then From 6c4f541fc186cbce313fe70b18c1463192e3aed6 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 6 Nov 2022 13:14:54 +0300 Subject: [PATCH 55/74] refactor: use scatter in SparseVector.setPositions --- .../Vector/SparseVector/SparseVector.fs | 43 +++---------------- 1 file changed, 6 insertions(+), 37 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 26e0156c..350dcfc3 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -269,31 +269,17 @@ module SparseVector = let private setPositions<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - let setPositions = - <@ fun (ndRange: Range1D) prefixSumArrayLength resultLength (allValues: ClArray<'a>) (allIndices: ClArray) (prefixSumBuffer: ClArray) (resultValues: ClArray<'a>) (resultIndices: ClArray) -> - - let i = ndRange.GlobalID0 - let index = prefixSumBuffer.[i] - - if i < prefixSumArrayLength - 1 - && index <> prefixSumBuffer.[i + 1] - || (i = prefixSumArrayLength - 1 - && index < resultLength) then - - resultValues.[index] <- allValues.[i] - resultIndices.[index] <- allIndices.[i] @> - - let kernel = clContext.Compile(setPositions) - let sum = ClArray.prefixSumExcludeInplace clContext workGroupSize + let valuesScatter = Scatter.runInplace clContext workGroupSize + + let indicesScatter = Scatter.runInplace clContext workGroupSize + let resultLength = Array.zeroCreate 1 fun (processor: MailboxProcessor<_>) (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> - let prefixSumArrayLength = positions.Length - let resultLengthGpu = clContext.CreateClCell 0 let _, r = sum processor positions resultLengthGpu @@ -322,26 +308,9 @@ module SparseVector = allocationMode = AllocationMode.Default ) - let ndRange = - Range1D.CreateValid(prefixSumArrayLength, workGroupSize) + valuesScatter processor positions allValues resultValues - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - prefixSumArrayLength - resultLength - allValues - allIndices - positions - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + indicesScatter processor positions allIndices resultIndices resultValues, resultIndices From 22cc3ca0f0a48e8292d4cd53a77de7c7ebf921f8 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 6 Nov 2022 18:11:44 +0300 Subject: [PATCH 56/74] build: pass locally --- .../Vector/DenseVector/DenseVector.fs | 10 ++------- .../Vector/SparseVector/SparseVector.fs | 6 ++++-- tests/GraphBLAS-sharp.Tests/Helpers.fs | 21 +++++++------------ .../VectorOperations/OfList.fs | 4 +--- 4 files changed, 14 insertions(+), 27 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 6de2419a..993c96e0 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -18,7 +18,7 @@ module DenseVector = let gid = ndRange.GlobalID0 if gid < resultLength then - match leftVector[gid], rightVector[gid] with + match leftVector.[gid], rightVector.[gid] with | Some left, Some right -> resultVector.[gid] <- (%opAdd) (Both(left, right)) | Some left, None -> resultVector.[gid] <- (%opAdd) (Left left) | None, Some right -> resultVector.[gid] <- (%opAdd) (Right right) @@ -43,13 +43,7 @@ module DenseVector = processor.Post( Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftVector.Length - leftVector - rightVector - resultVector) + (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector rightVector resultVector) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 350dcfc3..2a4f572a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -272,9 +272,11 @@ module SparseVector = let sum = ClArray.prefixSumExcludeInplace clContext workGroupSize - let valuesScatter = Scatter.runInplace clContext workGroupSize + let valuesScatter = + Scatter.runInplace clContext workGroupSize - let indicesScatter = Scatter.runInplace clContext workGroupSize + let indicesScatter = + Scatter.runInplace clContext workGroupSize let resultLength = Array.zeroCreate 1 diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index bbfe4b17..9d8ff4e9 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -558,38 +558,31 @@ module Generators = |> Arb.fromGen static member SByteType() = - pairOfVectorsOfEqualSize - <| Arb.generate + pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen static member ByteType() = - pairOfVectorsOfEqualSize - <| Arb.generate + pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen static member Int16Type() = - pairOfVectorsOfEqualSize - <| Arb.generate + pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen static member UInt16Type() = - pairOfVectorsOfEqualSize - <| Arb.generate + pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen static member Int32Type() = - pairOfVectorsOfEqualSize - <| Arb.generate + pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen static member UInt32Type() = - pairOfVectorsOfEqualSize - <| Arb.generate + pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen static member BoolType() = - pairOfVectorsOfEqualSize - <| Arb.generate + pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen module Utils = diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index ee8e4e2c..8a078bd6 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -28,9 +28,7 @@ let correctnessGenericTest<'a when 'a: struct> = let elements = - elements - |> Array.distinctBy fst - |> List.ofArray + elements |> Array.distinctBy fst |> List.ofArray if elements.Length > 0 then From 286b78f75516071def457dafef4c03d6ee04a4b7 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 10 Nov 2022 18:29:55 +0300 Subject: [PATCH 57/74] add: complementedMask operation, DenseVector.elementWise --- .../Common/StandardOperations.fs | 7 ++++ .../Vector/DenseVector/DenseVector.fs | 40 +++++++++++++++++++ 2 files changed, 47 insertions(+) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 24c4682a..3100cf7b 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -107,3 +107,10 @@ module StandardOperations = match value with | Left left -> Some left | _ -> Some res @> + + let complementedMask<'a, 'b when 'a: struct and 'b: struct> res = + <@ fun (left: 'a option) (right: 'b option) -> + match left, right with + | Some left, Some _-> Some left + | None, Some _ -> None + | _ -> Some res @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 993c96e0..ac16f736 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -6,6 +6,46 @@ open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Quotations module DenseVector = + let elementWise<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + (workGroupSize: int) + = + + let eWiseAdd = + <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + + let gid = ndRange.GlobalID0 + + if gid < resultLength then + resultVector.[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] @> + + let kernel = clContext.Compile(eWiseAdd) + + fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> + + let resultVector = + clContext.CreateClArray( + leftVector.Length, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let ndRange = + Range1D.CreateValid(leftVector.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector rightVector resultVector) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultVector + let elementWiseAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) (opAdd: Expr -> 'c option>) From 4281f95d8c78fff5f30972141e23fac5b3af834b Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 11 Nov 2022 09:39:46 +0300 Subject: [PATCH 58/74] add: PapseVector.toDense, tests --- .../Vector/DenseVector/DenseVector.fs | 2 +- .../Vector/SparseVector/SparseVector.fs | 119 ++------- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 41 ++- .../MatrixElementwiseTests.fs | 8 +- .../BackendCommonTests/TransposeTests.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 2 +- tests/GraphBLAS-sharp.Tests/Program.fs | 52 ++-- .../VectorOperations/Complemented.fs | 242 +++++++++--------- .../VectorOperations/Convert.fs | 89 ++++--- .../VectorOperations/Copy.fs | 2 +- .../VectorOperations/ElementWiseAtLeastOne.fs | 20 +- .../VectorOperations/FillSubVector.fs | 18 +- .../VectorOperations/OfList.fs | 10 +- .../VectorOperations/Reduce.fs | 3 +- .../VectorOperations/ZeroCreate.fs | 2 +- 15 files changed, 271 insertions(+), 341 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index ac16f736..a7b59b3a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -261,7 +261,7 @@ module DenseVector = resultValues, resultIndices - let toCoo<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + let toSparse<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let getValuesAndIndices = getValuesAndIndices clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 2a4f572a..f25aaea2 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -367,125 +367,38 @@ module SparseVector = fun (processor: MailboxProcessor<_>) (leftVector: ClSparseVector<'a>) (rightVector: ClSparseVector<'b>) -> eWiseAdd processor leftVector rightVector - let preparePositionsComplemented (clContext: ClContext) (workGroupSize: int) = - - let preparePositions = - <@ fun (ndRange: Range1D) indicesArrayLength (inputIndices: ClArray) (positions: ClArray) -> + let toDense (clContext: ClContext) (workGroupSize: int) = + let toDense = + <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (indices: ClArray) (resultArray: ClArray<'a option>) -> let gid = ndRange.GlobalID0 - if gid < indicesArrayLength then - let index = inputIndices.[gid] - - positions.[index] <- 0 @> - - let kernel = clContext.Compile(preparePositions) - - let creat = ClArray.create clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (inputIndices: ClArray) (vectorSize: int) -> - - let positions = creat processor vectorSize 1 - - let ndRange = - Range1D.CreateValid(inputIndices.Length, workGroupSize) + if gid < length then + let index = indices.[gid] - let kernel = kernel.GetKernel() + resultArray.[index] <- Some values.[gid] @> - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputIndices.Length inputIndices positions) - ) + let kernel = clContext.Compile(toDense) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - positions - - let setPositionsComplemented (clContext: ClContext) (workGroupSize: int) = - - let setPositions = - <@ fun (ndRange: Range1D) length (positions: ClArray) (resultIndices: ClArray) -> - - let gid = ndRange.GlobalID0 - - if gid = length - 1 - || gid < length - && positions.[gid] <> positions.[gid + 1] then - let index = positions.[gid] - - resultIndices.[index] <- gid @> - - let kernel = clContext.Compile(setPositions) - - let sum = - ClArray.prefixSumExcludeInplace clContext workGroupSize - - let resultLength = Array.zeroCreate 1 - - fun (processor: MailboxProcessor<_>) (positions: ClArray) -> - - let prefixArrayLenght = positions.Length - - let resultLengthGpu = clContext.CreateClCell 0 - - let _, r = sum processor positions resultLengthGpu - - let resultLength = - let res = - processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(r, resultLength, ch)) + fun (processor: MailboxProcessor<_>) (vector: ClSparseVector<'a>) -> - processor.Post(Msg.CreateFreeMsg<_>(r)) + let resultArray = zeroCreate processor vector.Size - res.[0] - - let resultIndices = - clContext.CreateClArray( - resultLength, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.Default - ) - - let ndRange = - Range1D.CreateValid(prefixArrayLenght, workGroupSize) + let ndRange = Range1D.CreateValid(vector.Indices.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange prefixArrayLenght positions resultIndices) + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultArray) ) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - resultIndices - - let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - - let preparePositions = - preparePositionsComplemented clContext workGroupSize - - let create = - ClArray.zeroCreate clContext workGroupSize + processor.Post(Msg.CreateRunMsg(kernel)) - let setPositions = - setPositionsComplemented clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (vector: ClSparseVector<'a>) -> - - let positions = - preparePositions processor vector.Indices vector.Size - - let resultIndices = setPositions processor positions - - let resultLenght = resultIndices.Length - - let (ResultValues: ClArray<'a>) = create processor resultLenght - - processor.Post(Msg.CreateFreeMsg<_>(positions)) - - { Context = clContext - Indices = resultIndices - Values = ResultValues - Size = vector.Size } + resultArray let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 3ff8d993..b21ea870 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -8,7 +8,6 @@ open GraphBLAS.FSharp.Backend.Common module Vector = let zeroCreate (clContext: ClContext) (workGroupSize: int) = - let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -69,19 +68,31 @@ module Vector = let mask = copy - let toCoo (clContext: ClContext) (workGroupSize: int) = - let toCoo = - DenseVector.toCoo clContext workGroupSize + let toSparse (clContext: ClContext) (workGroupSize: int) = + let toSparse = + DenseVector.toSparse clContext workGroupSize let copy = copy clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorDense vector -> ClVectorSparse <| toCoo processor vector + | ClVectorDense vector -> ClVectorSparse <| toSparse processor vector | ClVectorSparse _ -> copy processor vector - let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = + let toDense (clContext: ClContext) (workGroupSize: int) = + let toDense = + SparseVector.toDense clContext workGroupSize + + let copy = ClArray.copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + match vector with + | ClVectorDense vector -> + ClVectorDense <| copy processor vector + | ClVectorSparse vector -> + ClVectorDense <| toDense processor vector + let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let addCoo = SparseVector.elementWiseAtLeastOne clContext opAdd workGroupSize @@ -102,10 +113,10 @@ module Vector = DenseVector.fillSubVector clContext workGroupSize let toCooVector = - DenseVector.toCoo clContext workGroupSize + DenseVector.toSparse clContext workGroupSize let toCooMask = - DenseVector.toCoo clContext workGroupSize + DenseVector.toSparse clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> match vector, maskVector with @@ -126,20 +137,6 @@ module Vector = ClVectorDense <| denseFillVector value processor vector mask - let complemented (clContext: ClContext) (workGroupSize: int) = - let cooComplemented = - SparseVector.complemented clContext workGroupSize - - let denseComplemented = - DenseVector.complemented clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> - match vector with - | ClVectorSparse vector -> ClVectorSparse <| cooComplemented processor vector - | ClVectorDense vector -> - ClVectorDense - <| denseComplemented processor vector - let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let cooReduce = SparseVector.reduce clContext workGroupSize opAdd diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs index 1e2eb5f7..c9624611 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs @@ -135,7 +135,7 @@ let testFixturesEWiseAdd case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddTests = - getTestFromFixtures testFixturesEWiseAdd "Backend.Matrix.EWiseAdd tests" + testsWithFixtures testFixturesEWiseAdd "Backend.Matrix.EWiseAdd tests" let testFixturesEWiseAddAtLeastOne case = [ let config = defaultConfig @@ -185,7 +185,7 @@ let testFixturesEWiseAddAtLeastOne case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddAtLeastOneTests = - getTestFromFixtures testFixturesEWiseAddAtLeastOne "Backend.Matrix.EWiseAddAtLeastOne tests" + testsWithFixtures testFixturesEWiseAddAtLeastOne "Backend.Matrix.EWiseAddAtLeastOne tests" let testFixturesEWiseAddAtLeastOneToCOO case = [ let config = defaultConfig @@ -235,7 +235,7 @@ let testFixturesEWiseAddAtLeastOneToCOO case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddAtLeastOneToCOOTests = - getTestFromFixtures testFixturesEWiseAddAtLeastOneToCOO "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" + testsWithFixtures testFixturesEWiseAddAtLeastOneToCOO "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" let testFixturesEWiseMulAtLeastOne case = [ let config = defaultConfig @@ -285,4 +285,4 @@ let testFixturesEWiseMulAtLeastOne case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseMulAtLeastOneTests = - getTestFromFixtures testFixturesEWiseMulAtLeastOne "Backend.Matrix.eWiseMulAtLeastOne tests" + testsWithFixtures testFixturesEWiseMulAtLeastOne "Backend.Matrix.eWiseMulAtLeastOne tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs index 3d474ed9..83efea8a 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs @@ -173,4 +173,4 @@ let testFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "bool (twice transpose)") ] let tests = - getTestFromFixtures testFixtures "Transpose tests" + testsWithFixtures testFixtures "Transpose tests" diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 9d8ff4e9..d34de4e2 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -740,7 +740,7 @@ module Utils = <| expected.[i] |> failtestf "%s" - let getTestFromFixtures<'a when 'a: equality> testFixtures name = + let testsWithFixtures<'a when 'a: equality> testFixtures name = testCases<'a> |> List.filter (fun case -> diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 4e45ac16..ddbb2e07 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -11,32 +11,34 @@ open GraphBLAS.FSharp.IO let allTests = testList "All tests" - [ Backend.Mxm.tests - Backend.BitonicSort.tests - Backend.PrefixSum.tests - Backend.Scatter.tests - Backend.Convert.tests - Backend.RemoveDuplicates.tests - Backend.Copy.tests - Backend.Replicate.tests - //Backend.Elementwise.elementwiseAddTests - //Backend.Elementwise.elementwiseAddAtLeastOneTests - //Backend.Elementwise.elementwiseAddAtLeastOneToCOOTests - //Backend.Elementwise.elementwiseMulAtLeastOneTests - Backend.Transpose.tests - //Matrix.GetTuples.tests - //Matrix.Mxv.tests - //Algo.Bfs.tests - Backend.Reduce.tests - Backend.Vector.ZeroCreate.tests - Backend.Vector.OfList.tests - Backend.Vector.Copy.tests + [ + // [ Backend.Mxm.tests + // Backend.BitonicSort.tests + // Backend.PrefixSum.tests + // Backend.Scatter.tests + // Backend.Convert.tests + // Backend.RemoveDuplicates.tests + // Backend.Copy.tests + // Backend.Replicate.tests + // //Backend.Elementwise.elementwiseAddTests + // //Backend.Elementwise.elementwiseAddAtLeastOneTests + // //Backend.Elementwise.elementwiseAddAtLeastOneToCOOTests + // //Backend.Elementwise.elementwiseMulAtLeastOneTests + // Backend.Transpose.tests + // //Matrix.GetTuples.tests + // //Matrix.Mxv.tests + // //Algo.Bfs.tests + // Backend.Reduce.tests + // Backend.Vector.ZeroCreate.tests + // Backend.Vector.OfList.tests + // Backend.Vector.Copy.tests Backend.Vector.Convert.tests - Backend.Vector.ElementWiseAddAtLeastOne.addTests - Backend.Vector.ElementWiseAddAtLeastOne.mulTests - Backend.Vector.FillSubVector.tests - Backend.Vector.Complemented.tests - Backend.Vector.Reduce.tests ] + // Backend.Vector.ElementWiseAddAtLeastOne.addTests + // Backend.Vector.ElementWiseAddAtLeastOne.mulTests + // Backend.Vector.FillSubVector.tests + // Backend.Vector.Complemented.tests + // Backend.Vector.Reduce.tests ] + ] |> testSequenced [] diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs index c575163c..2ea36a8c 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs @@ -1,122 +1,122 @@ module Backend.Vector.Complemented - -open Expecto -open Expecto.Logging -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Tests.Utils -open OpenCL.Net - -let logger = Log.create "Vector.complemented.Tests" - -let NNZCountCount array isZero = - Array.filter (fun item -> not <| isZero item) array - |> Array.length - -let fFilter = - fun item -> - System.Double.IsNaN item - || System.Double.IsInfinity item - >> not - |> Array.filter - -let checkResult isEqual zero (actual: Vector<'a>) (vector: 'a []) = - - let expectedArrayLength = vector.Length - - let expectedArray = Array.create expectedArrayLength 1 - - for i in 0 .. expectedArrayLength - 1 do - if not <| isEqual vector.[i] zero then - expectedArray.[i] <- 0 - - match actual with - | VectorSparse actual -> - let actualArray = Array.create expectedArrayLength 0 - - for i in 0 .. actual.Indices.Length - 1 do - actualArray.[actual.Indices.[i]] <- 1 - - $"arrays must have the same values and length" - |> compareArrays (=) actualArray expectedArray - | _ -> failwith "Vector format must be Sparse." - -let correctnessGenericTest - isEqual - zero - (complemented: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) - (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) - filter - case - (maskArray: 'a []) - = - - let maskArray = filter maskArray - - let maskNNZ = NNZCountCount maskArray (isEqual zero) - - if maskNNZ > 0 && maskNNZ < maskArray.Length - 1 then - let q = case.ClContext.Queue - let context = case.ClContext.ClContext - - let secondVector = - createVectorFromArray case.Format maskArray (isEqual zero) - - let clVector = secondVector.ToDevice context - - let res = complemented q clVector - - clVector.Dispose q - - let cooRes = toCoo q res - - res.Dispose q - - let actual = cooRes.ToHost q - - cooRes.Dispose q - - checkResult isEqual zero actual maskArray - -let testFixtures (case: OperationCase) = - let config = defaultConfig - - let getCorrectnessTestName dataType = - $"Correctness on %A{dataType}, %A{case.Format}" - - let wgSize = 32 - let context = case.ClContext.ClContext - - [ let intToCoo = Vector.toCoo context wgSize - - let intComplemented = Vector.complemented context wgSize - - case - |> correctnessGenericTest (=) 0 intComplemented intToCoo id - |> testPropertyWithConfig config (getCorrectnessTestName "int") - - let byteToCoo = Vector.toCoo context wgSize - - let byteComplemented = Vector.complemented context wgSize - - case - |> correctnessGenericTest (=) 0uy byteComplemented byteToCoo id - |> testPropertyWithConfig config (getCorrectnessTestName "byte") - - let floatToCoo = Vector.toCoo context wgSize - - let floatComplemented = Vector.complemented context wgSize - - case - |> correctnessGenericTest (=) 0.0 floatComplemented floatToCoo fFilter - |> testPropertyWithConfig config (getCorrectnessTestName "float") - - let boolToCoo = Vector.toCoo context wgSize - - let boolComplemented = Vector.complemented context wgSize - - case - |> correctnessGenericTest (=) false boolComplemented boolToCoo id - |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] - -let tests = - getTestFromFixtures testFixtures "Backend.Vector.complemented tests" +// +// open Expecto +// open Expecto.Logging +// open GraphBLAS.FSharp.Backend +// open GraphBLAS.FSharp.Tests.Utils +// open OpenCL.Net +// +// let logger = Log.create "Vector.complemented.Tests" +// +// let NNZCountCount array isZero = +// Array.filter (fun item -> not <| isZero item) array +// |> Array.length +// +// let fFilter = +// fun item -> +// System.Double.IsNaN item +// || System.Double.IsInfinity item +// >> not +// |> Array.filter +// +// let checkResult isEqual zero (actual: Vector<'a>) (vector: 'a []) = +// +// let expectedArrayLength = vector.Length +// +// let expectedArray = Array.create expectedArrayLength 1 +// +// for i in 0 .. expectedArrayLength - 1 do +// if not <| isEqual vector.[i] zero then +// expectedArray.[i] <- 0 +// +// match actual with +// | VectorSparse actual -> +// let actualArray = Array.create expectedArrayLength 0 +// +// for i in 0 .. actual.Indices.Length - 1 do +// actualArray.[actual.Indices.[i]] <- 1 +// +// $"arrays must have the same values and length" +// |> compareArrays (=) actualArray expectedArray +// | _ -> failwith "Vector format must be Sparse." +// +// let correctnessGenericTest +// isEqual +// zero +// (complemented: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) +// (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) +// filter +// case +// (maskArray: 'a []) +// = +// +// let maskArray = filter maskArray +// +// let maskNNZ = NNZCountCount maskArray (isEqual zero) +// +// if maskNNZ > 0 && maskNNZ < maskArray.Length - 1 then +// let q = case.ClContext.Queue +// let context = case.ClContext.ClContext +// +// let secondVector = +// createVectorFromArray case.Format maskArray (isEqual zero) +// +// let clVector = secondVector.ToDevice context +// +// let res = complemented q clVector +// +// clVector.Dispose q +// +// let cooRes = toCoo q res +// +// res.Dispose q +// +// let actual = cooRes.ToHost q +// +// cooRes.Dispose q +// +// checkResult isEqual zero actual maskArray +// +// let testFixtures (case: OperationCase) = +// let config = defaultConfig +// +// let getCorrectnessTestName dataType = +// $"Correctness on %A{dataType}, %A{case.Format}" +// +// let wgSize = 32 +// let context = case.ClContext.ClContext +// +// [ let intToCoo = Vector.toSparse context wgSize +// +// let intComplemented = Vector.complemented context wgSize +// +// case +// |> correctnessGenericTest (=) 0 intComplemented intToCoo id +// |> testPropertyWithConfig config (getCorrectnessTestName "int") +// +// let byteToCoo = Vector.toSparse context wgSize +// +// let byteComplemented = Vector.complemented context wgSize +// +// case +// |> correctnessGenericTest (=) 0uy byteComplemented byteToCoo id +// |> testPropertyWithConfig config (getCorrectnessTestName "byte") +// +// let floatToCoo = Vector.toSparse context wgSize +// +// let floatComplemented = Vector.complemented context wgSize +// +// case +// |> correctnessGenericTest (=) 0.0 floatComplemented floatToCoo fFilter +// |> testPropertyWithConfig config (getCorrectnessTestName "float") +// +// let boolToCoo = Vector.toSparse context wgSize +// +// let boolComplemented = Vector.complemented context wgSize +// +// case +// |> correctnessGenericTest (=) false boolComplemented boolToCoo id +// |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] +// +// let tests = +// testsWithFixtures testFixtures "Backend.Vector.complemented tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs index ee5e60ec..aebf04f6 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs @@ -13,18 +13,24 @@ let logger = let config = defaultConfig let wgSize = 32 -let makeTestDense isZero context q (toCOO: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (array: 'a []) = +let makeTest formatFrom (convertFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) isZero case (array: 'a []) = if array.Length > 0 then + let context = case.ClContext.ClContext + let q = case.ClContext.Queue + let vector = - createVectorFromArray VectorFormat.Dense array isZero + createVectorFromArray formatFrom array isZero let actual = - let clDenseVector = vector.ToDevice context - let clCooVector = toCOO q clDenseVector - let result = clCooVector.ToHost q - clCooVector.Dispose q - clDenseVector.Dispose q - result + let clVector = vector.ToDevice context + let convertedVector = convertFun q clVector + + let res = convertedVector.ToHost q + + clVector.Dispose q + convertedVector.Dispose q + + res logger.debug ( eventX "Actual is {actual}" @@ -32,41 +38,54 @@ let makeTestDense isZero context q (toCOO: MailboxProcessor<_> -> ClVector<'a> - ) let expected = - createVectorFromArray VectorFormat.Sparse array isZero + createVectorFromArray case.Format array isZero Expect.equal actual expected "Vectors must be the same" let testFixtures case = - let getCorrectnessTestName datatype = - sprintf "Correctness on %s, %A" datatype case.Format - - let filterFloat x = - System.Double.IsNaN x - || abs x < Accuracy.medium.absolute + let getCorrectnessTestName datatype formatFrom = + sprintf "Correctness on %s, %A -> %A" datatype formatFrom case.Format let context = case.ClContext.ClContext let q = case.ClContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) - - [ let toCoo = Vector.toCoo context wgSize - makeTestDense ((=) 0) context q toCoo - |> testPropertyWithConfig config (getCorrectnessTestName "int") - - let toCoo = Vector.toCoo context wgSize - - makeTestDense filterFloat context q toCoo - |> testPropertyWithConfig config (getCorrectnessTestName "float") - - let toCoo = Vector.toCoo context wgSize - - makeTestDense ((=) 0uy) context q toCoo - |> testPropertyWithConfig config (getCorrectnessTestName "byte") - - let toCoo = Vector.toCoo context wgSize + q.Error.Add(fun e -> failwithf "%A" e) - makeTestDense ((=) false) context q toCoo - |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] + match case.Format with + | Sparse -> + [ let convertFun = Vector.toSparse context wgSize + + listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) 0) case + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Vector.toSparse context wgSize + + listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) false) case + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat + | Dense -> + [ let convertFun = Vector.toDense context wgSize + + listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) 0) case + |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) + + let convertFun = Vector.toDense context wgSize + + listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest formatFrom convertFun ((=) false) case + |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] + |> List.concat let tests = - getTestFromFixtures testFixtures "Backend.Vector.Convert tests" + testsWithFixtures testFixtures "Backend.Vector.Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs index 5fcde86b..2081e138 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs @@ -95,4 +95,4 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let tests = - getTestFromFixtures testFixtures "Backend.Vector.copy tests" + testsWithFixtures testFixtures "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs index dad367f7..2d875c69 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs @@ -132,7 +132,7 @@ let addTestFixtures case = let wgSize = 32 let context = case.ClContext.ClContext - [ let toCoo = Vector.toCoo context wgSize + [ let toCoo = Vector.toSparse context wgSize let intAddFun = Vector.elementWiseAddAtLeastOne context intSumAtLeastOne wgSize @@ -141,7 +141,7 @@ let addTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") - let floatToCoo = Vector.toCoo context wgSize + let floatToCoo = Vector.toSparse context wgSize let floatAddFun = Vector.elementWiseAddAtLeastOne context floatSumAtLeastOne wgSize @@ -153,7 +153,7 @@ let addTestFixtures case = |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun floatToCoo |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") - let boolToCoo = Vector.toCoo context wgSize + let boolToCoo = Vector.toSparse context wgSize let boolAddFun = Vector.elementWiseAddAtLeastOne context boolSumAtLeastOne wgSize @@ -162,7 +162,7 @@ let addTestFixtures case = |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") - let byteToCoo = Vector.toCoo context wgSize + let byteToCoo = Vector.toSparse context wgSize let byteAddFun = Vector.elementWiseAddAtLeastOne context byteSumAtLeastOne wgSize @@ -172,7 +172,7 @@ let addTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let addTests = - getTestFromFixtures addTestFixtures "Backend.Vector.ElementWiseAtLeasOneAdd tests" + testsWithFixtures addTestFixtures "Backend.Vector.ElementWiseAtLeasOneAdd tests" let mulTestFixtures case = let config = defaultConfig @@ -184,7 +184,7 @@ let mulTestFixtures case = let context = case.ClContext.ClContext - [ let toCoo = Vector.toCoo context wgSize + [ let toCoo = Vector.toSparse context wgSize let intMulFun = Vector.elementWiseAddAtLeastOne context intMulAtLeastOne wgSize @@ -193,7 +193,7 @@ let mulTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") - let floatToCoo = Vector.toCoo context wgSize + let floatToCoo = Vector.toSparse context wgSize let floatMulFun = Vector.elementWiseAddAtLeastOne context floatMulAtLeastOne wgSize @@ -205,7 +205,7 @@ let mulTestFixtures case = |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun floatToCoo |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") - let boolToCoo = Vector.toCoo context wgSize + let boolToCoo = Vector.toSparse context wgSize let boolMulFun = Vector.elementWiseAddAtLeastOne context boolMulAtLeastOne wgSize @@ -214,7 +214,7 @@ let mulTestFixtures case = |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") - let byteToCoo = Vector.toCoo context wgSize + let byteToCoo = Vector.toSparse context wgSize let byteMulFun = Vector.elementWiseAddAtLeastOne context byteMulAtLeastOne wgSize @@ -224,4 +224,4 @@ let mulTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let mulTests = - getTestFromFixtures mulTestFixtures "Backend.Vector.ElementWiseAtLeasOneMul tests" + testsWithFixtures mulTestFixtures "Backend.Vector.ElementWiseAtLeasOneMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs index 1455673a..44d6e0e1 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs @@ -117,7 +117,7 @@ let testFixtures case = [ let intFill = Vector.fillSubVector context wgSize - let intToCoo = Vector.toCoo context wgSize + let intToCoo = Vector.toSparse context wgSize case |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Sparse (fun item -> true) @@ -125,7 +125,7 @@ let testFixtures case = let floatFill = Vector.fillSubVector context wgSize - let floatToCoo = Vector.toCoo context wgSize + let floatToCoo = Vector.toSparse context wgSize case |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Sparse System.Double.IsNormal @@ -133,7 +133,7 @@ let testFixtures case = let byteFill = Vector.fillSubVector context wgSize - let byteToCoo = Vector.toCoo context wgSize + let byteToCoo = Vector.toSparse context wgSize case |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Sparse (fun item -> true) @@ -141,7 +141,7 @@ let testFixtures case = let boolFill = Vector.fillSubVector context wgSize - let boolToCoo = Vector.toCoo context wgSize + let boolToCoo = Vector.toSparse context wgSize case |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Sparse (fun item -> true) @@ -149,7 +149,7 @@ let testFixtures case = let intFill = Vector.fillSubVector context wgSize - let intToCoo = Vector.toCoo context wgSize + let intToCoo = Vector.toSparse context wgSize case |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Dense (fun item -> true) @@ -157,7 +157,7 @@ let testFixtures case = let floatFill = Vector.fillSubVector context wgSize - let floatToCoo = Vector.toCoo context wgSize + let floatToCoo = Vector.toSparse context wgSize case |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Dense System.Double.IsNormal @@ -165,7 +165,7 @@ let testFixtures case = let byteFill = Vector.fillSubVector context wgSize - let byteToCoo = Vector.toCoo context wgSize + let byteToCoo = Vector.toSparse context wgSize case |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Dense (fun item -> true) @@ -173,11 +173,11 @@ let testFixtures case = let boolFill = Vector.fillSubVector context wgSize - let boolToCoo = Vector.toCoo context wgSize + let boolToCoo = Vector.toSparse context wgSize case |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense (fun item -> true) |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] let tests = - getTestFromFixtures testFixtures "Backend.Vector.fillSubVector tests" + testsWithFixtures testFixtures "Backend.Vector.fillSubVector tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs index 8a078bd6..af40817f 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs @@ -66,7 +66,7 @@ let testFixtures (case: OperationCase) = let boolOfList = Vector.ofList context - let toCoo = Vector.toCoo context wgSize + let toCoo = Vector.toSparse context wgSize case |> correctnessGenericTest (=) boolOfList toCoo @@ -74,7 +74,7 @@ let testFixtures (case: OperationCase) = let intOfList = Vector.ofList context - let toCoo = Vector.toCoo context wgSize + let toCoo = Vector.toSparse context wgSize case |> correctnessGenericTest (=) intOfList toCoo @@ -83,7 +83,7 @@ let testFixtures (case: OperationCase) = let byteOfList = Vector.ofList context - let toCoo = Vector.toCoo context wgSize + let toCoo = Vector.toSparse context wgSize case |> correctnessGenericTest (=) byteOfList toCoo @@ -91,11 +91,11 @@ let testFixtures (case: OperationCase) = let floatOfList = Vector.ofList context - let toCoo = Vector.toCoo context wgSize + let toCoo = Vector.toSparse context wgSize case |> correctnessGenericTest (=) floatOfList toCoo |> testPropertyWithConfig config (getCorrectnessTestName "float") ] let tests = - getTestFromFixtures testFixtures "Backend.Vector.ofList tests" + testsWithFixtures testFixtures "Backend.Vector.ofList tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs index 51852258..f4873244 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs @@ -16,7 +16,6 @@ let zeroFilter array isZero = <| array let checkResult zero op (actual: 'a) (vector: 'a []) = - let expected = Array.fold op zero vector "Results should be the same" @@ -136,4 +135,4 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "bool and") ] let tests = - getTestFromFixtures testFixtures "Backend.Vector.reduce tests" + testsWithFixtures testFixtures "Backend.Vector.reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs index 1919bb7e..3e38524a 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs @@ -76,4 +76,4 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] let tests = - getTestFromFixtures testFixtures "Backend.Vector.zeroCreate tests" + testsWithFixtures testFixtures "Backend.Vector.zeroCreate tests" From 04a09cc5209f3ebc0c89b0f2f39e7281af7db171 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 11 Nov 2022 10:41:35 +0300 Subject: [PATCH 59/74] add: Vector.elementWise --- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 10 +- .../MatrixElementwiseTests.fs | 8 +- .../BackendCommonTests/TransposeTests.fs | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 16 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 2 +- tests/GraphBLAS-sharp.Tests/Program.fs | 9 +- .../{VectorOperations => Vector}/Convert.fs | 2 +- .../{VectorOperations => Vector}/Copy.fs | 2 +- .../Vector/ElementWise.fs | 160 ++++++++++++++++++ .../ElementWiseAtLeasOne.fs} | 54 ++---- .../FillSubVector.fs | 2 +- .../{VectorOperations => Vector}/OfList.fs | 2 +- .../{VectorOperations => Vector}/Reduce.fs | 2 +- .../ZeroCreate.fs | 2 +- .../VectorOperations/Complemented.fs | 122 ------------- 15 files changed, 209 insertions(+), 186 deletions(-) rename tests/GraphBLAS-sharp.Tests/{VectorOperations => Vector}/Convert.fs (97%) rename tests/GraphBLAS-sharp.Tests/{VectorOperations => Vector}/Copy.fs (97%) create mode 100644 tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs rename tests/GraphBLAS-sharp.Tests/{VectorOperations/ElementWiseAtLeastOne.fs => Vector/ElementWiseAtLeasOne.fs} (76%) rename tests/GraphBLAS-sharp.Tests/{VectorOperations => Vector}/FillSubVector.fs (98%) rename tests/GraphBLAS-sharp.Tests/{VectorOperations => Vector}/OfList.fs (97%) rename tests/GraphBLAS-sharp.Tests/{VectorOperations => Vector}/Reduce.fs (97%) rename tests/GraphBLAS-sharp.Tests/{VectorOperations => Vector}/ZeroCreate.fs (96%) delete mode 100644 tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index b21ea870..e6cdb16b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -92,7 +92,7 @@ module Vector = | ClVectorSparse vector -> ClVectorDense <| toDense processor vector - let elementWiseAddAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = + let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let addCoo = SparseVector.elementWiseAtLeastOne clContext opAdd workGroupSize @@ -105,6 +105,14 @@ module Vector = | ClVectorDense left, ClVectorDense right -> ClVectorDense <| addDense processor left right | _ -> failwith "Vector formats are not matching." + let elementWise (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) (workGroupSize: int) = + let addDense = DenseVector.elementWise clContext opAdd workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVectorDense leftVector, ClVectorDense rightVector -> addDense processor leftVector rightVector + | _ -> failwith "Vector formats are not matching." + let fillSubVector (clContext: ClContext) (workGroupSize: int) = let cooFillVector = SparseVector.fillSubVector clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs index c9624611..3de0b94b 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixElementwiseTests.fs @@ -135,7 +135,7 @@ let testFixturesEWiseAdd case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddTests = - testsWithFixtures testFixturesEWiseAdd "Backend.Matrix.EWiseAdd tests" + testsWithOperationCase testFixturesEWiseAdd "Backend.Matrix.EWiseAdd tests" let testFixturesEWiseAddAtLeastOne case = [ let config = defaultConfig @@ -185,7 +185,7 @@ let testFixturesEWiseAddAtLeastOne case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddAtLeastOneTests = - testsWithFixtures testFixturesEWiseAddAtLeastOne "Backend.Matrix.EWiseAddAtLeastOne tests" + testsWithOperationCase testFixturesEWiseAddAtLeastOne "Backend.Matrix.EWiseAddAtLeastOne tests" let testFixturesEWiseAddAtLeastOneToCOO case = [ let config = defaultConfig @@ -235,7 +235,7 @@ let testFixturesEWiseAddAtLeastOneToCOO case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseAddAtLeastOneToCOOTests = - testsWithFixtures testFixturesEWiseAddAtLeastOneToCOO "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" + testsWithOperationCase testFixturesEWiseAddAtLeastOneToCOO "Backend.Matrix.EWiseAddAtLeastOneToCOO tests" let testFixturesEWiseMulAtLeastOne case = [ let config = defaultConfig @@ -285,4 +285,4 @@ let testFixturesEWiseMulAtLeastOne case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let elementwiseMulAtLeastOneTests = - testsWithFixtures testFixturesEWiseMulAtLeastOne "Backend.Matrix.eWiseMulAtLeastOne tests" + testsWithOperationCase testFixturesEWiseMulAtLeastOne "Backend.Matrix.eWiseMulAtLeastOne tests" diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs index 83efea8a..db2e56bb 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/TransposeTests.fs @@ -173,4 +173,4 @@ let testFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "bool (twice transpose)") ] let tests = - testsWithFixtures testFixtures "Transpose tests" + testsWithOperationCase testFixtures "Transpose tests" diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index a95956e3..4e248623 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -27,14 +27,14 @@ - - - - - - - - + + + + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index d34de4e2..e11e44dd 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -740,7 +740,7 @@ module Utils = <| expected.[i] |> failtestf "%s" - let testsWithFixtures<'a when 'a: equality> testFixtures name = + let testsWithOperationCase<'a when 'a: equality> testFixtures name = testCases<'a> |> List.filter (fun case -> diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index ddbb2e07..8c98d542 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -32,11 +32,12 @@ let allTests = // Backend.Vector.ZeroCreate.tests // Backend.Vector.OfList.tests // Backend.Vector.Copy.tests - Backend.Vector.Convert.tests - // Backend.Vector.ElementWiseAddAtLeastOne.addTests - // Backend.Vector.ElementWiseAddAtLeastOne.mulTests + // Backend.Vector.Convert.tests + // Backend.Vector.ElementWiseAtLeastOne.addTests + // Backend.Vector.ElementWiseAtLeastOne.mulTests + Backend.Vector.ElementWise.addTests + Backend.Vector.ElementWise.mulTests // Backend.Vector.FillSubVector.tests - // Backend.Vector.Complemented.tests // Backend.Vector.Reduce.tests ] ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs similarity index 97% rename from tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs rename to tests/GraphBLAS-sharp.Tests/Vector/Convert.fs index aebf04f6..46918a4b 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs @@ -88,4 +88,4 @@ let testFixtures case = |> List.concat let tests = - testsWithFixtures testFixtures "Backend.Vector.Convert tests" + testsWithOperationCase testFixtures "Backend.Vector.Convert tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs b/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs similarity index 97% rename from tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs rename to tests/GraphBLAS-sharp.Tests/Vector/Copy.fs index 2081e138..40db643b 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs @@ -95,4 +95,4 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "byte") ] let tests = - testsWithFixtures testFixtures "Backend.Vector.copy tests" + testsWithOperationCase testFixtures "Backend.Vector.copy tests" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs new file mode 100644 index 00000000..8c901376 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs @@ -0,0 +1,160 @@ +module Backend.Vector.ElementWise + +open Expecto +open Expecto.Logging +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Tests.Utils +open GraphBLAS.FSharp.Backend.Common +open StandardOperations + +let logger = + Log.create "Vector.ElementWise.Tests" + +let context = defaultContext.ClContext + +let q = defaultContext.Queue + +let config = defaultConfig + +let NNZCountCount array isZero = + Array.filter (fun item -> not <| isZero item) array + |> Array.length + +let checkResult + isEqual + resultZero + (op: 'a -> 'b -> 'c) + (actual: Vector<'c>) + (leftArray: 'a []) + (rightArray: 'b []) + = + + let expectedArrayLength = leftArray.Length + + let expectedArray = + Array.create expectedArrayLength resultZero + + for i in 0 .. expectedArrayLength - 1 do + expectedArray.[i] <- op leftArray.[i] rightArray.[i] + + let (VectorDense expected) = createVectorFromArray Dense expectedArray (isEqual resultZero) + + match actual with + | VectorDense actual -> + "arrays must have the same values" + |> Expect.equal actual expected + | _ -> failwith "Vector format must be Sparse." + +let correctnessGenericTest + leftIsEqual + rightIsEqual + resultIsEqual + leftZero + rightZero + resultZero + op + (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) + (leftArray: 'a [], rightArray: 'b []) + = + + let leftNNZCount = + NNZCountCount leftArray (leftIsEqual leftZero) + + let rightNNZCount = + NNZCountCount rightArray (rightIsEqual rightZero) + + if leftNNZCount > 0 && rightNNZCount > 0 then + + let firstVector = + createVectorFromArray Dense leftArray (leftIsEqual leftZero) + + let secondVector = + createVectorFromArray Dense rightArray (rightIsEqual rightZero) + + let v1 = firstVector.ToDevice context + let v2 = secondVector.ToDevice context + + try + let res = addFun q v1 v2 + + v1.Dispose q + v2.Dispose q + + let actual = res.ToHost q + + res.Dispose q + + checkResult resultIsEqual resultZero op actual leftArray rightArray + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex + +let addTestFixtures = + let getCorrectnessTestName fstType sndType thrType = + $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, Dense" + + let wgSize = 32 + + [ let intAddFun = + Vector.elementWiseAtLeastOne context intSumAtLeastOne wgSize + + correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun + |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") + + let floatAddFun = + Vector.elementWiseAtLeastOne context floatSumAtLeastOne wgSize + + let fIsEqual = + fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y + + correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun + |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") + + let boolAddFun = + Vector.elementWiseAtLeastOne context boolSumAtLeastOne wgSize + + correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun + |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") + + let byteAddFun = + Vector.elementWiseAtLeastOne context byteSumAtLeastOne wgSize + + correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun + |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] + +let addTests = testList "Backend.Vector.ElementWiseAdd tests" addTestFixtures + +let mulTestFixtures = + let getCorrectnessTestName fstType sndType thrType = + $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, Dense" + + let wgSize = 32 + + [ let intMulFun = + Vector.elementWiseAtLeastOne context intMulAtLeastOne wgSize + + correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun + |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") + + let floatMulFun = + Vector.elementWiseAtLeastOne context floatMulAtLeastOne wgSize + + let fIsEqual = + fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y + + correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun + |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") + + let boolMulFun = + Vector.elementWiseAtLeastOne context boolMulAtLeastOne wgSize + + correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun + |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") + + let byteMulFun = + Vector.elementWiseAtLeastOne context byteMulAtLeastOne wgSize + + correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun + |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] + +let mulTests = testList "Backend.Vector.ElementWiseMul tests" mulTestFixtures diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs b/tests/GraphBLAS-sharp.Tests/Vector/ElementWiseAtLeasOne.fs similarity index 76% rename from tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs rename to tests/GraphBLAS-sharp.Tests/Vector/ElementWiseAtLeasOne.fs index 2d875c69..343c1bc4 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ElementWiseAtLeastOne.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ElementWiseAtLeasOne.fs @@ -1,4 +1,4 @@ -module Backend.Vector.ElementWiseAddAtLeastOne +module Backend.Vector.ElementWiseAtLeastOne open Expecto open Expecto.Logging @@ -16,17 +16,8 @@ let NNZCountCount array isZero = Array.filter (fun item -> not <| isZero item) array |> Array.length -let fFilter = - fun item -> - System.Double.IsNaN item - || System.Double.IsInfinity item - >> not - |> Array.filter - let checkResult (isEqual: 'c -> 'c -> bool) - leftZero - rightZero resultZero (op: 'a -> 'b -> 'c) (actual: Vector<'c>) @@ -34,29 +25,13 @@ let checkResult (rightArray: 'b []) = - let expectedArrayLength = max leftArray.Length rightArray.Length - - let isLeftLess = leftArray.Length < rightArray.Length - - let lowBound = - if isLeftLess then - leftArray.Length - else - rightArray.Length + let expectedArrayLength = leftArray.Length let expectedArray = Array.create expectedArrayLength resultZero for i in 0 .. expectedArrayLength - 1 do - let item = - if i < lowBound then - op leftArray.[i] rightArray.[i] - elif isLeftLess then - op leftZero rightArray.[i] - else - op leftArray.[i] rightZero - - expectedArray.[i] <- item + expectedArray.[i] <- op leftArray.[i] rightArray.[i] match actual with | VectorSparse actual -> @@ -118,7 +93,7 @@ let correctnessGenericTest let actual = cooRes.ToHost q - checkResult resultIsEqual leftZero rightZero resultZero op actual leftArray rightArray + checkResult resultIsEqual resultZero op actual leftArray rightArray with | ex when ex.Message = "InvalidBufferSize" -> () | ex -> raise ex @@ -135,7 +110,7 @@ let addTestFixtures case = [ let toCoo = Vector.toSparse context wgSize let intAddFun = - Vector.elementWiseAddAtLeastOne context intSumAtLeastOne wgSize + Vector.elementWiseAtLeastOne context intSumAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun toCoo @@ -144,7 +119,7 @@ let addTestFixtures case = let floatToCoo = Vector.toSparse context wgSize let floatAddFun = - Vector.elementWiseAddAtLeastOne context floatSumAtLeastOne wgSize + Vector.elementWiseAtLeastOne context floatSumAtLeastOne wgSize let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y @@ -156,7 +131,7 @@ let addTestFixtures case = let boolToCoo = Vector.toSparse context wgSize let boolAddFun = - Vector.elementWiseAddAtLeastOne context boolSumAtLeastOne wgSize + Vector.elementWiseAtLeastOne context boolSumAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToCoo @@ -165,14 +140,14 @@ let addTestFixtures case = let byteToCoo = Vector.toSparse context wgSize let byteAddFun = - Vector.elementWiseAddAtLeastOne context byteSumAtLeastOne wgSize + Vector.elementWiseAtLeastOne context byteSumAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToCoo |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let addTests = - testsWithFixtures addTestFixtures "Backend.Vector.ElementWiseAtLeasOneAdd tests" + testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseAtLeasOneAdd tests" let mulTestFixtures case = let config = defaultConfig @@ -187,7 +162,7 @@ let mulTestFixtures case = [ let toCoo = Vector.toSparse context wgSize let intMulFun = - Vector.elementWiseAddAtLeastOne context intMulAtLeastOne wgSize + Vector.elementWiseAtLeastOne context intMulAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun toCoo @@ -196,7 +171,7 @@ let mulTestFixtures case = let floatToCoo = Vector.toSparse context wgSize let floatMulFun = - Vector.elementWiseAddAtLeastOne context floatMulAtLeastOne wgSize + Vector.elementWiseAtLeastOne context floatMulAtLeastOne wgSize let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y @@ -208,7 +183,7 @@ let mulTestFixtures case = let boolToCoo = Vector.toSparse context wgSize let boolMulFun = - Vector.elementWiseAddAtLeastOne context boolMulAtLeastOne wgSize + Vector.elementWiseAtLeastOne context boolMulAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToCoo @@ -217,11 +192,12 @@ let mulTestFixtures case = let byteToCoo = Vector.toSparse context wgSize let byteMulFun = - Vector.elementWiseAddAtLeastOne context byteMulAtLeastOne wgSize + Vector.elementWiseAtLeastOne context byteMulAtLeastOne wgSize case |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToCoo |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] let mulTests = - testsWithFixtures mulTestFixtures "Backend.Vector.ElementWiseAtLeasOneMul tests" + testsWithOperationCase mulTestFixtures "Backend.Vector.ElementWiseAtLeasOneMul tests" + diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs similarity index 98% rename from tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs rename to tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs index 44d6e0e1..90434361 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs @@ -180,4 +180,4 @@ let testFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] let tests = - testsWithFixtures testFixtures "Backend.Vector.fillSubVector tests" + testsWithOperationCase testFixtures "Backend.Vector.fillSubVector tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs similarity index 97% rename from tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs rename to tests/GraphBLAS-sharp.Tests/Vector/OfList.fs index af40817f..e43cbf5a 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs @@ -98,4 +98,4 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "float") ] let tests = - testsWithFixtures testFixtures "Backend.Vector.ofList tests" + testsWithOperationCase testFixtures "Backend.Vector.ofList tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs similarity index 97% rename from tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs rename to tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs index f4873244..b3c9bde5 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs @@ -135,4 +135,4 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "bool and") ] let tests = - testsWithFixtures testFixtures "Backend.Vector.reduce tests" + testsWithOperationCase testFixtures "Backend.Vector.reduce tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs similarity index 96% rename from tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs rename to tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs index 3e38524a..503f6cd5 100644 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs @@ -76,4 +76,4 @@ let testFixtures (case: OperationCase) = |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] let tests = - testsWithFixtures testFixtures "Backend.Vector.zeroCreate tests" + testsWithOperationCase testFixtures "Backend.Vector.zeroCreate tests" diff --git a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs b/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs deleted file mode 100644 index 2ea36a8c..00000000 --- a/tests/GraphBLAS-sharp.Tests/VectorOperations/Complemented.fs +++ /dev/null @@ -1,122 +0,0 @@ -module Backend.Vector.Complemented -// -// open Expecto -// open Expecto.Logging -// open GraphBLAS.FSharp.Backend -// open GraphBLAS.FSharp.Tests.Utils -// open OpenCL.Net -// -// let logger = Log.create "Vector.complemented.Tests" -// -// let NNZCountCount array isZero = -// Array.filter (fun item -> not <| isZero item) array -// |> Array.length -// -// let fFilter = -// fun item -> -// System.Double.IsNaN item -// || System.Double.IsInfinity item -// >> not -// |> Array.filter -// -// let checkResult isEqual zero (actual: Vector<'a>) (vector: 'a []) = -// -// let expectedArrayLength = vector.Length -// -// let expectedArray = Array.create expectedArrayLength 1 -// -// for i in 0 .. expectedArrayLength - 1 do -// if not <| isEqual vector.[i] zero then -// expectedArray.[i] <- 0 -// -// match actual with -// | VectorSparse actual -> -// let actualArray = Array.create expectedArrayLength 0 -// -// for i in 0 .. actual.Indices.Length - 1 do -// actualArray.[actual.Indices.[i]] <- 1 -// -// $"arrays must have the same values and length" -// |> compareArrays (=) actualArray expectedArray -// | _ -> failwith "Vector format must be Sparse." -// -// let correctnessGenericTest -// isEqual -// zero -// (complemented: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) -// (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) -// filter -// case -// (maskArray: 'a []) -// = -// -// let maskArray = filter maskArray -// -// let maskNNZ = NNZCountCount maskArray (isEqual zero) -// -// if maskNNZ > 0 && maskNNZ < maskArray.Length - 1 then -// let q = case.ClContext.Queue -// let context = case.ClContext.ClContext -// -// let secondVector = -// createVectorFromArray case.Format maskArray (isEqual zero) -// -// let clVector = secondVector.ToDevice context -// -// let res = complemented q clVector -// -// clVector.Dispose q -// -// let cooRes = toCoo q res -// -// res.Dispose q -// -// let actual = cooRes.ToHost q -// -// cooRes.Dispose q -// -// checkResult isEqual zero actual maskArray -// -// let testFixtures (case: OperationCase) = -// let config = defaultConfig -// -// let getCorrectnessTestName dataType = -// $"Correctness on %A{dataType}, %A{case.Format}" -// -// let wgSize = 32 -// let context = case.ClContext.ClContext -// -// [ let intToCoo = Vector.toSparse context wgSize -// -// let intComplemented = Vector.complemented context wgSize -// -// case -// |> correctnessGenericTest (=) 0 intComplemented intToCoo id -// |> testPropertyWithConfig config (getCorrectnessTestName "int") -// -// let byteToCoo = Vector.toSparse context wgSize -// -// let byteComplemented = Vector.complemented context wgSize -// -// case -// |> correctnessGenericTest (=) 0uy byteComplemented byteToCoo id -// |> testPropertyWithConfig config (getCorrectnessTestName "byte") -// -// let floatToCoo = Vector.toSparse context wgSize -// -// let floatComplemented = Vector.complemented context wgSize -// -// case -// |> correctnessGenericTest (=) 0.0 floatComplemented floatToCoo fFilter -// |> testPropertyWithConfig config (getCorrectnessTestName "float") -// -// let boolToCoo = Vector.toSparse context wgSize -// -// let boolComplemented = Vector.complemented context wgSize -// -// case -// |> correctnessGenericTest (=) false boolComplemented boolToCoo id -// |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] -// -// let tests = -// testsWithFixtures testFixtures "Backend.Vector.complemented tests" From f76e8acf486df883a86b7947a3b6819d98ed39f6 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 11 Nov 2022 17:11:57 +0300 Subject: [PATCH 60/74] add: DenseVector.elementwise --- .../Common/StandardOperations.fs | 23 +++-- .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Vector/DenseVector/DenseVector.fs | 90 ++++--------------- .../Vector/DenseVector/ElementwiseQuotes.fs | 62 +++++++++++++ src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 6 +- 5 files changed, 99 insertions(+), 83 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseQuotes.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 3100cf7b..ff055279 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -102,15 +102,20 @@ module StandardOperations = let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f - let maskAtLeastOne<'a, 'b when 'a: struct and 'b: struct> res = - <@ fun (value: AtLeastOne<'a, 'b>) -> - match value with + let mask<'a, 'b when 'a: struct and 'b: struct> = + <@ fun (left: 'a option) (right: 'b option) value -> + match left, right with + | _, None -> left + | _ -> Some value @> + + let maskAtLeastOne<'a, 'b when 'a: struct and 'b: struct> = + <@ fun (pair: AtLeastOne<'a, 'b>) value -> + match pair with | Left left -> Some left - | _ -> Some res @> + | _ -> Some value @> - let complementedMask<'a, 'b when 'a: struct and 'b: struct> res = - <@ fun (left: 'a option) (right: 'b option) -> + let complementedMask<'a, 'b when 'a: struct and 'b: struct> = + <@ fun (left: 'a option) (right: 'b option) value -> match left, right with - | Some left, Some _-> Some left - | None, Some _ -> None - | _ -> Some res @> + | _, Some _-> left + | _ -> Some value @> diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index f545b17e..0e343b84 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -34,6 +34,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index a7b59b3a..f935c33b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -12,15 +12,7 @@ module DenseVector = (workGroupSize: int) = - let eWiseAdd = - <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> - - let gid = ndRange.GlobalID0 - - if gid < resultLength then - resultVector.[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] @> - - let kernel = clContext.Compile(eWiseAdd) + let kernel = clContext.Compile(ElementwiseQuotes.kernel opAdd) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> @@ -52,19 +44,7 @@ module DenseVector = (workGroupSize: int) = - let eWiseAdd = - <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> - - let gid = ndRange.GlobalID0 - - if gid < resultLength then - match leftVector.[gid], rightVector.[gid] with - | Some left, Some right -> resultVector.[gid] <- (%opAdd) (Both(left, right)) - | Some left, None -> resultVector.[gid] <- (%opAdd) (Left left) - | None, Some right -> resultVector.[gid] <- (%opAdd) (Right right) - | _ -> resultVector.[gid] <- None @> - - let kernel = clContext.Compile(eWiseAdd) + let kernel = clContext.Compile(ElementwiseQuotes.atLeastOneKernel opAdd) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> @@ -90,66 +70,35 @@ module DenseVector = resultVector - let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) (scalar: 'a) = - - let eWiseAdd = - elementWiseAtLeastOne clContext (StandardOperations.maskAtLeastOne scalar) workGroupSize - - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) -> - - let clScalar = clContext.CreateClCell scalar - - let resultVector = eWiseAdd processor leftVector maskVector - - processor.Post(Msg.CreateFreeMsg<_>(maskVector)) - - processor.Post(Msg.CreateFreeMsg<_>(clScalar)) - - resultVector - - let complemented<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = - - let complemented = - <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a option>) (defaultValue: ClCell<'a>) (resultArray: ClArray<'a option>) -> - - let gid = ndRange.GlobalID0 - - if gid < length then - match inputArray.[gid] with - | None -> resultArray.[gid] <- Some defaultValue.Value - | _ -> () @> - - - let kernel = clContext.Compile(complemented) - - let create = - ClArray.zeroCreate clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - - let length = vector.Length + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> + (clContext: ClContext) + (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) + (workGroupSize: int) = - let resultArray = create processor length + let kernel = clContext.Compile(ElementwiseQuotes.fillSubVector maskOp) - let defaultValue = - clContext.CreateClCell Unchecked.defaultof<'a> + fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> + let resultArray = + clContext.CreateClArray( + leftVector.Length, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) let ndRange = - Range1D.CreateValid(length, workGroupSize) + Range1D.CreateValid(leftVector.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange length vector defaultValue resultArray) + Msg.MsgSetArguments(fun () -> + kernel.KernelFunc ndRange leftVector.Length leftVector maskVector value resultArray) ) - processor.Post(Msg.CreateRunMsg(kernel)) - - processor.Post(Msg.CreateFreeMsg(defaultValue)) - resultArray - let getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = + let private getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let getPositions = <@ fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray) -> @@ -202,7 +151,6 @@ module DenseVector = resultIndices.[index] <- gid | None -> () @> - let kernel = clContext.Compile(getValuesAndIndices) let getPositions = getBitmap clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseQuotes.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseQuotes.fs new file mode 100644 index 00000000..d113f96f --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseQuotes.fs @@ -0,0 +1,62 @@ +namespace GraphBLAS.FSharp.Backend + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common + +module ElementwiseQuotes = + let private elementWiseGeneralKernel writeOp = + <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + + let gid = ndRange.GlobalID0 + + if gid < resultLength then + (%writeOp) gid leftVector rightVector resultVector @> + + let private elementWiseWrite opAdd = + <@ + fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultArray: ClArray<'c option>) -> + resultArray.[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] + @> + + let private elementWiseAtLeastOneWrite opAdd = + <@ + fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultArray: ClArray<'c option>) -> + match leftVector.[gid], rightVector.[gid] with + | Some left, Some right -> resultArray.[gid] <- (%opAdd) (Both(left, right)) + | Some left, None -> resultArray.[gid] <- (%opAdd) (Left left) + | None, Some right -> resultArray.[gid] <- (%opAdd) (Right right) + | _ -> resultArray.[gid] <- None + @> + + let kernel opAdd = elementWiseGeneralKernel <| elementWiseWrite opAdd + + let atLeastOneKernel opAdd = elementWiseGeneralKernel <| elementWiseAtLeastOneWrite opAdd + + let private fillSubVectorGeneralKernel writeOp = + <@ + fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'c option>) -> + + let gid = ndRange.GlobalID0 + + if gid < resultLength then + (%writeOp) gid leftVector rightVector value.Value resultVector @> + + let private fillSubVectorWrite opAdd = + <@ + fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: 'a) (resultArray: ClArray<'c option>) -> + resultArray.[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] value + @> + + let private fillSubVectorAtLeastOneWrite opAdd = + <@ + fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (values: 'a) (resultArray: ClArray<'c option>) -> + match leftVector.[gid], rightVector.[gid] with + | Some left, Some right -> resultArray.[gid] <- (%opAdd) (Both(left, right)) values + | Some left, None -> resultArray.[gid] <- (%opAdd) (Left left) values + | None, Some right -> resultArray.[gid] <- (%opAdd) (Right right) values + | _ -> resultArray.[gid] <- None + @> + + let fillSubVector maskOp = fillSubVectorGeneralKernel <| fillSubVectorWrite maskOp + + let fillSubVectorAtLeastOne maskOp = fillSubVectorGeneralKernel <| fillSubVectorAtLeastOneWrite maskOp diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index e6cdb16b..cbac0fae 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -118,7 +118,7 @@ module Vector = SparseVector.fillSubVector clContext workGroupSize let denseFillVector = - DenseVector.fillSubVector clContext workGroupSize + DenseVector.fillSubVector clContext StandardOperations.mask workGroupSize let toCooVector = DenseVector.toSparse clContext workGroupSize @@ -126,7 +126,7 @@ module Vector = let toCooMask = DenseVector.toSparse clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: 'a) -> + fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: ClCell<'a>) -> match vector, maskVector with | ClVectorSparse vector, ClVectorSparse mask -> ClVectorSparse @@ -143,7 +143,7 @@ module Vector = <| cooFillVector value processor vector mask | ClVectorDense vector, ClVectorDense mask -> ClVectorDense - <| denseFillVector value processor vector mask + <| denseFillVector processor vector mask value let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let cooReduce = From 0ab45fabf31cb8df6ac757fb7bc06df8a4989f31 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 11 Nov 2022 21:12:50 +0300 Subject: [PATCH 61/74] refactor: SparseVector.fillSubVector, elementWise --- .../GraphBLAS-sharp.Backend.fsproj | 3 +- .../Vector/DenseVector/DenseVector.fs | 8 +- ...iseQuotes.fs => ElementwiseConstructor.fs} | 4 +- .../SparseVector/ElementwiseConstructor.fs | 207 ++++++++++++++ .../Vector/SparseVector/SparseVector.fs | 254 +++++++----------- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 3 +- 6 files changed, 312 insertions(+), 167 deletions(-) rename src/GraphBLAS-sharp.Backend/Vector/DenseVector/{ElementwiseQuotes.fs => ElementwiseConstructor.fs} (97%) create mode 100644 src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 0e343b84..083f1aef 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -33,8 +33,9 @@ + - + diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index f935c33b..10e4997c 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend +namespace GraphBLAS.FSharp.Backend.DenseVector open Brahma.FSharp open GraphBLAS.FSharp.Backend @@ -12,7 +12,7 @@ module DenseVector = (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseQuotes.kernel opAdd) + let kernel = clContext.Compile(ElementwiseConstructor.kernel opAdd) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> @@ -44,7 +44,7 @@ module DenseVector = (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseQuotes.atLeastOneKernel opAdd) + let kernel = clContext.Compile(ElementwiseConstructor.atLeastOneKernel opAdd) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> @@ -75,7 +75,7 @@ module DenseVector = (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseQuotes.fillSubVector maskOp) + let kernel = clContext.Compile(ElementwiseConstructor.fillSubVector maskOp) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> let resultArray = diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseQuotes.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs similarity index 97% rename from src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseQuotes.fs rename to src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs index d113f96f..26ea4cfd 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseQuotes.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs @@ -1,9 +1,9 @@ -namespace GraphBLAS.FSharp.Backend +namespace GraphBLAS.FSharp.Backend.DenseVector open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common -module ElementwiseQuotes = +module ElementwiseConstructor = let private elementWiseGeneralKernel writeOp = <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs new file mode 100644 index 00000000..fe8f6518 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs @@ -0,0 +1,207 @@ +namespace GraphBLAS.FSharp.Backend.SparseVector + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Quotations + +module ElementwiseConstructor = + 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) -> + + let i = ndRange.GlobalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 + + if localID < 2 then + let mutable x = localID * (workGroupSize - 1) + i - 1 + + if x >= sumOfSides then + x <- sumOfSides - 1 + + let diagonalNumber = x + + let mutable leftEdge = diagonalNumber + 1 - secondSide + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstSide - 1 + + if rightEdge > diagonalNumber then + rightEdge <- diagonalNumber + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = firstIndicesBuffer.[middleIdx] + + let secondIndex = + secondIndicesBuffer.[diagonalNumber - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + // Here localID equals either 0 or 1 + if localID = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge + + 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 + + if rightEdge > localID then + rightEdge <- localID + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] + + let secondIndex = + localIndices.[firstLocalLength + localID - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + let boundaryX = rightEdge + let boundaryY = localID - leftEdge + + // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) + let isValidX = boundaryX >= 0 + let isValidY = boundaryY >= 0 + + let mutable fstIdx = 0 + + if isValidX then + fstIdx <- localIndices.[boundaryX] + + let mutable sndIdx = 0 + + if isValidY then + sndIdx <- localIndices.[firstLocalLength + boundaryY] + + if not isValidX || isValidY && fstIdx <= sndIdx then + allIndicesBuffer.[i] <- sndIdx + secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + isLeftBitMap.[i] <- 0 + else + allIndicesBuffer.[i] <- fstIdx + firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitMap.[i] <- 1 @> + + let private both<'c> = + <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray) (allValuesBuffer: ClArray<'c>) -> + rawPositionsBuffer.[index] <- 0 + + match result with + | Some v -> + allValuesBuffer.[index + 1] <- v + rawPositionsBuffer.[index + 1] <- 1 + | None -> rawPositionsBuffer.[index + 1] <- 0 @> + + let private leftRight<'c> = + <@ fun index (leftResult: 'c option) (rightResult: 'c option) (isLeftBitmap: ClArray) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) -> + if isLeftBitmap.[index] = 1 then + match leftResult with + | Some v -> + allValuesBuffer.[index] <- v + rawPositionsBuffer.[index] <- 1 + | None -> rawPositionsBuffer.[index] <- 0 + else + match rightResult with + | Some v -> + allValuesBuffer.[index] <- v + rawPositionsBuffer.[index] <- 1 + | None -> rawPositionsBuffer.[index] <- 0 @> + + let preparePositionsAtLeastOne 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) (Both(leftValues.[gid], rightValues.[gid + 1])) + + (%both) gid result positions allValues + elif (gid < length + && gid > 0 + && allIndices.[gid - 1] <> allIndices.[gid]) + || gid = 0 then + + let leftResult = (%opAdd) (Left(leftValues.[gid])) + let rightResult = (%opAdd) (Right(rightValues.[gid])) + + (%leftRight) gid leftResult rightResult isLeft allValues positions @> + + let preparePositions (opAdd: Expr<'a option -> 'b option -> 'c option>) = + <@ 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]) + + (%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]) + + (%leftRight) gid leftResult rightResult isLeft allValues positions @> + + let preparePositionsFillSubVectorAtLeasOne opAdd = + <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> + + let gid = ndRange.GlobalID0 + + let value = value.Value + + if gid < length - 1 + && allIndices.[gid] = allIndices.[gid + 1] then + let result = (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value + + (%both) gid result positions allValues + elif (gid < length + && gid > 0 + && allIndices.[gid - 1] <> allIndices.[gid]) + || gid = 0 then + let leftResult = (%opAdd) (Left(leftValues.[gid])) value + let rightResult = (%opAdd) (Right(rightValues.[gid])) value + + (%leftRight) gid leftResult rightResult isLeft allValues positions @> + diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index f25aaea2..bb2d55f2 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend +namespace GraphBLAS.FSharp.Backend.SparseVector open Brahma.FSharp open GraphBLAS.FSharp.Backend @@ -9,121 +9,7 @@ open Microsoft.FSharp.Quotations module SparseVector = let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = - 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 mutable x = localID * (workGroupSize - 1) + i - 1 - - if x >= sumOfSides then - x <- sumOfSides - 1 - - let diagonalNumber = x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstSide - 1 - - if rightEdge > diagonalNumber then - rightEdge <- diagonalNumber - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] - - let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge - - 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 - - if rightEdge > localID then - rightEdge <- localID - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = localID - leftEdge - - // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) - let isValidX = boundaryX >= 0 - let isValidY = boundaryY >= 0 - - let mutable fstIdx = 0 - - if isValidX then - fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0 - - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx <= sndIdx then - allIndicesBuffer.[i] <- sndIdx - 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) + let kernel = clContext.Compile(ElementwiseConstructor.merge workGroupSize) fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (secondValues: ClArray<'b>) -> @@ -193,43 +79,12 @@ module SparseVector = allIndices, firstResultValues, secondResultValues, isLeftBitmap - let private preparePositionsAtLeasOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) - (opAdd: Expr -> 'c option>) + preparePositions (workGroupSize: int) = - let preparePositions = - <@ 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 - positions.[gid] <- 0 - - match (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) with - | Some value -> - allValues.[gid + 1] <- value - positions.[gid + 1] <- 1 - | None -> positions.[gid + 1] <- 0 - elif (gid < length - && gid > 0 - && allIndices.[gid - 1] <> allIndices.[gid]) - || gid = 0 then - if isLeft.[gid] = 1 then - match (%opAdd) (Left(leftValues.[gid])) with - | Some value -> - allValues.[gid] <- value - positions.[gid] <- 1 - | None -> positions.[gid] <- 0 - else - match (%opAdd) (Right(rightValues.[gid])) with - | Some value -> - allValues.[gid] <- value - positions.[gid] <- 1 - | None -> positions.[gid] <- 0 @> - let kernel = clContext.Compile(preparePositions) fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> @@ -237,7 +92,7 @@ module SparseVector = let length = allIndices.Length let allValues = - clContext.CreateClArray( + clContext.CreateClArray<'a>( length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, @@ -245,7 +100,7 @@ module SparseVector = ) let positions = - clContext.CreateClArray( + clContext.CreateClArray( length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, @@ -319,16 +174,16 @@ module SparseVector = ///. ///. ///Should be a power of 2 and greater than 1. - let elementWiseAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + let private elementWiseGeneral<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) - (opAdd: Expr -> 'c option>) + preparePositionsKernel (workGroupSize: int) = let merge = merge clContext workGroupSize let prepare = - preparePositionsAtLeasOne clContext opAdd workGroupSize + preparePositions clContext preparePositionsKernel workGroupSize let setPositions = setPositions clContext workGroupSize @@ -356,16 +211,97 @@ module SparseVector = Indices = resultIndices Size = max leftVector.Size rightVector.Size } + let elementWiseAtLeasOne (clContext: ClContext) opAdd (workGroupSize: int) = + elementWiseGeneral clContext (ElementwiseConstructor.preparePositionsAtLeastOne opAdd) workGroupSize + + let elementWise (clContext: ClContext) opAdd (workGroupSize: int) = + elementWiseGeneral clContext (ElementwiseConstructor.preparePositions opAdd) workGroupSize + + let private preparePositionsFillSubVector<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + preparePositions + (workGroupSize: int) + = + + let kernel = clContext.Compile(preparePositions) + + fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) -> + + let length = allIndices.Length + + let allValues = + clContext.CreateClArray<'a>( + length, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let positions = + clContext.CreateClArray( + length, + hostAccessMode = HostAccessMode.NotAccessible, + deviceAccessMode = DeviceAccessMode.ReadWrite, + allocationMode = AllocationMode.Default + ) + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc ndRange length allIndices leftValues rightValues value isLeft allValues positions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + allValues, positions + ///. ///. ///Should be a power of 2 and greater than 1. - let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) (scalar: 'a) = + let private fillSubVectorGeneral<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + preparePositionsKernel + (workGroupSize: int) + = - let eWiseAdd = - elementWiseAtLeastOne clContext (StandardOperations.maskAtLeastOne scalar) workGroupSize + let merge = merge clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClSparseVector<'a>) (rightVector: ClSparseVector<'b>) -> - eWiseAdd processor leftVector rightVector + let prepare = + preparePositionsFillSubVector clContext preparePositionsKernel workGroupSize + + let setPositions = setPositions clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClSparseVector<'a>) (rightVector: ClSparseVector<'b>) (value: ClCell<'a>) -> + + let allIndices, leftValues, rightValues, isLeft = + merge processor leftVector.Indices leftVector.Values rightVector.Indices rightVector.Values + + let allValues, positions = + prepare processor allIndices leftValues rightValues value isLeft + + processor.Post(Msg.CreateFreeMsg<_>(leftValues)) + processor.Post(Msg.CreateFreeMsg<_>(rightValues)) + processor.Post(Msg.CreateFreeMsg<_>(isLeft)) + + let resultValues, resultIndices = + setPositions processor 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 fillSubVectorAtLeasOne (clContext: ClContext) opAdd (workGroupSize: int) = + fillSubVectorGeneral clContext (ElementwiseConstructor.preparePositionsFillSubVectorAtLeasOne opAdd) workGroupSize let toDense (clContext: ClContext) (workGroupSize: int) = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index cbac0fae..4209ae9f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -5,6 +5,7 @@ open GraphBLAS.FSharp.Backend open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.DenseVector module Vector = let zeroCreate (clContext: ClContext) (workGroupSize: int) = @@ -70,7 +71,7 @@ module Vector = let toSparse (clContext: ClContext) (workGroupSize: int) = let toSparse = - DenseVector.toSparse clContext workGroupSize + DenseVector.DenseVector.toSparse clContext workGroupSize let copy = copy clContext workGroupSize From 471cfdbdac1e4e5cd8b4da8d2f42f8cce0fe8162 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 11 Nov 2022 23:12:08 +0300 Subject: [PATCH 62/74] refactor: DenseVector.preparePositions --- .../SparseVector/ElementwiseConstructor.fs | 120 ++++++++++++++---- .../Vector/SparseVector/SparseVector.fs | 7 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 15 ++- 3 files changed, 105 insertions(+), 37 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs index fe8f6518..f2b83b74 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs @@ -119,6 +119,78 @@ module ElementwiseConstructor = firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] isLeftBitMap.[i] <- 1 @> + let private opWriteBothFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) value + @> + + let private opWriteLeftFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (value: 'a) -> + (%opAdd) (Some leftValues.[gid]) None value + @> + + let private opWriteRightFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = + <@ + fun gid (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) None (Some rightValues.[gid + 1]) value + @> + + let private opWriteAtLeastOneBothFill (opAdd: Expr -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value + @> + + let private opWriteAtLeastOneLeftFill (opAdd: Expr -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (value: 'a) -> + (%opAdd) (Left(leftValues.[gid])) value + @> + + let private opWriteAtLeastOneRightFill (opAdd: Expr -> 'a -> 'a option>) = + <@ + fun gid (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) (Right(rightValues.[gid])) value + @> + + let private opWriteBoth (opAdd: Expr<'a option -> 'b option -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> + (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) + @> + + let private opWriteLeft (opAdd: Expr<'a option -> 'b option -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>)-> + (%opAdd) (Some leftValues.[gid]) None + @> + + let private opWriteRight (opAdd: Expr<'a option -> 'b option -> 'c option>) = + <@ + fun gid (rightValues: ClArray<'b>) -> + (%opAdd) None (Some rightValues.[gid + 1]) + @> + + let private opWriteAtLeastOneBoth (opAdd: Expr -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> + (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) + @> + + let opWriteAtLeastOneLeft (opAdd: Expr -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>) -> + (%opAdd) (Left(leftValues.[gid])) + @> + + let opWriteAtLeastOneRight (opAdd: Expr -> 'a option>) = + <@ + fun gid (rightValues: ClArray<'b>) -> + (%opAdd) (Right(rightValues.[gid])) + @> + let private both<'c> = <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray) (allValuesBuffer: ClArray<'c>) -> rawPositionsBuffer.[index] <- 0 @@ -144,34 +216,19 @@ module ElementwiseConstructor = rawPositionsBuffer.[index] <- 1 | None -> rawPositionsBuffer.[index] <- 0 @> - let preparePositionsAtLeastOne 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) (Both(leftValues.[gid], rightValues.[gid + 1])) + let private preparePositionsGeneral + (bothWrite: Expr<(int -> ClArray<'a> -> ClArray<'b> -> 'c option)>) + leftWrite + rightWrite + = - (%both) gid result positions allValues - elif (gid < length - && gid > 0 - && allIndices.[gid - 1] <> allIndices.[gid]) - || gid = 0 then - - let leftResult = (%opAdd) (Left(leftValues.[gid])) - let rightResult = (%opAdd) (Right(rightValues.[gid])) - - (%leftRight) gid leftResult rightResult isLeft allValues positions @> - - let preparePositions (opAdd: Expr<'a option -> 'b option -> 'c option>) = <@ 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]) + let (result: 'c option) = (%bothWrite) gid leftValues rightValues (%both) gid result positions allValues elif (gid < length @@ -179,13 +236,13 @@ module ElementwiseConstructor = && allIndices.[gid - 1] <> allIndices.[gid]) || gid = 0 then - let leftResult = (%opAdd) (Some leftValues.[gid]) None - let rightResult = (%opAdd) None (Some rightValues.[gid]) + let leftResult = (%leftWrite) gid leftValues + let rightResult = (%rightWrite) gid rightValues (%leftRight) gid leftResult rightResult isLeft allValues positions @> - let preparePositionsFillSubVectorAtLeasOne opAdd = - <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> + let private prepareFillVectorGeneral bothWrite leftWrite rightWrite = + <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> let gid = ndRange.GlobalID0 @@ -193,15 +250,22 @@ module ElementwiseConstructor = if gid < length - 1 && allIndices.[gid] = allIndices.[gid + 1] then - let result = (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value + let (result: 'a option) = (%bothWrite) gid leftValues rightValues value (%both) gid result positions allValues elif (gid < length && gid > 0 && allIndices.[gid - 1] <> allIndices.[gid]) || gid = 0 then - let leftResult = (%opAdd) (Left(leftValues.[gid])) value - let rightResult = (%opAdd) (Right(rightValues.[gid])) value + let leftResult = (%leftWrite) gid leftValues value + let rightResult = (%rightWrite) gid rightValues value (%leftRight) gid leftResult rightResult isLeft allValues positions @> + let preparePositions opAdd = preparePositionsGeneral (opWriteBoth opAdd) (opWriteLeft opAdd) (opWriteRight opAdd) + + let preparePositionsAtLeastOne opAdd = preparePositionsGeneral (opWriteAtLeastOneBoth opAdd) (opWriteAtLeastOneLeft opAdd) (opWriteAtLeastOneRight opAdd) + + let prepareFillVector opAdd = prepareFillVectorGeneral (opWriteBothFill opAdd) (opWriteLeftFill opAdd) (opWriteRightFill opAdd) + + let prepareFillVectorAtLeastOne opAdd = prepareFillVectorGeneral (opWriteAtLeastOneBothFill opAdd) (opWriteAtLeastOneLeftFill opAdd) (opWriteAtLeastOneRightFill opAdd) diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index bb2d55f2..65b4619f 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -211,7 +211,7 @@ module SparseVector = Indices = resultIndices Size = max leftVector.Size rightVector.Size } - let elementWiseAtLeasOne (clContext: ClContext) opAdd (workGroupSize: int) = + let elementWiseAtLeasOne (clContext: ClContext) (opAdd: Expr<(AtLeastOne<'a,'b> -> 'c option)>) (workGroupSize: int) = elementWiseGeneral clContext (ElementwiseConstructor.preparePositionsAtLeastOne opAdd) workGroupSize let elementWise (clContext: ClContext) opAdd (workGroupSize: int) = @@ -301,7 +301,10 @@ module SparseVector = Size = max leftVector.Size rightVector.Size } let fillSubVectorAtLeasOne (clContext: ClContext) opAdd (workGroupSize: int) = - fillSubVectorGeneral clContext (ElementwiseConstructor.preparePositionsFillSubVectorAtLeasOne opAdd) workGroupSize + fillSubVectorGeneral clContext (ElementwiseConstructor.prepareFillVectorAtLeastOne opAdd) workGroupSize + + let fillSubVector (clContext: ClContext) opAdd (workGroupSize: int) = + fillSubVectorGeneral clContext (ElementwiseConstructor.prepareFillVector opAdd) workGroupSize let toDense (clContext: ClContext) (workGroupSize: int) = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 4209ae9f..b57f215d 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -6,6 +6,7 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.DenseVector +open GraphBLAS.FSharp.Backend.SparseVector module Vector = let zeroCreate (clContext: ClContext) (workGroupSize: int) = @@ -95,7 +96,7 @@ module Vector = let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let addCoo = - SparseVector.elementWiseAtLeastOne clContext opAdd workGroupSize + SparseVector.elementWiseAtLeasOne clContext opAdd workGroupSize //TODO() let addDense = DenseVector.elementWiseAtLeastOne clContext opAdd workGroupSize @@ -114,12 +115,12 @@ module Vector = | ClVectorDense leftVector, ClVectorDense rightVector -> addDense processor leftVector rightVector | _ -> failwith "Vector formats are not matching." - let fillSubVector (clContext: ClContext) (workGroupSize: int) = + let fillSubVector (clContext: ClContext) mask (workGroupSize: int) = let cooFillVector = - SparseVector.fillSubVector clContext workGroupSize + SparseVector.fillSubVector clContext mask workGroupSize let denseFillVector = - DenseVector.fillSubVector clContext StandardOperations.mask workGroupSize + DenseVector.fillSubVector clContext mask workGroupSize let toCooVector = DenseVector.toSparse clContext workGroupSize @@ -131,17 +132,17 @@ module Vector = match vector, maskVector with | ClVectorSparse vector, ClVectorSparse mask -> ClVectorSparse - <| cooFillVector value processor vector mask + <| cooFillVector processor vector mask value | ClVectorSparse vector, ClVectorDense mask -> let mask = toCooMask processor mask ClVectorSparse - <| cooFillVector value processor vector mask + <| cooFillVector processor vector mask value | ClVectorDense vector, ClVectorSparse mask -> let vector = toCooVector processor vector ClVectorSparse - <| cooFillVector value processor vector mask + <| cooFillVector processor vector mask value | ClVectorDense vector, ClVectorDense mask -> ClVectorDense <| denseFillVector processor vector mask value From 7b2e627acdfd52e202614e7b5ac6a738bd970012 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 12 Nov 2022 10:19:17 +0300 Subject: [PATCH 63/74] refactor: types in SparseVector.ElementWiseConstructor --- .../SparseVector/ElementwiseConstructor.fs | 178 +++++++++--------- .../Vector/SparseVector/SparseVector.fs | 8 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 37 ++-- .../Vector/ElementWise.fs | 75 +++++--- .../Vector/FillSubVector.fs | 82 +++----- 5 files changed, 197 insertions(+), 183 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs index f2b83b74..57b3eed4 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs @@ -119,77 +119,81 @@ module ElementwiseConstructor = firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] isLeftBitMap.[i] <- 1 @> - let private opWriteBothFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) value - @> - - let private opWriteLeftFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (value: 'a) -> - (%opAdd) (Some leftValues.[gid]) None value - @> - - let private opWriteRightFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = - <@ - fun gid (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) None (Some rightValues.[gid + 1]) value - @> - - let private opWriteAtLeastOneBothFill (opAdd: Expr -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value - @> - - let private opWriteAtLeastOneLeftFill (opAdd: Expr -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (value: 'a) -> - (%opAdd) (Left(leftValues.[gid])) value - @> - - let private opWriteAtLeastOneRightFill (opAdd: Expr -> 'a -> 'a option>) = - <@ - fun gid (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) (Right(rightValues.[gid])) value - @> - - let private opWriteBoth (opAdd: Expr<'a option -> 'b option -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> - (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) - @> - - let private opWriteLeft (opAdd: Expr<'a option -> 'b option -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>)-> - (%opAdd) (Some leftValues.[gid]) None - @> - - let private opWriteRight (opAdd: Expr<'a option -> 'b option -> 'c option>) = - <@ - fun gid (rightValues: ClArray<'b>) -> - (%opAdd) None (Some rightValues.[gid + 1]) - @> - - let private opWriteAtLeastOneBoth (opAdd: Expr -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> - (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) - @> - - let opWriteAtLeastOneLeft (opAdd: Expr -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>) -> - (%opAdd) (Left(leftValues.[gid])) - @> - - let opWriteAtLeastOneRight (opAdd: Expr -> 'a option>) = - <@ - fun gid (rightValues: ClArray<'b>) -> - (%opAdd) (Right(rightValues.[gid])) - @> + module FillSubVectorRead = + let both (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) value + @> + + let left (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (value: 'a) -> + (%opAdd) (Some leftValues.[gid]) None value + @> + + let right (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = + <@ + fun gid (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) None (Some rightValues.[gid + 1]) value + @> + + module FillSubVectorAtLeasOneRead = + let both (opAdd: Expr -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value + @> + + let left (opAdd: Expr -> 'a -> 'a option>) = + <@ + fun gid (leftValues: ClArray<'a>) (value: 'a) -> + (%opAdd) (Left(leftValues.[gid])) value + @> + + let right (opAdd: Expr -> 'a -> 'a option>) = + <@ + fun gid (rightValues: ClArray<'b>) (value: 'a) -> + (%opAdd) (Right(rightValues.[gid])) value + @> + + module ElementWiseRead = + let both (opAdd: Expr<'a option -> 'b option -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> + (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) + @> + + let left (opAdd: Expr<'a option -> 'b option -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>)-> + (%opAdd) (Some leftValues.[gid]) None + @> + + let right (opAdd: Expr<'a option -> 'b option -> 'c option>) = + <@ + fun gid (rightValues: ClArray<'b>) -> + (%opAdd) None (Some rightValues.[gid + 1]) + @> + + module ElementWiseAtLeasOneRead = + let both (opAdd: Expr -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> + (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) + @> + + let left (opAdd: Expr -> 'c option>) = + <@ + fun gid (leftValues: ClArray<'a>) -> + (%opAdd) (Left(leftValues.[gid])) + @> + + let right (opAdd: Expr -> 'c option>) = + <@ + fun gid (rightValues: ClArray<'b>) -> + (%opAdd) (Right(rightValues.[gid])) + @> let private both<'c> = <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray) (allValuesBuffer: ClArray<'c>) -> @@ -217,9 +221,9 @@ module ElementwiseConstructor = | None -> rawPositionsBuffer.[index] <- 0 @> let private preparePositionsGeneral - (bothWrite: Expr<(int -> ClArray<'a> -> ClArray<'b> -> 'c option)>) - leftWrite - rightWrite + bothRead + leftRead + rightRead = <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> @@ -228,7 +232,7 @@ module ElementwiseConstructor = if gid < length - 1 && allIndices.[gid] = allIndices.[gid + 1] then - let (result: 'c option) = (%bothWrite) gid leftValues rightValues + let (result: 'c option) = (%bothRead) gid leftValues rightValues (%both) gid result positions allValues elif (gid < length @@ -236,12 +240,12 @@ module ElementwiseConstructor = && allIndices.[gid - 1] <> allIndices.[gid]) || gid = 0 then - let leftResult = (%leftWrite) gid leftValues - let rightResult = (%rightWrite) gid rightValues + let leftResult = (%leftRead) gid leftValues + let rightResult = (%rightRead) gid rightValues (%leftRight) gid leftResult rightResult isLeft allValues positions @> - let private prepareFillVectorGeneral bothWrite leftWrite rightWrite = + let private prepareFillVectorGeneral bothRead leftRead rightRead = <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> let gid = ndRange.GlobalID0 @@ -250,22 +254,26 @@ module ElementwiseConstructor = if gid < length - 1 && allIndices.[gid] = allIndices.[gid + 1] then - let (result: 'a option) = (%bothWrite) gid leftValues rightValues value + let (result: 'a option) = (%bothRead) gid leftValues rightValues value (%both) gid result positions allValues elif (gid < length && gid > 0 && allIndices.[gid - 1] <> allIndices.[gid]) || gid = 0 then - let leftResult = (%leftWrite) gid leftValues value - let rightResult = (%rightWrite) gid rightValues value + let leftResult = (%leftRead) gid leftValues value + let rightResult = (%rightRead) gid rightValues value (%leftRight) gid leftResult rightResult isLeft allValues positions @> - let preparePositions opAdd = preparePositionsGeneral (opWriteBoth opAdd) (opWriteLeft opAdd) (opWriteRight opAdd) + let preparePositions opAdd = + preparePositionsGeneral (ElementWiseRead.both opAdd) (ElementWiseRead.left opAdd) (ElementWiseRead.right opAdd) - let preparePositionsAtLeastOne opAdd = preparePositionsGeneral (opWriteAtLeastOneBoth opAdd) (opWriteAtLeastOneLeft opAdd) (opWriteAtLeastOneRight opAdd) + let preparePositionsAtLeastOne opAdd = + preparePositionsGeneral (ElementWiseAtLeasOneRead.both opAdd) (ElementWiseAtLeasOneRead.left opAdd) (ElementWiseAtLeasOneRead.right opAdd) - let prepareFillVector opAdd = prepareFillVectorGeneral (opWriteBothFill opAdd) (opWriteLeftFill opAdd) (opWriteRightFill opAdd) + let prepareFillVector opAdd = + prepareFillVectorGeneral (FillSubVectorRead.both opAdd) (FillSubVectorRead.left opAdd) (FillSubVectorRead.right opAdd) - let prepareFillVectorAtLeastOne opAdd = prepareFillVectorGeneral (opWriteAtLeastOneBothFill opAdd) (opWriteAtLeastOneLeftFill opAdd) (opWriteAtLeastOneRightFill opAdd) + let prepareFillVectorAtLeastOne opAdd = + prepareFillVectorGeneral (FillSubVectorAtLeasOneRead.both opAdd) (FillSubVectorAtLeasOneRead.left opAdd) (FillSubVectorAtLeasOneRead.right opAdd) diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 65b4619f..5c9168b5 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -92,7 +92,7 @@ module SparseVector = let length = allIndices.Length let allValues = - clContext.CreateClArray<'a>( + clContext.CreateClArray<'c>( length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, @@ -183,7 +183,7 @@ module SparseVector = let merge = merge clContext workGroupSize let prepare = - preparePositions clContext preparePositionsKernel workGroupSize + preparePositions<'a, 'b , 'c> clContext preparePositionsKernel workGroupSize let setPositions = setPositions clContext workGroupSize @@ -211,10 +211,10 @@ module SparseVector = Indices = resultIndices Size = max leftVector.Size rightVector.Size } - let elementWiseAtLeasOne (clContext: ClContext) (opAdd: Expr<(AtLeastOne<'a,'b> -> 'c option)>) (workGroupSize: int) = + let elementWiseAtLeasOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = elementWiseGeneral clContext (ElementwiseConstructor.preparePositionsAtLeastOne opAdd) workGroupSize - let elementWise (clContext: ClContext) opAdd (workGroupSize: int) = + let elementWise (clContext: ClContext) (opAdd: Expr<'a option ->'b option -> 'c option>) (workGroupSize: int) = elementWiseGeneral clContext (ElementwiseConstructor.preparePositions opAdd) workGroupSize let private preparePositionsFillSubVector<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index b57f215d..5f7ecec9 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -95,60 +95,63 @@ module Vector = ClVectorDense <| toDense processor vector let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = - let addCoo = - SparseVector.elementWiseAtLeasOne clContext opAdd workGroupSize //TODO() + let addSparse = + SparseVector.elementWiseAtLeasOne clContext opAdd workGroupSize let addDense = DenseVector.elementWiseAtLeastOne clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with - | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addCoo processor left right + | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addSparse processor left right | ClVectorDense left, ClVectorDense right -> ClVectorDense <| addDense processor left right | _ -> failwith "Vector formats are not matching." let elementWise (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) (workGroupSize: int) = let addDense = DenseVector.elementWise clContext opAdd workGroupSize + let addSparse = SparseVector.elementWise clContext opAdd workGroupSize + fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with - | ClVectorDense leftVector, ClVectorDense rightVector -> addDense processor leftVector rightVector + | ClVectorDense leftVector, ClVectorDense rightVector -> ClVectorDense <| addDense processor leftVector rightVector + | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addSparse processor left right | _ -> failwith "Vector formats are not matching." - let fillSubVector (clContext: ClContext) mask (workGroupSize: int) = - let cooFillVector = - SparseVector.fillSubVector clContext mask workGroupSize + let fillSubVector (clContext: ClContext) maskOp (workGroupSize: int) = + let sparseFillVector = + SparseVector.fillSubVector clContext maskOp workGroupSize let denseFillVector = - DenseVector.fillSubVector clContext mask workGroupSize + DenseVector.fillSubVector clContext maskOp workGroupSize - let toCooVector = + let toSparseVector = DenseVector.toSparse clContext workGroupSize - let toCooMask = + let toSparseMask = DenseVector.toSparse clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: ClCell<'a>) -> match vector, maskVector with | ClVectorSparse vector, ClVectorSparse mask -> ClVectorSparse - <| cooFillVector processor vector mask value + <| sparseFillVector processor vector mask value | ClVectorSparse vector, ClVectorDense mask -> - let mask = toCooMask processor mask + let mask = toSparseMask processor mask ClVectorSparse - <| cooFillVector processor vector mask value + <| sparseFillVector processor vector mask value | ClVectorDense vector, ClVectorSparse mask -> - let vector = toCooVector processor vector + let vector = toSparseVector processor vector ClVectorSparse - <| cooFillVector processor vector mask value + <| sparseFillVector processor vector mask value | ClVectorDense vector, ClVectorDense mask -> ClVectorDense <| denseFillVector processor vector mask value let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = - let cooReduce = + let sparseReduce = SparseVector.reduce clContext workGroupSize opAdd let denseReduce = @@ -156,5 +159,5 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorSparse vector -> cooReduce processor vector + | ClVectorSparse vector -> sparseReduce processor vector | ClVectorDense vector -> denseReduce processor vector diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs index 8c901376..6e737982 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs @@ -10,10 +10,6 @@ open StandardOperations let logger = Log.create "Vector.ElementWise.Tests" -let context = defaultContext.ClContext - -let q = defaultContext.Queue - let config = defaultConfig let NNZCountCount array isZero = @@ -54,6 +50,8 @@ let correctnessGenericTest resultZero op (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) + (toDense: MailboxProcessor<_> -> ClVector<'c> -> ClVector<'c>) + (case: OperationCase) (leftArray: 'a [], rightArray: 'b []) = @@ -65,11 +63,14 @@ let correctnessGenericTest if leftNNZCount > 0 && rightNNZCount > 0 then + let context = case.ClContext.ClContext + let q = case.ClContext.Queue + let firstVector = - createVectorFromArray Dense leftArray (leftIsEqual leftZero) + createVectorFromArray case.Format leftArray (leftIsEqual leftZero) let secondVector = - createVectorFromArray Dense rightArray (rightIsEqual rightZero) + createVectorFromArray case.Format rightArray (rightIsEqual rightZero) let v1 = firstVector.ToDevice context let v2 = secondVector.ToDevice context @@ -80,25 +81,34 @@ let correctnessGenericTest v1.Dispose q v2.Dispose q - let actual = res.ToHost q + let denseActual = toDense q res + + let actual = denseActual.ToHost q res.Dispose q + denseActual.Dispose q checkResult resultIsEqual resultZero op actual leftArray rightArray with | ex when ex.Message = "InvalidBufferSize" -> () | ex -> raise ex -let addTestFixtures = +let addTestFixtures case = let getCorrectnessTestName fstType sndType thrType = - $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, Dense" + $"Correctness on '{fstType} option -> '{sndType} option -> '{thrType} option, {case.Format}" let wgSize = 32 + let context = case.ClContext.ClContext + + [ let intAddFun = Vector.elementWiseAtLeastOne context intSumAtLeastOne wgSize - correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun + let intToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0 0 0 (+) intAddFun intToDense |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") let floatAddFun = @@ -107,33 +117,47 @@ let addTestFixtures = let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y - correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun + let floatToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (+) floatAddFun floatToDense |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolAddFun = Vector.elementWiseAtLeastOne context boolSumAtLeastOne wgSize - correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun + let boolToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest (=) (=) (=) false false false (||) boolAddFun boolToDense |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteAddFun = Vector.elementWiseAtLeastOne context byteSumAtLeastOne wgSize - correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun + let byteToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToDense |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let addTests = testList "Backend.Vector.ElementWiseAdd tests" addTestFixtures +let addTests = testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseAdd tests" -let mulTestFixtures = +let mulTestFixtures case = let getCorrectnessTestName fstType sndType thrType = - $"Correctness on AtLeastOne<{fstType}, {sndType}> -> {thrType} option, Dense" + $"Correctness on '{fstType} option -> '{sndType} option -> '{thrType} option, {case.Format}" let wgSize = 32 + let context = case.ClContext.ClContext + [ let intMulFun = Vector.elementWiseAtLeastOne context intMulAtLeastOne wgSize - correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun + let intToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0 0 0 (*) intMulFun intToDense |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") let floatMulFun = @@ -142,19 +166,28 @@ let mulTestFixtures = let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y - correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun + let floatToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest fIsEqual fIsEqual fIsEqual 0.0 0.0 0.0 (*) floatMulFun floatToDense |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolMulFun = Vector.elementWiseAtLeastOne context boolMulAtLeastOne wgSize - correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun + let boolToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest (=) (=) (=) false false false (&&) boolMulFun boolToDense |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteMulFun = Vector.elementWiseAtLeastOne context byteMulAtLeastOne wgSize - correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun + let byteToDense = Vector.toDense context wgSize + + case + |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToDense |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let mulTests = testList "Backend.Vector.ElementWiseMul tests" mulTestFixtures +let mulTests = testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs index 90434361..2fc8721a 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs @@ -2,11 +2,10 @@ module Backend.Vector.FillSubVector open Expecto open Expecto.Logging -open Expecto.Logging.Message open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests.Utils open Brahma.FSharp -open OpenCL.Net let logger = Log.create "Vector.fillSubVector.Tests" @@ -52,13 +51,12 @@ let checkResult | _ -> failwith "Vector format must be Sparse." let makeTest<'a, 'b when 'a: struct and 'b: struct> - vectorIsZero + vectorIsEqual maskIsEqual vectorZero maskZero (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) - (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> 'a -> ClVector<'a>) - (maskFormat: VectorFormat) + (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> ClCell<'a> -> ClVector<'a>) (isValueValid: 'a -> bool) case (vector: 'a [], mask: 'b []) @@ -66,7 +64,7 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> = let vectorNNZ = - NNZCountCount vector (vectorIsZero vectorZero) + NNZCountCount vector (vectorIsEqual vectorZero) let maskNNZ = NNZCountCount mask (maskIsEqual maskZero) @@ -76,18 +74,22 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> let context = case.ClContext.ClContext let leftVector = - createVectorFromArray case.Format vector (vectorIsZero vectorZero) + createVectorFromArray case.Format vector (vectorIsEqual vectorZero) let maskVector = - createVectorFromArray maskFormat mask (maskIsEqual maskZero) + createVectorFromArray case.Format mask (maskIsEqual maskZero) let clLeftVector = leftVector.ToDevice context let clMaskVector = maskVector.ToDevice context try + let clValue = context.CreateClCell value + let clActual = - fillVector q clLeftVector clMaskVector value + fillVector q clLeftVector clMaskVector clValue + + clValue.Dispose () let cooClActual = toCoo q clActual @@ -98,7 +100,7 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> clActual.Dispose q cooClActual.Dispose q - checkResult vectorIsZero maskIsEqual vectorZero maskZero actual vector mask value + checkResult vectorIsEqual maskIsEqual vectorZero maskZero actual vector mask value with | ex when ex.Message = "InvalidBufferSize" -> () | ex -> raise ex @@ -106,8 +108,8 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> let testFixtures case = let config = defaultConfig - let getCorrectnessTestName datatype maskFormat = - $"Correctness on %s{datatype}, vector: %A{case.Format}, mask: %s{maskFormat}" + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, vector: %A{case.Format}" let wgSize = 32 let context = case.ClContext.ClContext @@ -115,69 +117,37 @@ let testFixtures case = let floatIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y - [ let intFill = Vector.fillSubVector context wgSize - - let intToCoo = Vector.toSparse context wgSize - - case - |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Sparse (fun item -> true) - |> testPropertyWithConfig config (getCorrectnessTestName "int" "Sparse") - - let floatFill = Vector.fillSubVector context wgSize - - let floatToCoo = Vector.toSparse context wgSize - - case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Sparse System.Double.IsNormal - |> testPropertyWithConfig config (getCorrectnessTestName "float" "Sparse") - - let byteFill = Vector.fillSubVector context wgSize - - let byteToCoo = Vector.toSparse context wgSize - - case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Sparse (fun item -> true) - |> testPropertyWithConfig config (getCorrectnessTestName "byte" "Sparse") - - let boolFill = Vector.fillSubVector context wgSize - - let boolToCoo = Vector.toSparse context wgSize - - case - |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Sparse (fun item -> true) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Sparse") - - let intFill = Vector.fillSubVector context wgSize + [ let intFill = Vector.fillSubVector context StandardOperations.mask wgSize let intToCoo = Vector.toSparse context wgSize case - |> makeTest (=) (=) 0 0 intToCoo intFill VectorFormat.Dense (fun item -> true) - |> testPropertyWithConfig config (getCorrectnessTestName "int" "Dense") + |> makeTest (=) (=) 0 0 intToCoo intFill (fun _ -> true) + |> testPropertyWithConfig config (getCorrectnessTestName "int") - let floatFill = Vector.fillSubVector context wgSize + let floatFill = Vector.fillSubVector context StandardOperations.mask wgSize let floatToCoo = Vector.toSparse context wgSize case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill VectorFormat.Dense System.Double.IsNormal - |> testPropertyWithConfig config (getCorrectnessTestName "float" "Dense") + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill System.Double.IsNormal + |> testPropertyWithConfig config (getCorrectnessTestName "float") - let byteFill = Vector.fillSubVector context wgSize + let byteFill = Vector.fillSubVector context StandardOperations.mask wgSize let byteToCoo = Vector.toSparse context wgSize case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill VectorFormat.Dense (fun item -> true) - |> testPropertyWithConfig config (getCorrectnessTestName "byte" "Dense") + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill (fun _ -> true) + |> testPropertyWithConfig config (getCorrectnessTestName "byte") - let boolFill = Vector.fillSubVector context wgSize + let boolFill = Vector.fillSubVector context StandardOperations.mask wgSize let boolToCoo = Vector.toSparse context wgSize case - |> makeTest (=) (=) false false boolToCoo boolFill VectorFormat.Dense (fun item -> true) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" "Dense") ] + |> makeTest (=) (=) false false boolToCoo boolFill (fun _ -> true) + |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] let tests = testsWithOperationCase testFixtures "Backend.Vector.fillSubVector tests" From a5a3d8cecc546f7b6520c3e1aeed9bba8efb34cb Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 12 Nov 2022 21:46:57 +0300 Subject: [PATCH 64/74] add: atLeastOneToNormalForm fun --- .../Vector/DenseVector/DenseVector.fs | 38 +---- .../DenseVector/ElementwiseConstructor.fs | 128 ++++++++++----- .../SparseVector/ElementwiseConstructor.fs | 146 +++++------------- .../Vector/SparseVector/SparseVector.fs | 39 +++-- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- tests/GraphBLAS-sharp.Tests/Program.fs | 36 ++--- .../Vector/ElementWise.fs | 22 +-- .../Vector/ElementWiseAtLeasOne.fs | 2 +- .../Vector/FillSubVector.fs | 74 +++++++-- 9 files changed, 243 insertions(+), 244 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 10e4997c..35661163 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -38,44 +38,15 @@ module DenseVector = resultVector - let elementWiseAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - (workGroupSize: int) - = - - let kernel = clContext.Compile(ElementwiseConstructor.atLeastOneKernel opAdd) - - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> - - let resultVector = - clContext.CreateClArray( - leftVector.Length, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.Default - ) - - let ndRange = - Range1D.CreateValid(leftVector.Length, workGroupSize) - - let kernel = kernel.GetKernel() - - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector rightVector resultVector) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - resultVector + let elementWiseAtLeastOne clContext op workGroupSize = + elementWise clContext (ElementwiseConstructor.atLeastOneToNormalForm op) workGroupSize let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseConstructor.fillSubVector maskOp) + let kernel = clContext.Compile(ElementwiseConstructor.fillSubVectorKernel maskOp) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> let resultArray = @@ -98,6 +69,9 @@ module DenseVector = resultArray + let fillSubVectorAtLeasOne clContext opAdd workGroupSize = + fillSubVector clContext (ElementwiseConstructor.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize + let private getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let getPositions = diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs index 26ea4cfd..d208a42a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs @@ -4,59 +4,105 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common module ElementwiseConstructor = - let private elementWiseGeneralKernel writeOp = - <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + // let private elementWiseGeneralKernel writeOp = + // <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + // + // let gid = ndRange.GlobalID0 + // + // if gid < resultLength then + // resultVector[gid] <- (%writeOp) leftVector.[gid] rightVector.[gid] @> + // + // let private elementWiseWrite opAdd = + // <@ + // fun (leftItem: 'a option) (rightItem: 'b option) -> + // (%opAdd) leftItem rightItem + // @> + // + // let private elementWiseAtLeastOneWrite opAdd = + // <@ + // fun (leftItem: 'a option) (rightItem: 'b option) -> + // match leftItem, rightItem with + // | Some left, Some right -> (%opAdd) (Both(left, right)) + // | Some left, None -> (%opAdd) (Left left) + // | None, Some right -> (%opAdd) (Right right) + // | _ -> None + // @> - let gid = ndRange.GlobalID0 + // let kernel opAdd = elementWiseGeneralKernel <| elementWiseWrite opAdd + // + // let atLeastOneKernel opAdd = elementWiseGeneralKernel <| elementWiseAtLeastOneWrite opAdd - if gid < resultLength then - (%writeOp) gid leftVector rightVector resultVector @> - - let private elementWiseWrite opAdd = + let kernel opAdd = <@ - fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultArray: ClArray<'c option>) -> - resultArray.[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] - @> + fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> - let private elementWiseAtLeastOneWrite opAdd = - <@ - fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultArray: ClArray<'c option>) -> - match leftVector.[gid], rightVector.[gid] with - | Some left, Some right -> resultArray.[gid] <- (%opAdd) (Both(left, right)) - | Some left, None -> resultArray.[gid] <- (%opAdd) (Left left) - | None, Some right -> resultArray.[gid] <- (%opAdd) (Right right) - | _ -> resultArray.[gid] <- None - @> + let gid = ndRange.GlobalID0 - let kernel opAdd = elementWiseGeneralKernel <| elementWiseWrite opAdd + if gid < resultLength then + resultVector[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] + @> - let atLeastOneKernel opAdd = elementWiseGeneralKernel <| elementWiseAtLeastOneWrite opAdd + // let private fillSubVectorGeneralKernel writeOp = + // <@ + // fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'c option>) -> + // + // let gid = ndRange.GlobalID0 + // + // if gid < resultLength then + // resultVector[gid] <- (%writeOp) leftVector.[gid] rightVector.[gid] value.Value @> + // + // let private fillSubVectorWrite (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = + // <@ + // fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> + // (%opAdd) leftItem rightItem value + // @> + // + // let private fillSubVectorAtLeastOneWrite (opAdd: Expr -> 'a-> 'a option>) = + // <@ + // fun (leftItem: 'a option) (rightItem: 'b option) (values: 'a) -> + // match leftItem, rightItem with + // | Some left, Some right -> (%opAdd) (Both(left, right)) values + // | Some left, None -> (%opAdd) (Left left) values + // | None, Some right -> (%opAdd) (Right right) values + // | _ -> None + // @> - let private fillSubVectorGeneralKernel writeOp = - <@ - fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'c option>) -> + // let fillSubVector maskOp = fillSubVectorGeneralKernel <| fillSubVectorWrite maskOp + // + // let fillSubVectorAtLeastOne maskOp = fillSubVectorGeneralKernel <| fillSubVectorAtLeastOneWrite maskOp + let fillSubVectorKernel opAdd = + <@ + fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'c option>) -> - let gid = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if gid < resultLength then - (%writeOp) gid leftVector rightVector value.Value resultVector @> + if gid < resultLength then + resultVector[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] value.Value @> - let private fillSubVectorWrite opAdd = + let atLeastOneToNormalForm op = <@ - fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: 'a) (resultArray: ClArray<'c option>) -> - resultArray.[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] value + fun (leftItem: 'a option) (rightItem: 'b option) -> + match leftItem, rightItem with + | Some left, Some right -> + (%op) (Both(left, right)) + | None, Some right -> + (%op) (Right right) + | Some left, None -> + (%op) (Left left) + | None, None -> + None @> - let private fillSubVectorAtLeastOneWrite opAdd = + let fillSubVectorAtLeastOneToNormalForm op = <@ - fun gid (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (values: 'a) (resultArray: ClArray<'c option>) -> - match leftVector.[gid], rightVector.[gid] with - | Some left, Some right -> resultArray.[gid] <- (%opAdd) (Both(left, right)) values - | Some left, None -> resultArray.[gid] <- (%opAdd) (Left left) values - | None, Some right -> resultArray.[gid] <- (%opAdd) (Right right) values - | _ -> resultArray.[gid] <- None + fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> + match leftItem, rightItem with + | Some left, Some right -> + (%op) (Both(left, right)) value + | None, Some right -> + (%op) (Right right) value + | Some left, None -> + (%op) (Left left) value + | None, None -> + None @> - - let fillSubVector maskOp = fillSubVectorGeneralKernel <| fillSubVectorWrite maskOp - - let fillSubVectorAtLeastOne maskOp = fillSubVectorGeneralKernel <| fillSubVectorAtLeastOneWrite maskOp diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs index 57b3eed4..56bcb2c9 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs @@ -119,82 +119,6 @@ module ElementwiseConstructor = firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] isLeftBitMap.[i] <- 1 @> - module FillSubVectorRead = - let both (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) value - @> - - let left (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (value: 'a) -> - (%opAdd) (Some leftValues.[gid]) None value - @> - - let right (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = - <@ - fun gid (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) None (Some rightValues.[gid + 1]) value - @> - - module FillSubVectorAtLeasOneRead = - let both (opAdd: Expr -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value - @> - - let left (opAdd: Expr -> 'a -> 'a option>) = - <@ - fun gid (leftValues: ClArray<'a>) (value: 'a) -> - (%opAdd) (Left(leftValues.[gid])) value - @> - - let right (opAdd: Expr -> 'a -> 'a option>) = - <@ - fun gid (rightValues: ClArray<'b>) (value: 'a) -> - (%opAdd) (Right(rightValues.[gid])) value - @> - - module ElementWiseRead = - let both (opAdd: Expr<'a option -> 'b option -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> - (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) - @> - - let left (opAdd: Expr<'a option -> 'b option -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>)-> - (%opAdd) (Some leftValues.[gid]) None - @> - - let right (opAdd: Expr<'a option -> 'b option -> 'c option>) = - <@ - fun gid (rightValues: ClArray<'b>) -> - (%opAdd) None (Some rightValues.[gid + 1]) - @> - - module ElementWiseAtLeasOneRead = - let both (opAdd: Expr -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) -> - (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) - @> - - let left (opAdd: Expr -> 'c option>) = - <@ - fun gid (leftValues: ClArray<'a>) -> - (%opAdd) (Left(leftValues.[gid])) - @> - - let right (opAdd: Expr -> 'c option>) = - <@ - fun gid (rightValues: ClArray<'b>) -> - (%opAdd) (Right(rightValues.[gid])) - @> - let private both<'c> = <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray) (allValuesBuffer: ClArray<'c>) -> rawPositionsBuffer.[index] <- 0 @@ -220,60 +144,70 @@ module ElementwiseConstructor = rawPositionsBuffer.[index] <- 1 | None -> rawPositionsBuffer.[index] <- 0 @> - let private preparePositionsGeneral - bothRead - leftRead - rightRead - = - - <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) (allValues: ClArray<'c>) (positions: ClArray) -> + let prepareFillVector opAdd = + <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> let gid = ndRange.GlobalID0 + let value = value.Value + if gid < length - 1 && allIndices.[gid] = allIndices.[gid + 1] then - let (result: 'c option) = (%bothRead) gid leftValues rightValues + let result = (%opAdd) (Some leftValues[gid]) (Some rightValues[gid + 1]) value (%both) gid result positions allValues elif (gid < length && gid > 0 && allIndices.[gid - 1] <> allIndices.[gid]) - || gid = 0 then - - let leftResult = (%leftRead) gid leftValues - let rightResult = (%rightRead) gid rightValues + || gid = 0 then + let leftResult = (%opAdd) (Some leftValues.[gid]) None value + let rightResult = (%opAdd) None (Some rightValues.[gid]) value (%leftRight) gid leftResult rightResult isLeft allValues positions @> - let private prepareFillVectorGeneral bothRead leftRead rightRead = - <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> + 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 - let value = value.Value - if gid < length - 1 && allIndices.[gid] = allIndices.[gid + 1] then - let (result: 'a option) = (%bothRead) gid leftValues rightValues value + let result = (%opAdd) (Some leftValues[gid]) (Some rightValues[gid + 1]) (%both) gid result positions allValues elif (gid < length && gid > 0 && allIndices.[gid - 1] <> allIndices.[gid]) || gid = 0 then - let leftResult = (%leftRead) gid leftValues value - let rightResult = (%rightRead) gid rightValues value + let leftResult = (%opAdd) (Some leftValues.[gid]) None + let rightResult = (%opAdd) None (Some rightValues.[gid]) (%leftRight) gid leftResult rightResult isLeft allValues positions @> - let preparePositions opAdd = - preparePositionsGeneral (ElementWiseRead.both opAdd) (ElementWiseRead.left opAdd) (ElementWiseRead.right opAdd) - - let preparePositionsAtLeastOne opAdd = - preparePositionsGeneral (ElementWiseAtLeasOneRead.both opAdd) (ElementWiseAtLeasOneRead.left opAdd) (ElementWiseAtLeasOneRead.right opAdd) - - let prepareFillVector opAdd = - prepareFillVectorGeneral (FillSubVectorRead.both opAdd) (FillSubVectorRead.left opAdd) (FillSubVectorRead.right opAdd) - - let prepareFillVectorAtLeastOne opAdd = - prepareFillVectorGeneral (FillSubVectorAtLeasOneRead.both opAdd) (FillSubVectorAtLeasOneRead.left opAdd) (FillSubVectorAtLeasOneRead.right opAdd) + let atLeastOneToNormalForm (op: Expr -> 'c option>) = + <@ + fun (leftItem: 'a option) (rightItem: 'b option) -> + match leftItem, rightItem with + | Some left, Some right -> + (%op) (Both(left, right)) + | None, Some right -> + (%op) (Right right) + | Some left, None -> + (%op) (Left left) + | None, None -> + None + @> + + let fillSubVectorAtLeastOneToNormalForm (op: Expr -> 'a -> 'a option>) = + <@ + fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> + match leftItem, rightItem with + | Some left, Some right -> + (%op) (Both(left, right)) value + | None, Some right -> + (%op) (Right right) value + | Some left, None -> + (%op) (Left left) value + | None, None -> + None + @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 5c9168b5..0979d58d 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -81,11 +81,11 @@ module SparseVector = let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) - preparePositions + op (workGroupSize: int) = - let kernel = clContext.Compile(preparePositions) + let kernel = clContext.Compile(ElementwiseConstructor.preparePositions op) fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> @@ -174,16 +174,16 @@ module SparseVector = ///. ///. ///Should be a power of 2 and greater than 1. - let private elementWiseGeneral<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + let elementWise<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) - preparePositionsKernel + op (workGroupSize: int) = let merge = merge clContext workGroupSize let prepare = - preparePositions<'a, 'b , 'c> clContext preparePositionsKernel workGroupSize + preparePositions<'a, 'b , 'c> clContext op workGroupSize let setPositions = setPositions clContext workGroupSize @@ -211,19 +211,16 @@ module SparseVector = Indices = resultIndices Size = max leftVector.Size rightVector.Size } - let elementWiseAtLeasOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = - elementWiseGeneral clContext (ElementwiseConstructor.preparePositionsAtLeastOne opAdd) workGroupSize - - let elementWise (clContext: ClContext) (opAdd: Expr<'a option ->'b option -> 'c option>) (workGroupSize: int) = - elementWiseGeneral clContext (ElementwiseConstructor.preparePositions opAdd) workGroupSize + let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = + elementWise clContext (ElementwiseConstructor.atLeastOneToNormalForm opAdd) workGroupSize let private preparePositionsFillSubVector<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) - preparePositions + op (workGroupSize: int) = - let kernel = clContext.Compile(preparePositions) + let kernel = clContext.Compile(ElementwiseConstructor.prepareFillVector op) fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) -> @@ -263,16 +260,16 @@ module SparseVector = ///. ///. ///Should be a power of 2 and greater than 1. - let private fillSubVectorGeneral<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + let fillSubVector<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) - preparePositionsKernel + op (workGroupSize: int) = let merge = merge clContext workGroupSize let prepare = - preparePositionsFillSubVector clContext preparePositionsKernel workGroupSize + preparePositionsFillSubVector clContext op workGroupSize let setPositions = setPositions clContext workGroupSize @@ -300,11 +297,8 @@ module SparseVector = Indices = resultIndices Size = max leftVector.Size rightVector.Size } - let fillSubVectorAtLeasOne (clContext: ClContext) opAdd (workGroupSize: int) = - fillSubVectorGeneral clContext (ElementwiseConstructor.prepareFillVectorAtLeastOne opAdd) workGroupSize - - let fillSubVector (clContext: ClContext) opAdd (workGroupSize: int) = - fillSubVectorGeneral clContext (ElementwiseConstructor.prepareFillVector opAdd) workGroupSize + let fillSubVectorAtLeastOne (clContext: ClContext) opAdd (workGroupSize: int) = + fillSubVector clContext (ElementwiseConstructor.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize let toDense (clContext: ClContext) (workGroupSize: int) = @@ -335,7 +329,10 @@ module SparseVector = kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultArray) ) - processor.Post(Msg.CreateRunMsg(kernel)) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + processor.Post(Msg.CreateFreeMsg<_>(vector.Indices)) + processor.Post(Msg.CreateFreeMsg<_>(vector.Values)) resultArray diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 5f7ecec9..2ba4444a 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -96,7 +96,7 @@ module Vector = let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let addSparse = - SparseVector.elementWiseAtLeasOne clContext opAdd workGroupSize + SparseVector.elementWiseAtLeastOne clContext opAdd workGroupSize let addDense = DenseVector.elementWiseAtLeastOne clContext opAdd workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 8c98d542..e9b69710 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -20,24 +20,24 @@ let allTests = // Backend.RemoveDuplicates.tests // Backend.Copy.tests // Backend.Replicate.tests - // //Backend.Elementwise.elementwiseAddTests - // //Backend.Elementwise.elementwiseAddAtLeastOneTests - // //Backend.Elementwise.elementwiseAddAtLeastOneToCOOTests - // //Backend.Elementwise.elementwiseMulAtLeastOneTests - // Backend.Transpose.tests - // //Matrix.GetTuples.tests - // //Matrix.Mxv.tests - // //Algo.Bfs.tests - // Backend.Reduce.tests - // Backend.Vector.ZeroCreate.tests - // Backend.Vector.OfList.tests - // Backend.Vector.Copy.tests - // Backend.Vector.Convert.tests - // Backend.Vector.ElementWiseAtLeastOne.addTests - // Backend.Vector.ElementWiseAtLeastOne.mulTests - Backend.Vector.ElementWise.addTests - Backend.Vector.ElementWise.mulTests - // Backend.Vector.FillSubVector.tests + //Backend.Elementwise.elementwiseAddTests + //Backend.Elementwise.elementwiseAddAtLeastOneTests + //Backend.Elementwise.elementwiseAddAtLeastOneToCOOTests + //Backend.Elementwise.elementwiseMulAtLeastOneTests + // Backend.Transpose.tests + //Matrix.GetTuples.tests + //Matrix.Mxv.tests + //Algo.Bfs.tests + // Backend.Reduce.tests + // Backend.Vector.ZeroCreate.tests + // Backend.Vector.OfList.tests + // Backend.Vector.Copy.tests + // Backend.Vector.Convert.tests + Backend.Vector.ElementWiseAtLeastOne.addTests + Backend.Vector.ElementWiseAtLeastOne.mulTests + Backend.Vector.ElementWise.addTests + Backend.Vector.ElementWise.mulTests + // Backend.Vector.FillSubVector.tests // Backend.Vector.Reduce.tests ] ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs index 6e737982..5dc04c7f 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs @@ -51,7 +51,7 @@ let correctnessGenericTest op (addFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'b> -> ClVector<'c>) (toDense: MailboxProcessor<_> -> ClVector<'c> -> ClVector<'c>) - (case: OperationCase) + case (leftArray: 'a [], rightArray: 'b []) = @@ -94,6 +94,7 @@ let correctnessGenericTest | ex -> raise ex let addTestFixtures case = + let getCorrectnessTestName fstType sndType thrType = $"Correctness on '{fstType} option -> '{sndType} option -> '{thrType} option, {case.Format}" @@ -101,9 +102,8 @@ let addTestFixtures case = let context = case.ClContext.ClContext - [ let intAddFun = - Vector.elementWiseAtLeastOne context intSumAtLeastOne wgSize + Vector.elementWise context intSum wgSize let intToDense = Vector.toDense context wgSize @@ -112,7 +112,7 @@ let addTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") let floatAddFun = - Vector.elementWiseAtLeastOne context floatSumAtLeastOne wgSize + Vector.elementWise context floatSum wgSize let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y @@ -124,7 +124,7 @@ let addTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolAddFun = - Vector.elementWiseAtLeastOne context boolSumAtLeastOne wgSize + Vector.elementWise context boolSum wgSize let boolToDense = Vector.toDense context wgSize @@ -133,7 +133,7 @@ let addTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteAddFun = - Vector.elementWiseAtLeastOne context byteSumAtLeastOne wgSize + Vector.elementWise context byteSum wgSize let byteToDense = Vector.toDense context wgSize @@ -152,7 +152,7 @@ let mulTestFixtures case = let context = case.ClContext.ClContext [ let intMulFun = - Vector.elementWiseAtLeastOne context intMulAtLeastOne wgSize + Vector.elementWise context intMul wgSize let intToDense = Vector.toDense context wgSize @@ -161,7 +161,7 @@ let mulTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "int" "int" "int") let floatMulFun = - Vector.elementWiseAtLeastOne context floatMulAtLeastOne wgSize + Vector.elementWise context floatMul wgSize let fIsEqual = fun x y -> abs (x - y) < Accuracy.medium.absolute || x = y @@ -173,7 +173,7 @@ let mulTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "float" "float" "float") let boolMulFun = - Vector.elementWiseAtLeastOne context boolMulAtLeastOne wgSize + Vector.elementWise context boolMul wgSize let boolToDense = Vector.toDense context wgSize @@ -182,7 +182,7 @@ let mulTestFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "bool" "bool" "bool") let byteMulFun = - Vector.elementWiseAtLeastOne context byteMulAtLeastOne wgSize + Vector.elementWise context byteMul wgSize let byteToDense = Vector.toDense context wgSize @@ -190,4 +190,4 @@ let mulTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToDense |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let mulTests = testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseMul tests" +let mulTests = testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ElementWiseAtLeasOne.fs b/tests/GraphBLAS-sharp.Tests/Vector/ElementWiseAtLeasOne.fs index 343c1bc4..c6142672 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/ElementWiseAtLeasOne.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ElementWiseAtLeasOne.fs @@ -44,7 +44,7 @@ let checkResult actualArray.[actual.Indices.[i]] <- actual.Values.[i] - "arrays must have the same values" + $"arrays must have the same values actual = %A{actualArray}, expected = %A{expectedArray}" |> compareArrays isEqual actualArray expectedArray | _ -> failwith "Vector format must be Sparse." diff --git a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs index 2fc8721a..4fc61d40 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs @@ -20,28 +20,26 @@ let checkResult (maskIsEqual: 'b -> 'b -> bool) vectorZero maskZero + isComplemented (actual: Vector<'a>) (vector: 'a []) (mask: 'b []) (value: 'a) = - let expectedArrayLength = max vector.Length mask.Length - let expectedArray = - Array.create expectedArrayLength vectorZero + Array.create vector.Length vectorZero - for i in 0 .. expectedArrayLength - 1 do - if i < mask.Length - && not <| maskIsEqual mask.[i] maskZero then + for i in 0 .. vector.Length - 1 do + if not <| maskIsEqual mask.[i] maskZero && not isComplemented then expectedArray.[i] <- value - elif i < vector.Length then + else expectedArray.[i] <- vector.[i] match actual with | VectorSparse actual -> let actualArray = - Array.create expectedArrayLength vectorZero + Array.create vector.Length vectorZero for i in 0 .. actual.Indices.Length - 1 do actualArray.[actual.Indices.[i]] <- actual.Values.[i] @@ -58,6 +56,7 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (fillVector: MailboxProcessor -> ClVector<'a> -> ClVector<'b> -> ClCell<'a> -> ClVector<'a>) (isValueValid: 'a -> bool) + isComplemented case (vector: 'a [], mask: 'b []) (value: 'a) @@ -100,7 +99,7 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> clActual.Dispose q cooClActual.Dispose q - checkResult vectorIsEqual maskIsEqual vectorZero maskZero actual vector mask value + checkResult vectorIsEqual maskIsEqual vectorZero maskZero isComplemented actual vector mask value with | ex when ex.Message = "InvalidBufferSize" -> () | ex -> raise ex @@ -117,12 +116,14 @@ let testFixtures case = let floatIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y + let isComplemented = false + [ let intFill = Vector.fillSubVector context StandardOperations.mask wgSize let intToCoo = Vector.toSparse context wgSize case - |> makeTest (=) (=) 0 0 intToCoo intFill (fun _ -> true) + |> makeTest (=) (=) 0 0 intToCoo intFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "int") let floatFill = Vector.fillSubVector context StandardOperations.mask wgSize @@ -130,7 +131,7 @@ let testFixtures case = let floatToCoo = Vector.toSparse context wgSize case - |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill System.Double.IsNormal + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill System.Double.IsNormal isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "float") let byteFill = Vector.fillSubVector context StandardOperations.mask wgSize @@ -138,7 +139,7 @@ let testFixtures case = let byteToCoo = Vector.toSparse context wgSize case - |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill (fun _ -> true) + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "byte") let boolFill = Vector.fillSubVector context StandardOperations.mask wgSize @@ -146,8 +147,55 @@ let testFixtures case = let boolToCoo = Vector.toSparse context wgSize case - |> makeTest (=) (=) false false boolToCoo boolFill (fun _ -> true) + |> makeTest (=) (=) false false boolToCoo boolFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] let tests = testsWithOperationCase testFixtures "Backend.Vector.fillSubVector tests" + + +let testFixturesComplemented case = + let config = defaultConfig + + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, vector: %A{case.Format}" + + let wgSize = 32 + let context = case.ClContext.ClContext + + let floatIsEqual x y = + abs (x - y) < Accuracy.medium.absolute || x = y + + let isComplemented = true + + [ let intFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + + let intToCoo = Vector.toSparse context wgSize + + case + |> makeTest (=) (=) 0 0 intToCoo intFill (fun _ -> true) isComplemented + |> testPropertyWithConfig config (getCorrectnessTestName "int") + + let floatFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + + let floatToCoo = Vector.toSparse context wgSize + + case + |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill System.Double.IsNormal isComplemented + |> testPropertyWithConfig config (getCorrectnessTestName "float") + + let byteFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + + let byteToCoo = Vector.toSparse context wgSize + + case + |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill (fun _ -> true) isComplemented + |> testPropertyWithConfig config (getCorrectnessTestName "byte") + + let boolFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + + let boolToCoo = Vector.toSparse context wgSize + + case + |> makeTest (=) (=) false false boolToCoo boolFill (fun _ -> true) isComplemented + |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] From 929e9fe2b6577059b3e1c500f9a42fd7ef7cbedb Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 13 Nov 2022 16:31:51 +0300 Subject: [PATCH 65/74] refactor: Vector.ofList, add: complemented tests, build pass --- .../Common/StandardOperations.fs | 18 +- .../GraphBLAS-sharp.Backend.fsproj | 3 +- .../Vector/DenseVector/DenseVector.fs | 41 +++- .../DenseVector/ElementwiseConstructor.fs | 108 --------- .../SparseVector/ElementwiseConstructor.fs | 213 ------------------ .../Vector/SparseVector/SparseElementwise.fs | 190 ++++++++++++++++ .../Vector/SparseVector/SparseVector.fs | 58 +++-- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 58 +++-- tests/GraphBLAS-sharp.Tests/Program.fs | 43 ++-- tests/GraphBLAS-sharp.Tests/Vector/Convert.fs | 6 +- .../Vector/ElementWise.fs | 27 +-- .../Vector/FillSubVector.fs | 55 +++-- tests/GraphBLAS-sharp.Tests/Vector/OfList.fs | 19 +- 13 files changed, 400 insertions(+), 439 deletions(-) delete mode 100644 src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs delete mode 100644 src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs create mode 100644 src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseElementwise.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index ff055279..1b3d6d4b 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -117,5 +117,21 @@ module StandardOperations = let complementedMask<'a, 'b when 'a: struct and 'b: struct> = <@ fun (left: 'a option) (right: 'b option) value -> match left, right with - | _, Some _-> left + | _, Some _ -> left | _ -> Some value @> + + let atLeastOneToNormalForm op = + <@ fun (leftItem: 'a option) (rightItem: 'b option) -> + match leftItem, rightItem with + | Some left, Some right -> (%op) (Both(left, right)) + | None, Some right -> (%op) (Right right) + | Some left, None -> (%op) (Left left) + | None, None -> None @> + + let fillSubVectorAtLeastOneToNormalForm op = + <@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> + match leftItem, rightItem with + | Some left, Some right -> (%op) (Both(left, right)) value + | None, Some right -> (%op) (Right right) value + | Some left, None -> (%op) (Left left) value + | None, None -> None @> diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 083f1aef..f2cdebc9 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -33,9 +33,8 @@ - + - diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 35661163..61b180ee 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -12,10 +12,17 @@ module DenseVector = (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseConstructor.kernel opAdd) + let elementWise = + <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> + let gid = ndRange.GlobalID0 + + if gid < resultLength then + resultVector.[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] @> + let kernel = clContext.Compile(elementWise) + + fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> let resultVector = clContext.CreateClArray( leftVector.Length, @@ -39,18 +46,27 @@ module DenseVector = resultVector let elementWiseAtLeastOne clContext op workGroupSize = - elementWise clContext (ElementwiseConstructor.atLeastOneToNormalForm op) workGroupSize + elementWise clContext (StandardOperations.atLeastOneToNormalForm op) workGroupSize let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) - (workGroupSize: int) = + (workGroupSize: int) + = + + let fillSubVectorKernel = + <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) -> + + let gid = ndRange.GlobalID0 + + if gid < resultLength then + resultVector.[gid] <- (%maskOp) leftVector.[gid] maskVector.[gid] value.Value @> - let kernel = clContext.Compile(ElementwiseConstructor.fillSubVectorKernel maskOp) + let kernel = clContext.Compile(fillSubVectorKernel) fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> - let resultArray = - clContext.CreateClArray( + let resultVector = + clContext.CreateClArray<'a option>( leftVector.Length, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, @@ -63,14 +79,16 @@ module DenseVector = let kernel = kernel.GetKernel() processor.Post( - Msg.MsgSetArguments(fun () -> - kernel.KernelFunc ndRange leftVector.Length leftVector maskVector value resultArray) + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector maskVector value resultVector) ) - resultArray + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + resultVector let fillSubVectorAtLeasOne clContext opAdd workGroupSize = - fillSubVector clContext (ElementwiseConstructor.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize + fillSubVector clContext (StandardOperations.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize let private getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = @@ -87,7 +105,6 @@ module DenseVector = let kernel = clContext.Compile(getPositions) fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> - let positions = clContext.CreateClArray( vector.Length, diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs deleted file mode 100644 index d208a42a..00000000 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/ElementwiseConstructor.fs +++ /dev/null @@ -1,108 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.DenseVector - -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common - -module ElementwiseConstructor = - // let private elementWiseGeneralKernel writeOp = - // <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> - // - // let gid = ndRange.GlobalID0 - // - // if gid < resultLength then - // resultVector[gid] <- (%writeOp) leftVector.[gid] rightVector.[gid] @> - // - // let private elementWiseWrite opAdd = - // <@ - // fun (leftItem: 'a option) (rightItem: 'b option) -> - // (%opAdd) leftItem rightItem - // @> - // - // let private elementWiseAtLeastOneWrite opAdd = - // <@ - // fun (leftItem: 'a option) (rightItem: 'b option) -> - // match leftItem, rightItem with - // | Some left, Some right -> (%opAdd) (Both(left, right)) - // | Some left, None -> (%opAdd) (Left left) - // | None, Some right -> (%opAdd) (Right right) - // | _ -> None - // @> - - // let kernel opAdd = elementWiseGeneralKernel <| elementWiseWrite opAdd - // - // let atLeastOneKernel opAdd = elementWiseGeneralKernel <| elementWiseAtLeastOneWrite opAdd - - let kernel opAdd = - <@ - fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> - - let gid = ndRange.GlobalID0 - - if gid < resultLength then - resultVector[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] - @> - - // let private fillSubVectorGeneralKernel writeOp = - // <@ - // fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'c option>) -> - // - // let gid = ndRange.GlobalID0 - // - // if gid < resultLength then - // resultVector[gid] <- (%writeOp) leftVector.[gid] rightVector.[gid] value.Value @> - // - // let private fillSubVectorWrite (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) = - // <@ - // fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> - // (%opAdd) leftItem rightItem value - // @> - // - // let private fillSubVectorAtLeastOneWrite (opAdd: Expr -> 'a-> 'a option>) = - // <@ - // fun (leftItem: 'a option) (rightItem: 'b option) (values: 'a) -> - // match leftItem, rightItem with - // | Some left, Some right -> (%opAdd) (Both(left, right)) values - // | Some left, None -> (%opAdd) (Left left) values - // | None, Some right -> (%opAdd) (Right right) values - // | _ -> None - // @> - - // let fillSubVector maskOp = fillSubVectorGeneralKernel <| fillSubVectorWrite maskOp - // - // let fillSubVectorAtLeastOne maskOp = fillSubVectorGeneralKernel <| fillSubVectorAtLeastOneWrite maskOp - let fillSubVectorKernel opAdd = - <@ - fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'c option>) -> - - let gid = ndRange.GlobalID0 - - if gid < resultLength then - resultVector[gid] <- (%opAdd) leftVector.[gid] rightVector.[gid] value.Value @> - - let atLeastOneToNormalForm op = - <@ - fun (leftItem: 'a option) (rightItem: 'b option) -> - match leftItem, rightItem with - | Some left, Some right -> - (%op) (Both(left, right)) - | None, Some right -> - (%op) (Right right) - | Some left, None -> - (%op) (Left left) - | None, None -> - None - @> - - let fillSubVectorAtLeastOneToNormalForm op = - <@ - fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> - match leftItem, rightItem with - | Some left, Some right -> - (%op) (Both(left, right)) value - | None, Some right -> - (%op) (Right right) value - | Some left, None -> - (%op) (Left left) value - | None, None -> - None - @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs deleted file mode 100644 index 56bcb2c9..00000000 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs +++ /dev/null @@ -1,213 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.SparseVector - -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common -open Microsoft.FSharp.Quotations - -module ElementwiseConstructor = - 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) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - - if localID < 2 then - let mutable x = localID * (workGroupSize - 1) + i - 1 - - if x >= sumOfSides then - x <- sumOfSides - 1 - - let diagonalNumber = x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstSide - 1 - - if rightEdge > diagonalNumber then - rightEdge <- diagonalNumber - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] - - let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge - - 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 - - if rightEdge > localID then - rightEdge <- localID - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = localID - leftEdge - - // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) - let isValidX = boundaryX >= 0 - let isValidY = boundaryY >= 0 - - let mutable fstIdx = 0 - - if isValidX then - fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0 - - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx <= sndIdx then - allIndicesBuffer.[i] <- sndIdx - secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - isLeftBitMap.[i] <- 0 - else - allIndicesBuffer.[i] <- fstIdx - firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - isLeftBitMap.[i] <- 1 @> - - let private both<'c> = - <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray) (allValuesBuffer: ClArray<'c>) -> - rawPositionsBuffer.[index] <- 0 - - match result with - | Some v -> - allValuesBuffer.[index + 1] <- v - rawPositionsBuffer.[index + 1] <- 1 - | None -> rawPositionsBuffer.[index + 1] <- 0 @> - - let private leftRight<'c> = - <@ fun index (leftResult: 'c option) (rightResult: 'c option) (isLeftBitmap: ClArray) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) -> - if isLeftBitmap.[index] = 1 then - match leftResult with - | Some v -> - allValuesBuffer.[index] <- v - rawPositionsBuffer.[index] <- 1 - | None -> rawPositionsBuffer.[index] <- 0 - else - match rightResult with - | Some v -> - allValuesBuffer.[index] <- v - rawPositionsBuffer.[index] <- 1 - | None -> rawPositionsBuffer.[index] <- 0 @> - - let prepareFillVector opAdd = - <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> - - let gid = ndRange.GlobalID0 - - let value = value.Value - - if gid < length - 1 - && allIndices.[gid] = allIndices.[gid + 1] then - let result = (%opAdd) (Some leftValues[gid]) (Some rightValues[gid + 1]) value - - (%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 value - let rightResult = (%opAdd) None (Some rightValues.[gid]) value - - (%leftRight) gid leftResult rightResult isLeft allValues positions @> - - 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]) - - (%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]) - - (%leftRight) gid leftResult rightResult isLeft allValues positions @> - - let atLeastOneToNormalForm (op: Expr -> 'c option>) = - <@ - fun (leftItem: 'a option) (rightItem: 'b option) -> - match leftItem, rightItem with - | Some left, Some right -> - (%op) (Both(left, right)) - | None, Some right -> - (%op) (Right right) - | Some left, None -> - (%op) (Left left) - | None, None -> - None - @> - - let fillSubVectorAtLeastOneToNormalForm (op: Expr -> 'a -> 'a option>) = - <@ - fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> - match leftItem, rightItem with - | Some left, Some right -> - (%op) (Both(left, right)) value - | None, Some right -> - (%op) (Right right) value - | Some left, None -> - (%op) (Left left) value - | None, None -> - None - @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseElementwise.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseElementwise.fs new file mode 100644 index 00000000..9fed462e --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseElementwise.fs @@ -0,0 +1,190 @@ +namespace GraphBLAS.FSharp.Backend.SparseVector + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Quotations + +module SparseElementwise = + 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) -> + + let i = ndRange.GlobalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 + + if localID < 2 then + let mutable x = localID * (workGroupSize - 1) + i - 1 + + if x >= sumOfSides then + x <- sumOfSides - 1 + + let diagonalNumber = x + + let mutable leftEdge = diagonalNumber + 1 - secondSide + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstSide - 1 + + if rightEdge > diagonalNumber then + rightEdge <- diagonalNumber + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = firstIndicesBuffer.[middleIdx] + + let secondIndex = + secondIndicesBuffer.[diagonalNumber - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + // Here localID equals either 0 or 1 + if localID = 0 then + beginIdxLocal <- leftEdge + else + endIdxLocal <- leftEdge + + 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 + + if rightEdge > localID then + rightEdge <- localID + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] + + let secondIndex = + localIndices.[firstLocalLength + localID - middleIdx] + + if firstIndex <= secondIndex then + leftEdge <- middleIdx + 1 + else + rightEdge <- middleIdx - 1 + + let boundaryX = rightEdge + let boundaryY = localID - leftEdge + + // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) + let isValidX = boundaryX >= 0 + let isValidY = boundaryY >= 0 + + let mutable fstIdx = 0 + + if isValidX then + fstIdx <- localIndices.[boundaryX] + + let mutable sndIdx = 0 + + if isValidY then + sndIdx <- localIndices.[firstLocalLength + boundaryY] + + if not isValidX || isValidY && fstIdx <= sndIdx then + allIndicesBuffer.[i] <- sndIdx + secondResultValues.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + isLeftBitMap.[i] <- 0 + else + allIndicesBuffer.[i] <- fstIdx + firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + isLeftBitMap.[i] <- 1 @> + + let private both<'c> = + <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray) (allValuesBuffer: ClArray<'c>) -> + rawPositionsBuffer.[index] <- 0 + + match result with + | Some v -> + allValuesBuffer.[index + 1] <- v + rawPositionsBuffer.[index + 1] <- 1 + | None -> rawPositionsBuffer.[index + 1] <- 0 @> + + let private leftRight<'c> = + <@ fun index (leftResult: 'c option) (rightResult: 'c option) (isLeftBitmap: ClArray) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray) -> + if isLeftBitmap.[index] = 1 then + match leftResult with + | Some v -> + allValuesBuffer.[index] <- v + rawPositionsBuffer.[index] <- 1 + | None -> rawPositionsBuffer.[index] <- 0 + else + match rightResult with + | Some v -> + allValuesBuffer.[index] <- v + rawPositionsBuffer.[index] <- 1 + | None -> rawPositionsBuffer.[index] <- 0 @> + + let prepareFillVector opAdd = + <@ fun (ndRange: Range1D) length (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> + + let gid = ndRange.GlobalID0 + + let value = value.Value + + if gid < length - 1 + && allIndices.[gid] = allIndices.[gid + 1] then + let result = + (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) value + + (%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 value + + let rightResult = + (%opAdd) None (Some rightValues.[gid]) value + + (%leftRight) gid leftResult rightResult isLeft allValues positions @> + + 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]) + + (%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]) + + (%leftRight) gid leftResult rightResult isLeft allValues positions @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 0979d58d..0aed5971 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -9,7 +9,8 @@ open Microsoft.FSharp.Quotations module SparseVector = let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseConstructor.merge workGroupSize) + let kernel = + clContext.Compile(SparseElementwise.merge workGroupSize) fun (processor: MailboxProcessor<_>) (firstIndices: ClArray) (firstValues: ClArray<'a>) (secondIndices: ClArray) (secondValues: ClArray<'b>) -> @@ -85,7 +86,8 @@ module SparseVector = (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseConstructor.preparePositions op) + let kernel = + clContext.Compile(SparseElementwise.preparePositions op) fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> @@ -150,7 +152,7 @@ module SparseVector = res.[0] let resultValues = - clContext.CreateClArray( + clContext.CreateClArray<'a>( resultLength, hostAccessMode = HostAccessMode.NotAccessible, deviceAccessMode = DeviceAccessMode.ReadWrite, @@ -183,7 +185,7 @@ module SparseVector = let merge = merge clContext workGroupSize let prepare = - preparePositions<'a, 'b , 'c> clContext op workGroupSize + preparePositions<'a, 'b, 'c> clContext op workGroupSize let setPositions = setPositions clContext workGroupSize @@ -211,16 +213,21 @@ module SparseVector = Indices = resultIndices Size = max leftVector.Size rightVector.Size } - let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) (workGroupSize: int) = - elementWise clContext (ElementwiseConstructor.atLeastOneToNormalForm opAdd) workGroupSize + let elementWiseAtLeastOne + (clContext: ClContext) + (opAdd: Expr -> 'c option>) + (workGroupSize: int) + = + elementWise clContext (StandardOperations.atLeastOneToNormalForm opAdd) workGroupSize - let private preparePositionsFillSubVector<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + let private preparePositionsFillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op (workGroupSize: int) = - let kernel = clContext.Compile(ElementwiseConstructor.prepareFillVector op) + let kernel = + clContext.Compile(SparseElementwise.prepareFillVector op) fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray) -> @@ -250,7 +257,16 @@ module SparseVector = processor.Post( Msg.MsgSetArguments (fun () -> - kernel.KernelFunc ndRange length allIndices leftValues rightValues value isLeft allValues positions) + kernel.KernelFunc + ndRange + length + allIndices + leftValues + rightValues + value + isLeft + allValues + positions) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -260,11 +276,7 @@ module SparseVector = ///. ///. ///Should be a power of 2 and greater than 1. - let fillSubVector<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) - op - (workGroupSize: int) - = + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op (workGroupSize: int) = let merge = merge clContext workGroupSize @@ -298,7 +310,7 @@ module SparseVector = Size = max leftVector.Size rightVector.Size } let fillSubVectorAtLeastOne (clContext: ClContext) opAdd (workGroupSize: int) = - fillSubVector clContext (ElementwiseConstructor.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize + fillSubVector clContext (StandardOperations.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize let toDense (clContext: ClContext) (workGroupSize: int) = @@ -313,28 +325,26 @@ module SparseVector = let kernel = clContext.Compile(toDense) - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + let create = + ClArray.zeroCreate clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClSparseVector<'a>) -> + let resultVector = create processor vector.Size - let resultArray = zeroCreate processor vector.Size - - let ndRange = Range1D.CreateValid(vector.Indices.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(vector.Indices.Length, workGroupSize) let kernel = kernel.GetKernel() processor.Post( Msg.MsgSetArguments (fun () -> - kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultArray) + kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultVector) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - processor.Post(Msg.CreateFreeMsg<_>(vector.Indices)) - processor.Post(Msg.CreateFreeMsg<_>(vector.Values)) - - resultArray + resultVector let reduce<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 2ba4444a..125c40dd 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -26,23 +26,21 @@ module Vector = | Dense -> ClVectorDense <| zeroCreate processor size let ofList (clContext: ClContext) = - fun (format: VectorFormat) (elements: (int * 'a) list) -> + fun (format: VectorFormat) size (elements: (int * 'a) list) -> let indices, values = elements |> Array.ofList |> Array.sortBy fst |> Array.unzip - let resultLenght = (Array.max indices) + 1 - match format with | Sparse -> SparseVector - .FromTuples(indices, values, resultLenght) + .FromTuples(indices, values, size) .ToDevice clContext |> ClVectorSparse | Dense -> - let res = Array.zeroCreate resultLenght + let res = Array.zeroCreate size for i in 0 .. indices.Length - 1 do res.[indices.[i]] <- Some(values.[i]) @@ -72,7 +70,7 @@ module Vector = let toSparse (clContext: ClContext) (workGroupSize: int) = let toSparse = - DenseVector.DenseVector.toSparse clContext workGroupSize + DenseVector.toSparse clContext workGroupSize let copy = copy clContext workGroupSize @@ -89,10 +87,8 @@ module Vector = fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with - | ClVectorDense vector -> - ClVectorDense <| copy processor vector - | ClVectorSparse vector -> - ClVectorDense <| toDense processor vector + | ClVectorDense vector -> ClVectorDense <| copy processor vector + | ClVectorSparse vector -> ClVectorDense <| toDense processor vector let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = let addSparse = @@ -108,13 +104,17 @@ module Vector = | _ -> failwith "Vector formats are not matching." let elementWise (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) (workGroupSize: int) = - let addDense = DenseVector.elementWise clContext opAdd workGroupSize + let addDense = + DenseVector.elementWise clContext opAdd workGroupSize - let addSparse = SparseVector.elementWise clContext opAdd workGroupSize + let addSparse = + SparseVector.elementWise clContext opAdd workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with - | ClVectorDense leftVector, ClVectorDense rightVector -> ClVectorDense <| addDense processor leftVector rightVector + | ClVectorDense leftVector, ClVectorDense rightVector -> + ClVectorDense + <| addDense processor leftVector rightVector | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addSparse processor left right | _ -> failwith "Vector formats are not matching." @@ -150,6 +150,38 @@ module Vector = ClVectorDense <| denseFillVector processor vector mask value + let fillSubVectorComplemented (clContext: ClContext) maskOp (workGroupSize: int) = + let denseFillVector = + DenseVector.fillSubVector clContext maskOp workGroupSize + + let vectorToDense = + SparseVector.toDense clContext workGroupSize + + let maskToDense = + SparseVector.toDense clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (maskVector: ClVector<'b>) (value: ClCell<'a>) -> + match leftVector, maskVector with + | ClVectorSparse vector, ClVectorSparse mask -> + let denseVector = vectorToDense processor vector + let denseMask = maskToDense processor mask + + ClVectorDense + <| denseFillVector processor denseVector denseMask value + | ClVectorDense vector, ClVectorSparse mask -> + let denseMask = maskToDense processor mask + + ClVectorDense + <| denseFillVector processor vector denseMask value + | ClVectorSparse vector, ClVectorDense mask -> + let denseVector = vectorToDense processor vector + + ClVectorDense + <| denseFillVector processor denseVector mask value + | ClVectorDense vector, ClVectorDense mask -> + ClVectorDense + <| denseFillVector processor vector mask value + let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let sparseReduce = SparseVector.reduce clContext workGroupSize opAdd diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index e9b69710..aab31a35 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -11,35 +11,34 @@ open GraphBLAS.FSharp.IO let allTests = testList "All tests" - [ - // [ Backend.Mxm.tests - // Backend.BitonicSort.tests - // Backend.PrefixSum.tests - // Backend.Scatter.tests - // Backend.Convert.tests - // Backend.RemoveDuplicates.tests - // Backend.Copy.tests - // Backend.Replicate.tests + [ Backend.Mxm.tests + Backend.BitonicSort.tests + Backend.PrefixSum.tests + Backend.Scatter.tests + Backend.Convert.tests + Backend.RemoveDuplicates.tests + Backend.Copy.tests + Backend.Replicate.tests //Backend.Elementwise.elementwiseAddTests //Backend.Elementwise.elementwiseAddAtLeastOneTests //Backend.Elementwise.elementwiseAddAtLeastOneToCOOTests //Backend.Elementwise.elementwiseMulAtLeastOneTests - // Backend.Transpose.tests + Backend.Transpose.tests //Matrix.GetTuples.tests //Matrix.Mxv.tests //Algo.Bfs.tests - // Backend.Reduce.tests - // Backend.Vector.ZeroCreate.tests - // Backend.Vector.OfList.tests - // Backend.Vector.Copy.tests - // Backend.Vector.Convert.tests - Backend.Vector.ElementWiseAtLeastOne.addTests - Backend.Vector.ElementWiseAtLeastOne.mulTests - Backend.Vector.ElementWise.addTests - Backend.Vector.ElementWise.mulTests - // Backend.Vector.FillSubVector.tests - // Backend.Vector.Reduce.tests ] - ] + Backend.Reduce.tests + Backend.Vector.ZeroCreate.tests + Backend.Vector.OfList.tests + Backend.Vector.Copy.tests + Backend.Vector.Convert.tests + Backend.Vector.ElementWiseAtLeastOne.addTests + Backend.Vector.ElementWiseAtLeastOne.mulTests + Backend.Vector.ElementWise.addTests + Backend.Vector.ElementWise.mulTests + Backend.Vector.FillSubVector.tests + Backend.Vector.FillSubVector.complementedTests + Backend.Vector.Reduce.tests ] |> testSequenced [] diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs index 46918a4b..741dde50 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs @@ -13,8 +13,12 @@ let logger = let config = defaultConfig let wgSize = 32 +let NNZCount array isZero = + Array.filter (fun item -> not <| isZero item) array + |> Array.length + let makeTest formatFrom (convertFun: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) isZero case (array: 'a []) = - if array.Length > 0 then + if array.Length > 0 && NNZCount array isZero > 0 then let context = case.ClContext.ClContext let q = case.ClContext.Queue diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs index 5dc04c7f..9450cd44 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/ElementWise.fs @@ -7,8 +7,7 @@ open GraphBLAS.FSharp.Tests.Utils open GraphBLAS.FSharp.Backend.Common open StandardOperations -let logger = - Log.create "Vector.ElementWise.Tests" +let logger = Log.create "Vector.ElementWise.Tests" let config = defaultConfig @@ -16,14 +15,7 @@ let NNZCountCount array isZero = Array.filter (fun item -> not <| isZero item) array |> Array.length -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 @@ -33,7 +25,8 @@ let checkResult for i in 0 .. expectedArrayLength - 1 do expectedArray.[i] <- op leftArray.[i] rightArray.[i] - let (VectorDense expected) = createVectorFromArray Dense expectedArray (isEqual resultZero) + let (VectorDense expected) = + createVectorFromArray Dense expectedArray (isEqual resultZero) match actual with | VectorDense actual -> @@ -102,8 +95,7 @@ let addTestFixtures case = let context = case.ClContext.ClContext - [ let intAddFun = - Vector.elementWise context intSum wgSize + [ let intAddFun = Vector.elementWise context intSum wgSize let intToDense = Vector.toDense context wgSize @@ -141,7 +133,8 @@ let addTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (+) byteAddFun byteToDense |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let addTests = testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseAdd tests" +let addTests = + testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseAdd tests" let mulTestFixtures case = let getCorrectnessTestName fstType sndType thrType = @@ -151,8 +144,7 @@ let mulTestFixtures case = let context = case.ClContext.ClContext - [ let intMulFun = - Vector.elementWise context intMul wgSize + [ let intMulFun = Vector.elementWise context intMul wgSize let intToDense = Vector.toDense context wgSize @@ -190,4 +182,5 @@ let mulTestFixtures case = |> correctnessGenericTest (=) (=) (=) 0uy 0uy 0uy (*) byteMulFun byteToDense |> testPropertyWithConfig config (getCorrectnessTestName "byte" "byte" "byte") ] -let mulTests = testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseMul tests" +let mulTests = + testsWithOperationCase addTestFixtures "Backend.Vector.ElementWiseMul tests" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs index 4fc61d40..e404b170 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs @@ -11,10 +11,16 @@ let logger = Log.create "Vector.fillSubVector.Tests" let clContext = defaultContext.ClContext -let NNZCountCount array isZero = +let NNZCount array isZero = Array.filter (fun item -> not <| isZero item) array |> Array.length +let complemented isComplemented value = + if isComplemented then + not value + else + value + let checkResult (resultIsEqual: 'a -> 'a -> bool) (maskIsEqual: 'b -> 'b -> bool) @@ -27,19 +33,19 @@ let checkResult (value: 'a) = - let expectedArray = - Array.create vector.Length vectorZero + let expectedArray = Array.create vector.Length vectorZero + + let complemented = complemented isComplemented for i in 0 .. vector.Length - 1 do - if not <| maskIsEqual mask.[i] maskZero && not isComplemented then + if complemented (not <| maskIsEqual mask.[i] maskZero) then expectedArray.[i] <- value else expectedArray.[i] <- vector.[i] match actual with | VectorSparse actual -> - let actualArray = - Array.create vector.Length vectorZero + let actualArray = Array.create vector.Length vectorZero for i in 0 .. actual.Indices.Length - 1 do actualArray.[actual.Indices.[i]] <- actual.Values.[i] @@ -63,10 +69,9 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> = let vectorNNZ = - NNZCountCount vector (vectorIsEqual vectorZero) + NNZCount vector (vectorIsEqual vectorZero) - let maskNNZ = - NNZCountCount mask (maskIsEqual maskZero) + let maskNNZ = NNZCount mask (maskIsEqual maskZero) if vectorNNZ > 0 && maskNNZ > 0 && isValueValid value then let q = case.ClContext.Queue @@ -83,13 +88,11 @@ let makeTest<'a, 'b when 'a: struct and 'b: struct> let clMaskVector = maskVector.ToDevice context try - let clValue = context.CreateClCell value + let clValue = context.CreateClCell<'a> value let clActual = fillVector q clLeftVector clMaskVector clValue - clValue.Dispose () - let cooClActual = toCoo q clActual let actual = cooClActual.ToHost q @@ -118,7 +121,8 @@ let testFixtures case = let isComplemented = false - [ let intFill = Vector.fillSubVector context StandardOperations.mask wgSize + [ let intFill = + Vector.fillSubVector context StandardOperations.mask wgSize let intToCoo = Vector.toSparse context wgSize @@ -126,7 +130,8 @@ let testFixtures case = |> makeTest (=) (=) 0 0 intToCoo intFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "int") - let floatFill = Vector.fillSubVector context StandardOperations.mask wgSize + let floatFill = + Vector.fillSubVector context StandardOperations.mask wgSize let floatToCoo = Vector.toSparse context wgSize @@ -134,7 +139,8 @@ let testFixtures case = |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill System.Double.IsNormal isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "float") - let byteFill = Vector.fillSubVector context StandardOperations.mask wgSize + let byteFill = + Vector.fillSubVector context StandardOperations.mask wgSize let byteToCoo = Vector.toSparse context wgSize @@ -142,7 +148,8 @@ let testFixtures case = |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "byte") - let boolFill = Vector.fillSubVector context StandardOperations.mask wgSize + let boolFill = + Vector.fillSubVector context StandardOperations.mask wgSize let boolToCoo = Vector.toSparse context wgSize @@ -153,7 +160,6 @@ let testFixtures case = let tests = testsWithOperationCase testFixtures "Backend.Vector.fillSubVector tests" - let testFixturesComplemented case = let config = defaultConfig @@ -168,7 +174,8 @@ let testFixturesComplemented case = let isComplemented = true - [ let intFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + [ let intFill = + Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize let intToCoo = Vector.toSparse context wgSize @@ -176,7 +183,8 @@ let testFixturesComplemented case = |> makeTest (=) (=) 0 0 intToCoo intFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "int") - let floatFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + let floatFill = + Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize let floatToCoo = Vector.toSparse context wgSize @@ -184,7 +192,8 @@ let testFixturesComplemented case = |> makeTest floatIsEqual floatIsEqual 0.0 0.0 floatToCoo floatFill System.Double.IsNormal isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "float") - let byteFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + let byteFill = + Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize let byteToCoo = Vector.toSparse context wgSize @@ -192,10 +201,14 @@ let testFixturesComplemented case = |> makeTest (=) (=) 0uy 0uy byteToCoo byteFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "byte") - let boolFill = Vector.fillSubVector context StandardOperations.complementedMask wgSize + let boolFill = + Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize let boolToCoo = Vector.toSparse context wgSize case |> makeTest (=) (=) false false boolToCoo boolFill (fun _ -> true) isComplemented |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] + +let complementedTests = + testsWithOperationCase testFixturesComplemented "Backend.Vector.fillSubVectorComplemented tests" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs index e43cbf5a..412912e2 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs @@ -9,9 +9,15 @@ open OpenCL.Net let logger = Log.create "Vector.ofList.Tests" -let checkResult (isEqual: 'a -> 'a -> bool) (expectedIndices: int []) (expectedValues: 'a []) (actual: Vector<'a>) = +let checkResult + (isEqual: 'a -> 'a -> bool) + (expectedIndices: int []) + (expectedValues: 'a []) + (actual: Vector<'a>) + actualSize + = - Expect.equal actual.Size (Array.max expectedIndices + 1) "lengths must be the same" + Expect.equal actual.Size actualSize "lengths must be the same" match actual with | VectorSparse actual -> @@ -21,10 +27,11 @@ let checkResult (isEqual: 'a -> 'a -> bool) (expectedIndices: int []) (expectedV let correctnessGenericTest<'a when 'a: struct> (isEqual: 'a -> 'a -> bool) - (ofList: VectorFormat -> (int * 'a) list -> ClVector<'a>) + (ofList: VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) (toCoo: MailboxProcessor<_> -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) (elements: (int * 'a) []) + (sizeDelta: int) = let elements = @@ -40,7 +47,9 @@ let correctnessGenericTest<'a when 'a: struct> |> Array.sortBy fst |> Array.unzip - let clActual = ofList case.Format elements + let actualSize = (Array.max indices) + abs sizeDelta + 1 + + let clActual = ofList case.Format actualSize elements let clCooActual = toCoo q clActual @@ -49,7 +58,7 @@ let correctnessGenericTest<'a when 'a: struct> clActual.Dispose q clCooActual.Dispose q - checkResult isEqual indices values actual + checkResult isEqual indices values actual actualSize let testFixtures (case: OperationCase) = [ let config = defaultConfig From 50f28e759b5a83888eb5dc28dc2796a7b6e6e3fd Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 13 Nov 2022 17:27:11 +0300 Subject: [PATCH 66/74] refactor: paths --- src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 7 ------- .../GraphBLAS-sharp.Backend.fsproj | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 16 ++++++++-------- 3 files changed, 9 insertions(+), 16 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index b9546593..539cfa34 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -15,13 +15,6 @@ module Reduce = let localValues = localArray<'a> workGroupSize - // let i = (gid - lid) * 2 + lid - - // if i + workGroupSize < length then - // localValues.[lid] <- (%opAdd) inputArray.[i] inputArray.[i + workGroupSize] - // elif i < length then - // localValues.[lid] <- inputArray.[i] - if gid < length then localValues.[lid] <- inputArray.[gid] diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index f2cdebc9..be4b7231 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -33,7 +33,7 @@ - + diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 4e248623..39157a14 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -27,14 +27,14 @@ - - - - - - - - + + + + + + + + From 6a411989b149afa5c7d81a3f374ad4864f2e1ac7 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 15 Nov 2022 11:09:22 +0300 Subject: [PATCH 67/74] refactor: Vector.fillSubVector, .fillSubVectorComplemented --- .../Common/StandardOperations.fs | 44 ++++++++----------- .../Vector/DenseVector/DenseVector.fs | 5 +-- .../Vector/SparseVector/SparseVector.fs | 5 +-- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 20 ++++++--- .../Vector/FillSubVector.fs | 16 +++---- 5 files changed, 44 insertions(+), 46 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 1b3d6d4b..6cb8d152 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -1,5 +1,7 @@ namespace GraphBLAS.FSharp.Backend.Common +open FSharp.Quotations + type AtLeastOne<'a, 'b when 'a: struct and 'b: struct> = | Both of 'a * 'b | Left of 'a @@ -102,25 +104,7 @@ module StandardOperations = let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f - let mask<'a, 'b when 'a: struct and 'b: struct> = - <@ fun (left: 'a option) (right: 'b option) value -> - match left, right with - | _, None -> left - | _ -> Some value @> - - let maskAtLeastOne<'a, 'b when 'a: struct and 'b: struct> = - <@ fun (pair: AtLeastOne<'a, 'b>) value -> - match pair with - | Left left -> Some left - | _ -> Some value @> - - let complementedMask<'a, 'b when 'a: struct and 'b: struct> = - <@ fun (left: 'a option) (right: 'b option) value -> - match left, right with - | _, Some _ -> left - | _ -> Some value @> - - let atLeastOneToNormalForm op = + let atLeastOneToOption op = <@ fun (leftItem: 'a option) (rightItem: 'b option) -> match leftItem, rightItem with | Some left, Some right -> (%op) (Both(left, right)) @@ -128,10 +112,20 @@ module StandardOperations = | Some left, None -> (%op) (Left left) | None, None -> None @> - let fillSubVectorAtLeastOneToNormalForm op = + let fillSubToOption (op: Expr<'a option -> 'a option -> 'a option>) = <@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> - match leftItem, rightItem with - | Some left, Some right -> (%op) (Both(left, right)) value - | None, Some right -> (%op) (Right right) value - | Some left, None -> (%op) (Left left) value - | None, None -> None @> + match rightItem with + | Some _ -> (%op) leftItem (Some value) + | None -> (%op) leftItem None @> + + let fillSubComplementedToOption (op: Expr<'a option -> 'a option -> 'a option>) = + <@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) -> + match rightItem with + | Some _ -> (%op) leftItem None + | None -> (%op) leftItem (Some value) @> + + let mask<'a when 'a: struct> = + <@ fun (left: 'a option) (right: 'a option) -> + match left, right with + | _, None -> left + | _ -> right @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 61b180ee..808be02d 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -46,7 +46,7 @@ module DenseVector = resultVector let elementWiseAtLeastOne clContext op workGroupSize = - elementWise clContext (StandardOperations.atLeastOneToNormalForm op) workGroupSize + elementWise clContext (StandardOperations.atLeastOneToOption op) workGroupSize let fillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) @@ -87,9 +87,6 @@ module DenseVector = resultVector - let fillSubVectorAtLeasOne clContext opAdd workGroupSize = - fillSubVector clContext (StandardOperations.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize - let private getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let getPositions = diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 0aed5971..8792a867 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -218,7 +218,7 @@ module SparseVector = (opAdd: Expr -> 'c option>) (workGroupSize: int) = - elementWise clContext (StandardOperations.atLeastOneToNormalForm opAdd) workGroupSize + elementWise clContext (StandardOperations.atLeastOneToOption opAdd) workGroupSize let private preparePositionsFillSubVector<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) @@ -309,9 +309,6 @@ module SparseVector = Indices = resultIndices Size = max leftVector.Size rightVector.Size } - let fillSubVectorAtLeastOne (clContext: ClContext) opAdd (workGroupSize: int) = - fillSubVector clContext (StandardOperations.fillSubVectorAtLeastOneToNormalForm opAdd) workGroupSize - let toDense (clContext: ClContext) (workGroupSize: int) = let toDense = diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 125c40dd..08fec52b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -118,12 +118,12 @@ module Vector = | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addSparse processor left right | _ -> failwith "Vector formats are not matching." - let fillSubVector (clContext: ClContext) maskOp (workGroupSize: int) = + let fillSubVector<'a, 'b when 'a: struct and 'b: struct> maskOp (clContext: ClContext) (workGroupSize: int) = let sparseFillVector = - SparseVector.fillSubVector clContext maskOp workGroupSize + SparseVector.fillSubVector clContext (StandardOperations.fillSubToOption maskOp) workGroupSize let denseFillVector = - DenseVector.fillSubVector clContext maskOp workGroupSize + DenseVector.fillSubVector clContext (StandardOperations.fillSubToOption maskOp) workGroupSize let toSparseVector = DenseVector.toSparse clContext workGroupSize @@ -150,9 +150,13 @@ module Vector = ClVectorDense <| denseFillVector processor vector mask value - let fillSubVectorComplemented (clContext: ClContext) maskOp (workGroupSize: int) = + let fillSubVectorComplemented<'a, 'b when 'a: struct and 'b: struct> + maskOp + (clContext: ClContext) + (workGroupSize: int) + = let denseFillVector = - DenseVector.fillSubVector clContext maskOp workGroupSize + DenseVector.fillSubVector clContext (StandardOperations.fillSubComplementedToOption maskOp) workGroupSize let vectorToDense = SparseVector.toDense clContext workGroupSize @@ -182,6 +186,12 @@ module Vector = ClVectorDense <| denseFillVector processor vector mask value + let standardFillSubVector<'a, 'b when 'a: struct and 'b: struct> = + fillSubVector<'a, 'b> StandardOperations.mask<'a> + + let standardFillSubVectorComplemented<'a, 'b when 'a: struct and 'b: struct> = + fillSubVectorComplemented<'a, 'b> StandardOperations.mask<'a> + let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let sparseReduce = SparseVector.reduce clContext workGroupSize opAdd diff --git a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs index 5bd13b05..e28d892e 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/FillSubVector.fs @@ -124,7 +124,7 @@ let testFixtures case = let isComplemented = false [ let intFill = - Vector.fillSubVector context StandardOperations.mask wgSize + Vector.standardFillSubVector context wgSize let intToCoo = Vector.toSparse context wgSize @@ -133,7 +133,7 @@ let testFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "int") let floatFill = - Vector.fillSubVector context StandardOperations.mask wgSize + Vector.standardFillSubVector context wgSize let floatToCoo = Vector.toSparse context wgSize @@ -142,7 +142,7 @@ let testFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "float") let byteFill = - Vector.fillSubVector context StandardOperations.mask wgSize + Vector.standardFillSubVector context wgSize let byteToCoo = Vector.toSparse context wgSize @@ -151,7 +151,7 @@ let testFixtures case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") let boolFill = - Vector.fillSubVector context StandardOperations.mask wgSize + Vector.standardFillSubVector context wgSize let boolToCoo = Vector.toSparse context wgSize @@ -177,7 +177,7 @@ let testFixturesComplemented case = let isComplemented = true [ let intFill = - Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize + Vector.standardFillSubVectorComplemented context wgSize let intToCoo = Vector.toSparse context wgSize @@ -186,7 +186,7 @@ let testFixturesComplemented case = |> testPropertyWithConfig config (getCorrectnessTestName "int") let floatFill = - Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize + Vector.standardFillSubVectorComplemented context wgSize let floatToCoo = Vector.toSparse context wgSize @@ -195,7 +195,7 @@ let testFixturesComplemented case = |> testPropertyWithConfig config (getCorrectnessTestName "float") let byteFill = - Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize + Vector.standardFillSubVectorComplemented context wgSize let byteToCoo = Vector.toSparse context wgSize @@ -204,7 +204,7 @@ let testFixturesComplemented case = |> testPropertyWithConfig config (getCorrectnessTestName "byte") let boolFill = - Vector.fillSubVectorComplemented context StandardOperations.complementedMask wgSize + Vector.standardFillSubVectorComplemented context wgSize let boolToCoo = Vector.toSparse context wgSize From f14ab7882da30bb3ca1448851d78e97c9d66c0d4 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 15 Nov 2022 11:36:10 +0300 Subject: [PATCH 68/74] build: pass locally --- src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs | 3 ++- .../Vector/SparseVector/SparseVector.fs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 808be02d..b66c00aa 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -4,6 +4,7 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Predefined module DenseVector = let elementWise<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> @@ -144,7 +145,7 @@ module DenseVector = let getPositions = getBitmap clContext workGroupSize let prefixSum = - ClArray.prefixSumExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInplace clContext workGroupSize let resultLength = Array.zeroCreate 1 diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs index 8792a867..0a02d5fc 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs @@ -5,6 +5,7 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Common open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Predefined module SparseVector = let private merge<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) = @@ -127,7 +128,7 @@ module SparseVector = let private setPositions<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) = let sum = - ClArray.prefixSumExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInplace clContext workGroupSize let valuesScatter = Scatter.runInplace clContext workGroupSize From c611da2e405540aa03e77cd920f110cac46896f1 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 15 Nov 2022 11:43:23 +0300 Subject: [PATCH 69/74] refactor: Helpers, Vector --- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 1 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 08fec52b..a5aeea64 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -155,6 +155,7 @@ module Vector = (clContext: ClContext) (workGroupSize: int) = + let denseFillVector = DenseVector.fillSubVector clContext (StandardOperations.fillSubComplementedToOption maskOp) workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 3d0416a2..60cbf8f4 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -755,7 +755,7 @@ module TestCases = |> contextFilter |> List.ofSeq - let matrixTestCases<'a> contextFilter = + let getTestCases<'a> contextFilter = Context.availableContexts defaultPlatformRegex |> contextFilter |> List.ofSeq @@ -770,7 +770,7 @@ module TestCases = Format = snd pair }) let operationGPUTests name (testFixtures: OperationCase<'a> -> Test list) = - matrixTestCases<'a> Context.gpuOnlyContextFilter + getTestCases<'a> Context.gpuOnlyContextFilter |> List.distinctBy (fun case -> case.ClContext.ClContext, case.Format) |> List.collect testFixtures |> testList name From f118659eccb6bf4206125ffd9918e967730fc9cf Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 18 Nov 2022 11:25:20 +0300 Subject: [PATCH 70/74] rename: mask -> fillSubOp, add: maskOp --- src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs | 8 +++++++- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 4 ++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 6cb8d152..14127639 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -124,8 +124,14 @@ module StandardOperations = | Some _ -> (%op) leftItem None | None -> (%op) leftItem (Some value) @> - let mask<'a when 'a: struct> = + let fillSubOp<'a when 'a: struct> = <@ fun (left: 'a option) (right: 'a option) -> match left, right with | _, None -> left | _ -> right @> + + let maskOp<'a, 'b when 'a: struct and 'b: struct> = + <@ fun (left: 'a option) (right: 'b option) -> + match left, right with + | _, Some _ -> left + | _ -> None @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index a5aeea64..f09fb5a6 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -188,10 +188,10 @@ module Vector = <| denseFillVector processor vector mask value let standardFillSubVector<'a, 'b when 'a: struct and 'b: struct> = - fillSubVector<'a, 'b> StandardOperations.mask<'a> + fillSubVector<'a, 'b> StandardOperations.fillSubOp<'a> let standardFillSubVectorComplemented<'a, 'b when 'a: struct and 'b: struct> = - fillSubVectorComplemented<'a, 'b> StandardOperations.mask<'a> + fillSubVectorComplemented<'a, 'b> StandardOperations.fillSubOp<'a> let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let sparseReduce = From a0c25a4ad12c983e0eaf1d766add6fcb7d924528 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 18 Nov 2022 23:17:38 +0300 Subject: [PATCH 71/74] add: complementedMaskOp --- src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 14127639..57e6e266 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -135,3 +135,9 @@ module StandardOperations = match left, right with | _, Some _ -> left | _ -> None @> + + let complementedMaskOp<'a, 'b when 'a: struct and 'b: struct> = + <@ fun (left: 'a option) (right: 'b option) -> + match left, right with + | _, None -> left + | _ -> None @> From 251b6114f7b4a4d9ed1dbccb2784691149754441 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 18 Nov 2022 23:32:30 +0300 Subject: [PATCH 72/74] refactor: Reduce.fs --- .../Common/CommonQuotes.fs | 17 +++++ src/GraphBLAS-sharp.Backend/Common/Reduce.fs | 66 +++++++++++++------ .../BackendCommonTests/ReduceTests.fs | 2 +- tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs | 2 +- 4 files changed, 66 insertions(+), 21 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/CommonQuotes.fs b/src/GraphBLAS-sharp.Backend/Common/CommonQuotes.fs index 3c29b316..00c865b9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/CommonQuotes.fs +++ b/src/GraphBLAS-sharp.Backend/Common/CommonQuotes.fs @@ -36,6 +36,23 @@ module SubSum = let treeSum<'a> opAdd = sumGeneral<'a> <| treeAccess<'a> opAdd +module SubReduce = + let run opAdd = + <@ fun length wgSize gid lid (localValues: 'a []) -> + let mutable step = 2 + + while step <= wgSize do + if (gid + wgSize / step) < length + && lid < wgSize / step then + let firstValue = localValues.[lid] + let secondValue = localValues.[lid + wgSize / step] + + localValues.[lid] <- (%opAdd) firstValue secondValue + + step <- step <<< 1 + + barrierLocal () @> + module PreparePositions = let both<'c> = <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray) (allValuesBuffer: ClArray<'c>) -> diff --git a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs index 539cfa34..0468a10a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Reduce.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Reduce.fs @@ -1,6 +1,7 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp +open GraphBLAS.FSharp.Backend open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations @@ -20,20 +21,9 @@ module Reduce = barrierLocal () - let mutable step = 2 - if gid < length then - while step <= workGroupSize do - if (gid + workGroupSize / step) < length - && lid < workGroupSize / step then - let firstValue = localValues.[lid] - let secondValue = localValues.[lid + workGroupSize / step] - - localValues.[lid] <- (%opAdd) firstValue secondValue - - step <- step <<< 1 - barrierLocal () + (%SubReduce.run opAdd) length workGroupSize gid lid localValues if lid = 0 then resultArray.[gid / workGroupSize] <- localValues.[0] @> @@ -53,10 +43,53 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let private scanToCell<'a when 'a: struct> + (clContext: ClContext) + (workGroupSize: int) + (opAdd: Expr<'a -> 'a -> 'a>) + = + + let scan = + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultValue: ClCell<'a>) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let localValues = localArray<'a> workGroupSize + + if gid < length then + localValues.[lid] <- inputArray.[gid] + + barrierLocal () + + if gid < length then + + (%SubReduce.run opAdd) length workGroupSize gid lid localValues + + if lid = 0 then + resultValue.Value <- localValues.[0] @> + + let kernel = clContext.Compile(scan) + + fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultValue: ClCell<'a>) -> + + let ndRange = + Range1D.CreateValid(valuesArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultValue) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let run<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) = let scan = scan clContext workGroupSize opAdd + let scanToCell = scanToCell clContext workGroupSize opAdd + fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> let scan = scan processor @@ -101,14 +134,9 @@ module Reduce = let fstVertices = fst verticesArrays let result = - clContext.CreateClArray( - 1, - hostAccessMode = HostAccessMode.NotAccessible, - deviceAccessMode = DeviceAccessMode.ReadWrite, - allocationMode = AllocationMode.Default - ) + clContext.CreateClCell Unchecked.defaultof<'a> - scan fstVertices verticesLength result + scanToCell processor fstVertices verticesLength result processor.Post(Msg.CreateFreeMsg(firstVerticesArray)) processor.Post(Msg.CreateFreeMsg(secondVerticesArray)) diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index d32e2e40..bbea333f 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -14,7 +14,7 @@ let context = Context.defaultContext.ClContext let makeTest (q: MailboxProcessor<_>) - (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClArray<'a>) + (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zero (filter: 'a [] -> 'a []) diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs index 4e9b19f0..2a3f7c3a 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs @@ -27,7 +27,7 @@ let correctnessGenericTest zero op opQ - (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClArray<'a>) + (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) filter case (array: 'a []) From 595c187ae0159699b5ecda642b62395d140fa536 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 18 Nov 2022 23:34:38 +0300 Subject: [PATCH 73/74] refactor: StandartOperations --- src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs index 57e6e266..96a1008f 100644 --- a/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs +++ b/src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs @@ -132,12 +132,12 @@ module StandardOperations = let maskOp<'a, 'b when 'a: struct and 'b: struct> = <@ fun (left: 'a option) (right: 'b option) -> - match left, right with - | _, Some _ -> left + match right with + | Some _ -> left | _ -> None @> let complementedMaskOp<'a, 'b when 'a: struct and 'b: struct> = <@ fun (left: 'a option) (right: 'b option) -> - match left, right with - | _, None -> left + match right with + | None -> left | _ -> None @> From 72a6c5a9ae48079f892ff21cbd6e44bafc508538 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 19 Nov 2022 00:16:59 +0300 Subject: [PATCH 74/74] build: pass locally --- tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs | 3 +-- tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs | 3 +-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs index bbea333f..4715fd75 100644 --- a/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs +++ b/tests/GraphBLAS-sharp.Tests/BackendCommonTests/ReduceTests.fs @@ -71,8 +71,7 @@ let tests = let q = Context.defaultContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - let filterFloats = - Array.filter (System.Double.IsNaN >> not) + let filterFloats = Array.filter System.Double.IsNormal [ testFixtures config wgSize q (+) <@ (+) @> 0 id "int add" testFixtures config wgSize q (+) <@ (+) @> 0uy id "byte add" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs index 2a3f7c3a..eafd6d5d 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs @@ -72,8 +72,7 @@ let testFixtures (case: OperationCase) = q.Error.Add(fun e -> failwithf "%A" e) - let filterFloats = - Array.filter (System.Double.IsNaN >> not) + let filterFloats = Array.filter System.Double.IsNormal [ let intReduce = Vector.reduce context wgSize