Skip to content

Commit d6b9fb5

Browse files
committed
BFS Push-pull and push
1 parent d3bc08c commit d6b9fb5

6 files changed

Lines changed: 387 additions & 5 deletions

File tree

src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs

Lines changed: 167 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,3 +71,170 @@ module BFS =
7171

7272
levels
7373
| _ -> failwith "Not implemented"
74+
75+
let singleSourceSparse
76+
(add: Expr<bool option -> bool option -> bool option>)
77+
(mul: Expr<bool option -> bool option -> bool option>)
78+
(clContext: ClContext)
79+
workGroupSize
80+
=
81+
82+
let spMSpV =
83+
SpMSpV.run add mul clContext workGroupSize
84+
85+
let zeroCreate =
86+
ClArray.zeroCreate clContext workGroupSize
87+
88+
let ofList = Vector.ofList clContext workGroupSize
89+
90+
let maskComplemented =
91+
Vector.Sparse.Vector.map2SparseDense Mask.complementedOp clContext workGroupSize
92+
93+
let fillSubVectorTo =
94+
Vector.assignBySparseMaskInPlace (Convert.assignToOption Mask.assign) clContext workGroupSize
95+
96+
fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix.CSR<bool>) (source: int) ->
97+
let vertexCount = matrix.RowCount
98+
99+
let levels = zeroCreate queue HostInterop vertexCount
100+
101+
let mutable frontier =
102+
ofList queue DeviceOnly Sparse vertexCount [ source, true ]
103+
104+
let mutable level = 0
105+
let mutable stop = false
106+
107+
while not stop do
108+
match frontier with
109+
| ClVector.Sparse front ->
110+
level <- level + 1
111+
112+
//Assigning new level values
113+
fillSubVectorTo queue levels front (clContext.CreateClCell level) levels
114+
115+
//Getting new frontier
116+
match spMSpV queue matrix front with
117+
| None ->
118+
frontier.Dispose queue
119+
stop <- true
120+
| Some newFrontier ->
121+
frontier.Dispose queue
122+
//Filtering visited vertices
123+
match maskComplemented queue DeviceOnly newFrontier levels with
124+
| None ->
125+
stop <- true
126+
newFrontier.Dispose queue
127+
| Some f ->
128+
frontier <- ClVector.Sparse f
129+
newFrontier.Dispose queue
130+
131+
| _ -> failwith "Not implemented"
132+
133+
levels
134+
135+
136+
let singleSourcePushPull
137+
(add: Expr<bool option -> bool option -> bool option>)
138+
(mul: Expr<bool option -> bool option -> bool option>)
139+
(clContext: ClContext)
140+
workGroupSize
141+
=
142+
143+
let SPARSITY = 0.001f
144+
145+
let push nnz size =
146+
(float32 nnz) / (float32 size) <= SPARSITY
147+
148+
let spMVTo =
149+
SpMV.runTo add mul clContext workGroupSize
150+
151+
let spMSpV =
152+
SpMSpV.runBoolStandard add mul clContext workGroupSize
153+
154+
let zeroCreate =
155+
ClArray.zeroCreate clContext workGroupSize
156+
157+
let ofList = Vector.ofList clContext workGroupSize
158+
159+
let maskComplementedTo =
160+
Vector.map2InPlace Mask.complementedOp clContext workGroupSize
161+
162+
let maskComplemented =
163+
Vector.Sparse.Vector.map2SparseDense Mask.complementedOp clContext workGroupSize
164+
165+
let fillSubVectorDenseTo =
166+
Vector.assignByMaskInPlace (Convert.assignToOption Mask.assign) clContext workGroupSize
167+
168+
let fillSubVectorSparseTo =
169+
Vector.assignBySparseMaskInPlace (Convert.assignToOption Mask.assign) clContext workGroupSize
170+
171+
let toSparse = Vector.toSparse clContext workGroupSize
172+
173+
let toDense = Vector.toDense clContext workGroupSize
174+
175+
let countNNZ =
176+
ClArray.count Predicates.isSome clContext workGroupSize
177+
178+
fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix.CSR<bool>) (source: int) ->
179+
let vertexCount = matrix.RowCount
180+
181+
let levels = zeroCreate queue HostInterop vertexCount
182+
183+
let mutable frontier =
184+
ofList queue DeviceOnly Sparse vertexCount [ source, true ]
185+
186+
let mutable level = 0
187+
let mutable stop = false
188+
189+
while not stop do
190+
level <- level + 1
191+
192+
match frontier with
193+
| ClVector.Sparse front ->
194+
//Assigning new level values
195+
fillSubVectorSparseTo queue levels front (clContext.CreateClCell level) levels
196+
197+
//Getting new frontier
198+
match spMSpV queue matrix front with
199+
| None ->
200+
frontier.Dispose queue
201+
stop <- true
202+
| Some newFrontier ->
203+
frontier.Dispose queue
204+
//Filtering visited vertices
205+
match maskComplemented queue DeviceOnly newFrontier levels with
206+
| None ->
207+
stop <- true
208+
newFrontier.Dispose queue
209+
| Some f ->
210+
newFrontier.Dispose queue
211+
212+
//Push/pull
213+
if (push f.NNZ f.Size) then
214+
frontier <- ClVector.Sparse f
215+
else
216+
frontier <- toDense queue DeviceOnly (ClVector.Sparse f)
217+
f.Dispose queue
218+
| ClVector.Dense front ->
219+
//Assigning new level values
220+
fillSubVectorDenseTo queue levels front (clContext.CreateClCell level) levels
221+
222+
//Getting new frontier
223+
spMVTo queue matrix front front
224+
225+
maskComplementedTo queue front levels front
226+
227+
//Emptiness check
228+
let NNZ = countNNZ queue front
229+
230+
stop <- NNZ = 0
231+
232+
//Push/pull
233+
if not stop then
234+
if (push NNZ front.Length) then
235+
frontier <- ClVector.Sparse(toSparse queue DeviceOnly front)
236+
front.Free queue
237+
else
238+
frontier.Dispose queue
239+
240+
levels

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

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -904,3 +904,44 @@ module ClArray =
904904

