Skip to content

Commit 2a40ca3

Browse files
committed
add: vector.mapWithValue
1 parent 2907167 commit 2a40ca3

File tree

5 files changed

+202
-4
lines changed

5 files changed

+202
-4
lines changed

src/GraphBLAS-sharp.Backend/Common/ClArray.fs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -172,18 +172,20 @@ module ClArray =
172172

173173
let kernel = clContext.Compile map
174174

175-
fun (processor: MailboxProcessor<_>) allocationMode (value: ClCell<'a>) (inputArray: ClArray<'b>) ->
175+
fun (processor: MailboxProcessor<_>) allocationMode (value: 'a) (inputArray: ClArray<'b>) ->
176176

177177
let result =
178178
clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length)
179179

180+
let valueClCell = value |> clContext.CreateClCell
181+
180182
let ndRange =
181183
Range1D.CreateValid(inputArray.Length, workGroupSize)
182184

183185
let kernel = kernel.GetKernel()
184186

185187
processor.Post(
186-
Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length value inputArray result)
188+
Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length valueClCell inputArray result)
187189
)
188190

189191
processor.Post(Msg.CreateRunMsg<_, _>(kernel))

src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@
4343
<Compile Include="Vector/Sparse/Common.fs" />
4444
<Compile Include="Vector/Sparse/Merge.fs" />
4545
<Compile Include="Vector/Sparse/Map2.fs" />
46+
<Compile Include="Vector/Sparse/Map.fs" />
4647
<Compile Include="Vector/Sparse/Vector.fs" />
4748
<Compile Include="Vector/SpMV.fs" />
4849
<Compile Include="Vector/Vector.fs" />

src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ namespace GraphBLAS.FSharp.Backend.Vector.Sparse
22

33
open Brahma.FSharp
44
open GraphBLAS.FSharp.Backend.Common
5+
open GraphBLAS.FSharp.Backend.Objects.ClVector
56
open Microsoft.FSharp.Control
67
open GraphBLAS.FSharp.Backend.Objects.ClContext
78
open GraphBLAS.FSharp.Backend.Objects.ClCell
@@ -34,3 +35,65 @@ module internal Common =
3435
indicesScatter processor positions allIndices resultIndices
3536

