@@ -5,9 +5,8 @@ open FSharp.Quotations
55open GraphBLAS.FSharp
66open GraphBLAS.FSharp .Objects
77open GraphBLAS.FSharp .Backend .Quotes
8- open GraphBLAS.FSharp .Backend .Vector .Dense
9- open GraphBLAS.FSharp .Objects .ClContextExtensions
108open GraphBLAS.FSharp .Objects .ArraysExtensions
9+ open GraphBLAS.FSharp .Objects .ClContextExtensions
1110open GraphBLAS.FSharp .Objects .ClCellExtensions
1211
1312module internal BFS =
@@ -18,57 +17,54 @@ module internal BFS =
1817 workGroupSize
1918 =
2019
21- let spMVTo =
22- Operations.SpMVInplace add mul clContext workGroupSize
20+ let spMVInPlace =
21+ Operations.SpMVInPlace add mul clContext workGroupSize
2322
2423 let zeroCreate =
25- ClArray .zeroCreate clContext workGroupSize
24+ Vector .zeroCreate clContext workGroupSize
2625
2726 let ofList = Vector.ofList clContext workGroupSize
2827
29- let maskComplementedTo =
28+ let maskComplementedInPlace =
3029 Vector.map2InPlace Mask.complementedOp clContext workGroupSize
3130
3231 let fillSubVectorTo =
33- Vector.assignByMaskInPlace ( Convert.assignToOption Mask.assign) clContext workGroupSize
32+ Vector.assignByMaskInPlace Mask.assign clContext workGroupSize
3433
3534 let containsNonZero =
36- ClArray .exists Predicates.isSome clContext workGroupSize
35+ Vector .exists Predicates.isSome clContext workGroupSize
3736
3837 fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix < 'a >) ( source : int ) ->
3938 let vertexCount = matrix.RowCount
4039
41- let levels = zeroCreate queue HostInterop vertexCount
40+ let levels =
41+ zeroCreate queue DeviceOnly vertexCount Dense
4242
43- let frontier =
43+ let front =
4444 ofList queue DeviceOnly Dense vertexCount [ source, 1 ]
4545
46- match frontier with
47- | ClVector.Dense front ->
48-
49- let mutable level = 0
50- let mutable stop = false
46+ let mutable level = 0
47+ let mutable stop = false
5148
52- while not stop do
53- level <- level + 1
49+ while not stop do
50+ level <- level + 1
5451
55- //Assigning new level values
56- fillSubVectorTo queue levels front ( clContext.CreateClCell level) levels
52+ //Assigning new level values
53+ fillSubVectorTo queue levels front ( clContext.CreateClCell level)
5754
58- //Getting new frontier
59- spMVTo queue matrix frontier frontier
55+ //Getting new frontier
56+ spMVInPlace queue matrix front front
6057
61- maskComplementedTo queue front levels front
58+ maskComplementedInPlace queue front levels
6259
63- //Checking if front is empty
64- stop <-
65- not
66- <| ( containsNonZero queue front) .ToHostAndFree queue
60+ //Checking if front is empty
61+ stop <-
62+ not
63+ <| ( containsNonZero queue front) .ToHostAndFree queue
6764
68- front.Free queue
65+ front.Dispose queue
6966
70- levels
71- | _ -> failwith " Not implemented"
67+ levels
7268
7369 let singleSourceSparse
7470 ( add : Expr < bool option -> bool option -> bool option >)
@@ -78,55 +74,52 @@ module internal BFS =
7874 =
7975
8076 let spMSpV =
81- SpMSpV.run add mul clContext workGroupSize
77+ Operations.SpMSpVBool add mul clContext workGroupSize
8278
8379 let zeroCreate =
84- ClArray .zeroCreate clContext workGroupSize
80+ Vector .zeroCreate clContext workGroupSize
8581
8682 let ofList = Vector.ofList clContext workGroupSize
8783
8884 let maskComplemented =
89- Vector.Sparse.Vector.map2SparseDense Mask.complementedOp clContext workGroupSize
85+ Vector.map2Sparse Mask.complementedOp clContext workGroupSize
9086
9187 let fillSubVectorTo =
92- Vector.assignBySparseMaskInPlace ( Convert.assignToOption Mask.assign) clContext workGroupSize
88+ Vector.assignByMaskInPlace Mask.assign clContext workGroupSize
9389
94- fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix.CSR < bool >) ( source : int ) ->
90+ fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix < bool >) ( source : int ) ->
9591 let vertexCount = matrix.RowCount
9692
97- let levels = zeroCreate queue HostInterop vertexCount
93+ let levels =
94+ zeroCreate queue DeviceOnly vertexCount Dense
9895
99- let mutable frontier =
96+ let mutable front =
10097 ofList queue DeviceOnly Sparse vertexCount [ source, true ]
10198
10299 let mutable level = 0
103100 let mutable stop = false
104101
105102 while not stop do
106- match frontier with
107- | ClVector.Sparse front ->
108- level <- level + 1
109-
110- //Assigning new level values
111- fillSubVectorTo queue levels front ( clContext.CreateClCell level) levels
103+ level <- level + 1
112104
113- //Getting new frontier
114- match spMSpV queue matrix front with
105+ //Assigning new level values
106+ fillSubVectorTo queue levels front ( clContext.CreateClCell level)
107+
108+ //Getting new frontier
109+ match spMSpV queue matrix front with
110+ | None ->
111+ front.Dispose queue
112+ stop <- true
113+ | Some newFrontier ->
114+ front.Dispose queue
115+ //Filtering visited vertices
116+ match maskComplemented queue DeviceOnly newFrontier levels with
115117 | None ->
116- frontier.Dispose queue
117118 stop <- true
118- | Some newFrontier ->
119- frontier.Dispose queue
120- //Filtering visited vertices
121- match maskComplemented queue DeviceOnly newFrontier levels with
122- | None ->
123- stop <- true
124- newFrontier.Dispose queue
125- | Some f ->
126- frontier <- ClVector.Sparse f
127- newFrontier.Dispose queue
128-
129- | _ -> failwith " Not implemented"
119+ newFrontier.Dispose queue
120+ | Some f ->
121+ front <- f
122+ newFrontier.Dispose queue
130123
131124 levels
132125
@@ -138,33 +131,25 @@ module internal BFS =
138131 workGroupSize
139132 =
140133
141- let SPARSITY = 0.001 f
142-
143- let push nnz size =
144- ( float32 nnz) / ( float32 size) <= SPARSITY
145-
146- let spMVTo =
147- SpMV.runTo add mul clContext workGroupSize
134+ let spMVInPlace =
135+ Operations.SpMVInPlace add mul clContext workGroupSize
148136
149137 let spMSpV =
150- SpMSpV.runBoolStandard add mul clContext workGroupSize
138+ Operations.SpMSpVBool add mul clContext workGroupSize
151139
152140 let zeroCreate =
153- ClArray .zeroCreate clContext workGroupSize
141+ Vector .zeroCreate clContext workGroupSize
154142
155143 let ofList = Vector.ofList clContext workGroupSize
156144
157- let maskComplementedTo =
145+ let maskComplementedInPlace =
158146 Vector.map2InPlace Mask.complementedOp clContext workGroupSize
159147
160148 let maskComplemented =
161- Vector.Sparse.Vector.map2SparseDense Mask.complementedOp clContext workGroupSize
162-
163- let fillSubVectorDenseTo =
164- Vector.assignByMaskInPlace ( Convert.assignToOption Mask.assign) clContext workGroupSize
149+ Vector.map2Sparse Mask.complementedOp clContext workGroupSize
165150
166- let fillSubVectorSparseTo =
167- Vector.assignBySparseMaskInPlace ( Convert.assignToOption Mask.assign) clContext workGroupSize
151+ let fillSubVectorInPlace =
152+ Vector.assignByMaskInPlace ( Mask.assign) clContext workGroupSize
168153
169154 let toSparse = Vector.toSparse clContext workGroupSize
170155
@@ -173,10 +158,22 @@ module internal BFS =
173158 let countNNZ =
174159 ClArray.count Predicates.isSome clContext workGroupSize
175160
176- fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix.CSR < bool >) ( source : int ) ->
161+ //Push or pull functions
162+ let getNNZ ( queue : MailboxProcessor < Msg >) ( v : ClVector < bool >) =
163+ match v with
164+ | ClVector.Sparse v -> v.NNZ
165+ | ClVector.Dense v -> countNNZ queue v
166+
167+ let SPARSITY = 0.001 f
168+
169+ let push nnz size =
170+ ( float32 nnz) / ( float32 size) <= SPARSITY
171+
172+ fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix < bool >) ( source : int ) ->
177173 let vertexCount = matrix.RowCount
178174
179- let levels = zeroCreate queue HostInterop vertexCount
175+ let levels =
176+ zeroCreate queue DeviceOnly vertexCount Dense
180177
181178 let mutable frontier =
182179 ofList queue DeviceOnly Sparse vertexCount [ source, true ]
@@ -187,13 +184,13 @@ module internal BFS =
187184 while not stop do
188185 level <- level + 1
189186
190- match frontier with
191- | ClVector.Sparse front ->
192- //Assigning new level values
193- fillSubVectorSparseTo queue levels front ( clContext.CreateClCell level) levels
187+ //Assigning new level values
188+ fillSubVectorInPlace queue levels frontier ( clContext.CreateClCell level)
194189
190+ match frontier with
191+ | ClVector.Sparse _ ->
195192 //Getting new frontier
196- match spMSpV queue matrix front with
193+ match spMSpV queue matrix frontier with
197194 | None ->
198195 frontier.Dispose queue
199196 stop <- true
@@ -204,34 +201,33 @@ module internal BFS =
204201 | None ->
205202 stop <- true
206203 newFrontier.Dispose queue
207- | Some f ->
204+ | Some newMaskedFrontier ->
208205 newFrontier.Dispose queue
209206
210207 //Push/pull
211- if ( push f.NNZ f.Size) then
212- frontier <- ClVector.Sparse f
213- else
214- frontier <- toDense queue DeviceOnly ( ClVector.Sparse f)
215- f.Dispose queue
216- | ClVector.Dense front ->
217- //Assigning new level values
218- fillSubVectorDenseTo queue levels front ( clContext.CreateClCell level) levels
208+ let NNZ = getNNZ queue newMaskedFrontier
219209
210+ if ( push NNZ newMaskedFrontier.Size) then
211+ frontier <- newMaskedFrontier
212+ else
213+ frontier <- toDense queue DeviceOnly newMaskedFrontier
214+ newMaskedFrontier.Dispose queue
215+ | ClVector.Dense oldFrontier ->
220216 //Getting new frontier
221- spMVTo queue matrix front front
217+ spMVInPlace queue matrix frontier frontier
222218
223- maskComplementedTo queue front levels front
219+ maskComplementedInPlace queue frontier levels
224220
225221 //Emptiness check
226- let NNZ = countNNZ queue front
222+ let NNZ = getNNZ queue frontier
227223
228224 stop <- NNZ = 0
229225
230226 //Push/pull
231227 if not stop then
232- if ( push NNZ front.Length ) then
233- frontier <- ClVector.Sparse ( toSparse queue DeviceOnly front )
234- front .Free queue
228+ if ( push NNZ frontier.Size ) then
229+ frontier <- toSparse queue DeviceOnly frontier
230+ oldFrontier .Free queue
235231 else
236232 frontier.Dispose queue
237233
0 commit comments