905905
processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange index array value))
906906
processor.Post(Msg.CreateRunMsg<_, _> kernel)
907+
908+
let count (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize =
909+
910+
let sum =
911+
PrefixSum.standardExcludeInPlace clContext workGroupSize
912+
913+
let getBitmap =
914+
<@ fun (ndRange: Range1D) length (vector: ClArray<'a>) (bitmap: ClArray<int>) ->
915+
916+
let gid = ndRange.GlobalID0
917+
918+
if gid < length then
919+
let isTrue = (%predicate) vector.[gid]
920+
921+
if isTrue then
922+
bitmap.[gid] <- 1
923+
else
924+
bitmap.[gid] <- 0 @>
925+
926+
let kernel = clContext.Compile getBitmap
927+
928+
fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) ->
929+
930+
let bitmap =
931+
clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array.Length)
932+
933+
let ndRange =
934+
Range1D.CreateValid(array.Length, workGroupSize)
935+
936+
let kernel = kernel.GetKernel()
937+
938+
processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange array.Length array bitmap))
939+
940+
processor.Post(Msg.CreateRunMsg<_, _>(kernel))
941+
942+
let result =
943+
(sum processor bitmap).ToHostAndFree processor
944+
945+
processor.Post(Msg.CreateFreeMsg bitmap)
946+
947+
result

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

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -87,6 +87,45 @@ module Vector =
8787

8888
resultVector
8989

90+
let assignBySparseMaskInPlace<'a, 'b when 'a: struct and 'b: struct>
91+
(maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>)
92+
(clContext: ClContext)
93+
workGroupSize
94+
=
95+
96+
let fillSubVectorKernel =
97+
<@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (maskVectorIndices: ClArray<int>) (maskVectorValues: ClArray<'b>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) ->
98+
99+
let gid = ndRange.GlobalID0
100+
101+
if gid < resultLength then
102+
let i = maskVectorIndices.[gid]
103+
resultVector.[i] <- (%maskOp) leftVector.[i] (Some maskVectorValues.[gid]) value.Value @>
104+
105+
let kernel = clContext.Compile(fillSubVectorKernel)
106+
107+
fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: Sparse<'b>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) ->
108+
109+
let ndRange =
110+
Range1D.CreateValid(maskVector.NNZ, workGroupSize)
111+
112+
let kernel = kernel.GetKernel()
113+
114+
processor.Post(
115+
Msg.MsgSetArguments
116+
(fun () ->
117+
kernel.KernelFunc
118+
ndRange
119+
maskVector.NNZ
120+
leftVector
121+
maskVector.Indices
122+
maskVector.Values
123+
value
124+
resultVector)
125+
)
126+
127+
processor.Post(Msg.CreateRunMsg<_, _>(kernel))
128+
90129
let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize =
91130

92131
let scatterValues =

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

Lines changed: 96 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -103,6 +103,102 @@ module internal Map2 =
103103
Indices = resultIndices
104104
Size = max leftVector.Size rightVector.Size }
105105