3637
resultValues, resultIndices
38+
39+
let setPositionsOption<'a when 'a: struct> (clContext: ClContext) workGroupSize =
40+
41+
let sum =
42+
PrefixSum.standardExcludeInPlace clContext workGroupSize
43+
44+
let valuesScatter =
45+
Scatter.lastOccurrence clContext workGroupSize
46+
47+
let indicesScatter =
48+
Scatter.lastOccurrence clContext workGroupSize
49+
50+
fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray<int>) (positions: ClArray<int>) ->
51+
52+
let resultLength =
53+
(sum processor positions).ToHostAndFree(processor)
54+
55+
if resultLength = 0 then
56+
None
57+
else
58+
let resultValues =
59+
clContext.CreateClArrayWithSpecificAllocationMode<'a>(allocationMode, resultLength)
60+
61+
let resultIndices =
62+
clContext.CreateClArrayWithSpecificAllocationMode<int>(allocationMode, resultLength)
63+
64+
valuesScatter processor positions allValues resultValues
65+
66+
indicesScatter processor positions allIndices resultIndices
67+
68+
(resultValues, resultIndices) |> Some
69+
70+
let concat (clContext: ClContext) workGroupSize =
71+
72+
let concatValues = ClArray.concat clContext workGroupSize
73+
74+
let concatIndices = ClArray.concat clContext workGroupSize
75+
76+
let mapIndices =
77+
ClArray.mapWithValue clContext workGroupSize <@ fun x y -> x + y @>
78+
79+
fun (processor: MailboxProcessor<_>) allocationMode (vectors: Sparse<'a> seq) ->
80+
81+
let vectorIndices, _ =
82+
(0, vectors)
83+
||> Seq.mapFold
84+
(fun offset vector ->
85+
let newIndices =
86+
mapIndices processor allocationMode offset vector.Indices
87+
88+
newIndices, offset + vector.Size)
89+
90+
let vectorValues =
91+
vectors |> Seq.map (fun vector -> vector.Values)
92+
93+
let resultIndices =
94+
concatIndices processor allocationMode vectorIndices
95+
96+
let resultValues =
97+
concatValues processor allocationMode vectorValues
98+
99+
resultIndices, resultValues
Lines changed: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
1+
namespace GraphBLAS.FSharp.Backend.Vector.Sparse
2+
3+
open FSharp.Quotations.Evaluator
4+
open Microsoft.FSharp.Quotations
5+
open Brahma.FSharp
6+
open GraphBLAS.FSharp.Backend
7+
open GraphBLAS.FSharp.Backend.Quotes
8+
open GraphBLAS.FSharp.Backend.Vector.Sparse
9+
open GraphBLAS.FSharp.Backend.Objects.ClVector
10+
open GraphBLAS.FSharp.Backend.Common.ClArray
11+
open GraphBLAS.FSharp.Backend.Objects.ClCell
12+
open GraphBLAS.FSharp.Backend.Objects.ClContext
13+
14+
module Map =
15+
module WithValueOption =
16+
let preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize =
17+
18+
let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) =
19+
<@ fun (ndRange: Range1D) (operand: ClCell<'a option>) size valuesLength (indices: ClArray<int>) (values: ClArray<'b>) (resultIndices: ClArray<int>) (resultValues: ClArray<'c>) (resultBitmap: ClArray<int>) ->
20+
21+
let gid = ndRange.GlobalID0
22+
23+
if gid < size then
24+
25+
let value =
26+
(%Search.Bin.byKey) valuesLength gid indices values
27+
28+
match (%op) operand.Value value with
29+
| Some resultValue ->
30+
resultValues.[gid] <- resultValue
31+
resultIndices.[gid] <- gid
32+
resultBitmap.[gid] <- 1
33+
| None -> resultBitmap.[gid] <- 0 @>
34+
35+
let kernel =
36+
clContext.Compile <| preparePositions opAdd
37+
38+
fun (processor: MailboxProcessor<_>) (value: ClCell<'a option>) (vector: Sparse<'b>) ->
39+
40+
let resultBitmap =
41+
clContext.CreateClArrayWithSpecificAllocationMode<int>(DeviceOnly, vector.Size)
42+
43+
let resultIndices =
44+
clContext.CreateClArrayWithSpecificAllocationMode<int>(DeviceOnly, vector.Size)
45+
46+
let resultValues =
47+
clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vector.Size)
48+
49+
let ndRange =
50+
Range1D.CreateValid(vector.Size, workGroupSize)
51+
52+
let kernel = kernel.GetKernel()
53+
54+
processor.Post(
55+
Msg.MsgSetArguments
56+
(fun () ->
57+
kernel.KernelFunc
58+
ndRange
59+
value
60+
vector.Size
61+
vector.Values.Length
62+
vector.Indices
63+
vector.Values
64+
resultIndices
65+
resultValues
66+
resultBitmap)
67+
)
68+
69+
processor.Post(Msg.CreateRunMsg<_, _> kernel)
70+
71+
resultIndices, resultValues, resultBitmap
72+
73+
let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct>
74+
(clContext: ClContext)
75+
workGroupSize
76+
(op: Expr<'a option -> 'b option -> 'c option>)
77+
=
78+
79+
let map =
80+
preparePositions op clContext workGroupSize
81+
82+
let opOnHost = op |> QuotationEvaluator.Evaluate
83+
84+
let setPositions =
85+
Common.setPositionsOption<'c> clContext workGroupSize
86+
87+
let create = create clContext workGroupSize
88+
89+
let init =
90+
init <@ fun x -> x @> clContext workGroupSize
91+
92+
fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) size ->
93+
function
94+
| Some vector ->
95+
let valueClCell = clContext.CreateClCell value
96+
97+
let indices, values, bitmap = map queue valueClCell vector
98+
99+
valueClCell.Free queue
100+
101+
let result =
102+
setPositions queue allocationMode values indices bitmap
103+
104+
queue.Post(Msg.CreateFreeMsg<_>(indices))
105+
queue.Post(Msg.CreateFreeMsg<_>(values))
106+
queue.Post(Msg.CreateFreeMsg<_>(bitmap))
107+
108+
result
109+
|> Option.bind
110+
(fun (resultValues, resultIndices) ->
111+
{ Context = clContext
112+
Size = size
113+
Indices = resultIndices
114+
Values = resultValues }
115+
|> Some)
116+
| None ->
117+
opOnHost value None
118+
|> Option.bind
119+
(fun resultValue ->
120+
let resultValues =
121+
create queue allocationMode size resultValue
122+
123+
let resultIndices = init queue allocationMode size
124+
125+
{ Context = clContext
126+
Size = size
127+
Indices = resultIndices
128+
Values = resultValues }
129+
|> Some)

src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,13 @@
11
namespace GraphBLAS.FSharp.Backend.Vector.Sparse
22

33
open Brahma.FSharp
4-
open GraphBLAS.FSharp.Backend.Common
5-
open GraphBLAS.FSharp.Backend.Quotes
64
open Microsoft.FSharp.Control
75
open Microsoft.FSharp.Quotations
6+
open GraphBLAS.FSharp.Backend.Common
7+
open GraphBLAS.FSharp.Backend.Quotes
88
open GraphBLAS.FSharp.Backend.Objects
99
open GraphBLAS.FSharp.Backend.Objects.ClVector
10+
open GraphBLAS.FSharp.Backend.Vector.Sparse
1011

1112
module Vector =
1213
let copy (clContext: ClContext) workGroupSize =
@@ -20,6 +21,8 @@ module Vector =
2021
Values = copyData processor allocationMode vector.Values
2122
Size = vector.Size }
2223

24+
let mapWithValue = Map.WithValueOption.run
25+
2326
let map2 = Map2.run
2427

2528
let map2AtLeastOne opAdd (clContext: ClContext) workGroupSize allocationMode =

0 commit comments

Comments
 (0)