@@ -5,9 +5,8 @@ open FSharp.Quotations
5
5
open GraphBLAS.FSharp
6
6
open GraphBLAS.FSharp .Objects
7
7
open GraphBLAS.FSharp .Backend .Quotes
8
- open GraphBLAS.FSharp .Backend .Vector .Dense
9
- open GraphBLAS.FSharp .Objects .ClContextExtensions
10
8
open GraphBLAS.FSharp .Objects .ArraysExtensions
9
+ open GraphBLAS.FSharp .Objects .ClContextExtensions
11
10
open GraphBLAS.FSharp .Objects .ClCellExtensions
12
11
13
12
module internal BFS =
@@ -18,57 +17,54 @@ module internal BFS =
18
17
workGroupSize
19
18
=
20
19
21
- let spMVTo =
22
- Operations.SpMVInplace add mul clContext workGroupSize
20
+ let spMVInPlace =
21
+ Operations.SpMVInPlace add mul clContext workGroupSize
23
22
24
23
let zeroCreate =
25
- ClArray .zeroCreate clContext workGroupSize
24
+ Vector .zeroCreate clContext workGroupSize
26
25
27
26
let ofList = Vector.ofList clContext workGroupSize
28
27
29
- let maskComplementedTo =
28
+ let maskComplementedInPlace =
30
29
Vector.map2InPlace Mask.complementedOp clContext workGroupSize
31
30
32
31
let fillSubVectorTo =
33
- Vector.assignByMaskInPlace ( Convert.assignToOption Mask.assign) clContext workGroupSize
32
+ Vector.assignByMaskInPlace Mask.assign clContext workGroupSize
34
33
35
34
let containsNonZero =
36
- ClArray .exists Predicates.isSome clContext workGroupSize
35
+ Vector .exists Predicates.isSome clContext workGroupSize
37
36
38
37
fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix < 'a >) ( source : int ) ->
39
38
let vertexCount = matrix.RowCount
40
39
41
- let levels = zeroCreate queue HostInterop vertexCount
40
+ let levels =
41
+ zeroCreate queue DeviceOnly vertexCount Dense
42
42
43
- let frontier =
43
+ let front =
44
44
ofList queue DeviceOnly Dense vertexCount [ source, 1 ]
45
45
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
51
48
52
- while not stop do
53
- level <- level + 1
49
+ while not stop do
50
+ level <- level + 1
54
51
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)
57
54
58
- //Getting new frontier
59
- spMVTo queue matrix frontier frontier
55
+ //Getting new frontier
56
+ spMVInPlace queue matrix front front
60
57
61
- maskComplementedTo queue front levels front
58
+ maskComplementedInPlace queue front levels
62
59
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
67
64
68
- front.Free queue
65
+ front.Dispose queue
69
66
70
- levels
71
- | _ -> failwith " Not implemented"
67
+ levels
72
68
73
69
let singleSourceSparse
74
70
( add : Expr < bool option -> bool option -> bool option >)
@@ -78,55 +74,52 @@ module internal BFS =
78
74
=
79
75
80
76
let spMSpV =
81
- SpMSpV.run add mul clContext workGroupSize
77
+ Operations.SpMSpVBool add mul clContext workGroupSize
82
78
83
79
let zeroCreate =
84
- ClArray .zeroCreate clContext workGroupSize
80
+ Vector .zeroCreate clContext workGroupSize
85
81
86
82
let ofList = Vector.ofList clContext workGroupSize
87
83
88
84
let maskComplemented =
89
- Vector.Sparse.Vector.map2SparseDense Mask.complementedOp clContext workGroupSize
85
+ Vector.map2Sparse Mask.complementedOp clContext workGroupSize
90
86
91
87
let fillSubVectorTo =
92
- Vector.assignBySparseMaskInPlace ( Convert.assignToOption Mask.assign) clContext workGroupSize
88
+ Vector.assignByMaskInPlace Mask.assign clContext workGroupSize
93
89
94
- fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix.CSR < bool >) ( source : int ) ->
90
+ fun ( queue : MailboxProcessor < Msg >) ( matrix : ClMatrix < bool >) ( source : int ) ->
95
91
let vertexCount = matrix.RowCount
96
92
97
- let levels = zeroCreate queue HostInterop vertexCount
93
+ let levels =
94
+ zeroCreate queue DeviceOnly vertexCount Dense
98
95
99
- let mutable frontier =
96
+ let mutable front =
100
97
ofList queue DeviceOnly Sparse vertexCount [ source, true ]
101
98
102
99
let mutable level = 0
103
100
let mutable stop = false
104
101
105
102
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
112
104
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
115
117
| None ->
116
- frontier.Dispose queue
117
118
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
130
123
131
124
levels
132
125
@@ -138,33 +131,25 @@ module internal BFS =
138
131
workGroupSize
139
132
=
140
133
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
148
136
149
137
let spMSpV =
150
- SpMSpV.runBoolStandard add mul clContext workGroupSize
138
+ Operations.SpMSpVBool add mul clContext workGroupSize
151
139
152
140
let zeroCreate =
153
- ClArray .zeroCreate clContext workGroupSize
141
+ Vector .zeroCreate clContext workGroupSize
154
142
155
143
let ofList = Vector.ofList clContext workGroupSize
156
144
157
- let maskComplementedTo =
145
+ let maskComplementedInPlace =
158
146
Vector.map2InPlace Mask.complementedOp clContext workGroupSize
159
147
160
148
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
165
150
166
- let fillSubVectorSparseTo =
167
- Vector.assignBySparseMaskInPlace ( Convert.assignToOption Mask.assign) clContext workGroupSize
151
+ let fillSubVectorInPlace =
152
+ Vector.assignByMaskInPlace ( Mask.assign) clContext workGroupSize
168
153
169
154
let toSparse = Vector.toSparse clContext workGroupSize
170
155
@@ -173,10 +158,22 @@ module internal BFS =
173
158
let countNNZ =
174
159
ClArray.count Predicates.isSome clContext workGroupSize
175
160
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 ) ->
177
173
let vertexCount = matrix.RowCount
178
174
179
- let levels = zeroCreate queue HostInterop vertexCount
175
+ let levels =
176
+ zeroCreate queue DeviceOnly vertexCount Dense
180
177
181
178
let mutable frontier =
182
179
ofList queue DeviceOnly Sparse vertexCount [ source, true ]
@@ -187,13 +184,13 @@ module internal BFS =
187
184
while not stop do
188
185
level <- level + 1
189
186
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)
194
189
190
+ match frontier with
191
+ | ClVector.Sparse _ ->
195
192
//Getting new frontier
196
- match spMSpV queue matrix front with
193
+ match spMSpV queue matrix frontier with
197
194
| None ->
198
195
frontier.Dispose queue
199
196
stop <- true
@@ -204,34 +201,33 @@ module internal BFS =
204
201
| None ->
205
202
stop <- true
206
203
newFrontier.Dispose queue
207
- | Some f ->
204
+ | Some newMaskedFrontier ->
208
205
newFrontier.Dispose queue
209
206
210
207
//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
219
209
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 ->
220
216
//Getting new frontier
221
- spMVTo queue matrix front front
217
+ spMVInPlace queue matrix frontier frontier
222
218
223
- maskComplementedTo queue front levels front
219
+ maskComplementedInPlace queue frontier levels
224
220
225
221
//Emptiness check
226
- let NNZ = countNNZ queue front
222
+ let NNZ = getNNZ queue frontier
227
223
228
224
stop <- NNZ = 0
229
225
230
226
//Push/pull
231
227
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
235
231
else
236
232
frontier.Dispose queue
237
233
0 commit comments