106+
let private preparePositionsSparseDense<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd =
107+
108+
let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) =
109+
<@ fun (ndRange: Range1D) length (leftValues: ClArray<'a>) (leftIndices: ClArray<int>) (rightValues: ClArray<'b option>) (resultBitmap: ClArray<int>) (resultValues: ClArray<'c>) (resultIndices: ClArray<int>) ->
110+
111+
let gid = ndRange.GlobalID0
112+
113+
if gid < length then
114+
115+
let i = leftIndices.[gid]
116+
117+
let (leftValue: 'a option) = Some leftValues.[gid]
118+
119+
let (rightValue: 'b option) = rightValues.[i]
120+
121+
match (%op) leftValue rightValue with
122+
| Some value ->
123+
resultValues.[gid] <- value
124+
resultIndices.[gid] <- i
125+
126+
resultBitmap.[gid] <- 1
127+
| None -> resultBitmap.[gid] <- 0 @>
128+
129+
let kernel =
130+
clContext.Compile <| preparePositions opAdd
131+
132+
fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray<int>) (rightValues: ClArray<'b option>) ->
133+
134+
let resultBitmap =
135+
clContext.CreateClArrayWithSpecificAllocationMode<int>(DeviceOnly, vectorLenght)
136+
137+
let resultIndices =
138+
clContext.CreateClArrayWithSpecificAllocationMode<int>(DeviceOnly, vectorLenght)
139+
140+
let resultValues =
141+
clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vectorLenght)
142+
143+
let ndRange =
144+
Range1D.CreateValid(vectorLenght, workGroupSize)
145+
146+
let kernel = kernel.GetKernel()
147+
148+
processor.Post(
149+
Msg.MsgSetArguments
150+
(fun () ->
151+
kernel.KernelFunc
152+
ndRange
153+
vectorLenght
154+
leftValues
155+
leftIndices
156+
rightValues
157+
resultBitmap
158+
resultValues
159+
resultIndices)
160+
)
161+
162+
processor.Post(Msg.CreateRunMsg<_, _> kernel)
163+
164+
resultBitmap, resultValues, resultIndices
165+
166+
let runSparseDense<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct>
167+
op
168+
(clContext: ClContext)
169+
workGroupSize
170+
=
171+
172+
let prepare =
173+
preparePositionsSparseDense<'a, 'b, 'c> clContext workGroupSize op
174+
175+
let setPositions =
176+
Common.setPositionsOption clContext workGroupSize
177+
178+
fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClArray<'b option>) ->
179+
180+
let bitmap, allValues, allIndices =
181+
prepare processor leftVector.NNZ leftVector.Values leftVector.Indices rightVector
182+
183+
match setPositions processor allocationMode allValues allIndices bitmap with
184+
| Some (resultValues, resultIndices) ->
185+
186+
processor.Post(Msg.CreateFreeMsg<_>(allIndices))
187+
processor.Post(Msg.CreateFreeMsg<_>(allValues))
188+
processor.Post(Msg.CreateFreeMsg<_>(bitmap))
189+
190+
Some(
191+
{ Context = clContext
192+
Values = resultValues
193+
Indices = resultIndices
194+
Size = leftVector.Size }
195+
)
196+
| None ->
197+
processor.Post(Msg.CreateFreeMsg<_>(allIndices))
198+
processor.Post(Msg.CreateFreeMsg<_>(allValues))
199+
processor.Post(Msg.CreateFreeMsg<_>(bitmap))
200+
None
201+
106202
let private preparePositionsAssignByMask<'a, 'b when 'a: struct and 'b: struct>
107203
op
108204
(clContext: ClContext)

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,8 @@ module Vector =
2525

2626
let map2 = Map2.run
2727

28+
let map2SparseDense = Map2.runSparseDense
29+
2830
let map2AtLeastOne opAdd (clContext: ClContext) workGroupSize allocationMode =
2931
Map2.AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize allocationMode
3032

0 commit comments

Comments
 (0)