Skip to content

Commit 7fa89ce

Browse files
artemglartemgl
committed
Added first version
1 parent 6ce57a6 commit 7fa89ce

2 files changed

Lines changed: 296 additions & 1 deletion

File tree

‎src/GraphBLAS-sharp/Abstracts.fs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,7 @@ and [<AbstractClass>] Vector<'a when 'a : struct and 'a : equality>(size: int) =
5656
abstract GetNNZ: unit -> OpenCLEvaluation<int>
5757
abstract GetTuples: unit -> OpenCLEvaluation<{| Indices: int[]; Values: 'a[] |}>
5858
abstract GetMask: ?isComplemented: bool -> OpenCLEvaluation<Mask1D option>
59+
abstract ToHost: unit -> OpenCLEvaluation<Vector<'a>>
5960

6061
abstract Extract: Mask1D option -> OpenCLEvaluation<Vector<'a>>
6162
abstract Extract: int -> OpenCLEvaluation<Scalar<'a>>

‎src/GraphBLAS-sharp/Implementations.fs‎

Lines changed: 295 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -118,6 +118,11 @@ type CSRMatrix<'a when 'a : struct and 'a : equality>(csrTuples: CSRFormat<'a>)
118118
and SparseVector<'a when 'a : struct and 'a : equality>(size: int, indices: int[], values: 'a[]) =
119119
inherit Vector<'a>(size)
120120

121+
let mutable indices, values = indices, values
122+
member this.Values with get() = values
123+
member this.Indices with get() = indices
124+
member this.Elements with get() = (indices, values) ||> Array.zip
125+
121126
override this.Clear () = failwith "Not Implemented"
122127
override this.Copy () = failwith "Not Implemented"
123128
override this.Resize a = failwith "Not Implemented"
@@ -127,14 +132,302 @@ and SparseVector<'a when 'a : struct and 'a : equality>(size: int, indices: int[
127132
let isComplemented = defaultArg isComplemented false
128133
failwith "Not Implemented"
129134

135+
override this.ToHost () =
136+
opencl {
137+
let! _ = ToHost this.Indices
138+
let! _ = ToHost this.Values
139+
140+
return upcast this
141+
}
142+
130143
override this.Extract (mask: Mask1D option) : OpenCLEvaluation<Vector<'a>> = failwith "Not Implemented"
131144
override this.Extract (idx: int) : OpenCLEvaluation<Scalar<'a>> = failwith "Not Implemented"
132145
override this.Assign (mask: Mask1D option, vector: Vector<'a>) : OpenCLEvaluation<unit> = failwith "Not Implemented"
133146
override this.Assign (idx: int, Scalar (value: 'a)) : OpenCLEvaluation<unit> = failwith "Not Implemented"
134147
override this.Assign (mask: Mask1D option, Scalar (value: 'a)) : OpenCLEvaluation<unit> = failwith "Not Implemented"
135148

136149
override this.Vxm (matrix: Matrix<'a>) (mask: Mask1D option) (semiring: Semiring<'a>) : OpenCLEvaluation<Vector<'a>> = failwith "Not Implemented"
137-
override this.EWiseAdd a b c = failwith "Not Implemented"
150+
151+
member internal this.CalcPrefixSum
152+
(inputArray: int[]) =
153+
154+
let outputArray = Array.copy inputArray
155+
156+
if inputArray.Length = 1
157+
then
158+
let fillOutputArray =
159+
<@
160+
fun (ndRange: _1D)
161+
(inputArrayBuffer: int[])
162+
(outputArrayBuffer: int[]) ->
163+
164+
let i = ndRange.GlobalID0
165+
outputArrayBuffer.[i] <- inputArrayBuffer.[i]
166+
@>
167+
168+
opencl {
169+
let binder kernelP =
170+
let ndRange = _1D(outputArray.Length)
171+
kernelP
172+
ndRange
173+
inputArray
174+
outputArray
175+
do! RunCommand fillOutputArray binder
176+
return outputArray
177+
}
178+
else
179+
let intermediateArray = Array.zeroCreate ((inputArray.Length + 1) / 2)
180+
181+
let fillIntermediateArray =
182+
<@
183+
fun (ndRange: _1D)
184+
(inputArrayBuffer: int[])
185+
(intermediateArrayBuffer: int[]) ->
186+
187+
let i = ndRange.GlobalID0
188+
if 2 * i + 1 < inputArrayBuffer.Length
189+
then intermediateArrayBuffer.[i] <- inputArrayBuffer.[2 * i] + inputArrayBuffer.[2 * i + 1]
190+
else intermediateArrayBuffer.[i] <- inputArrayBuffer.[2 * i]
191+
@>
192+
193+
let fillIntermediateArray =
194+
opencl {
195+
let binder kernelP =
196+
let ndRange = _1D(intermediateArray.Length)
197+
kernelP
198+
ndRange
199+
inputArray
200+
intermediateArray
201+
do! RunCommand fillIntermediateArray binder
202+
}
203+
204+
let fillOutputArray =
205+
<@
206+
fun (ndRange: _1D)
207+
(auxiliaryPrefixSumArrayBuffer: int[])
208+
(inputArrayBuffer: int[])
209+
(outputArrayBuffer: int[]) ->
210+
211+
let i = ndRange.GlobalID0 + 1
212+
let j = (i - 1) / 2
213+
if i % 2 = 0
214+
then outputArrayBuffer.[i] <- auxiliaryPrefixSumArrayBuffer.[j] + inputArrayBuffer.[i]
215+
else outputArrayBuffer.[i] <- auxiliaryPrefixSumArrayBuffer.[j]
216+
@>
217+
218+
opencl {
219+
do! fillIntermediateArray
220+
let! auxiliaryPrefixSumArray = this.CalcPrefixSum intermediateArray
221+
222+
let binder kernelP =
223+
let ndRange = _1D(inputArray.Length - 1)
224+
kernelP
225+
ndRange
226+
auxiliaryPrefixSumArray
227+
inputArray
228+
outputArray
229+
do! RunCommand fillOutputArray binder
230+
231+
return outputArray
232+
}
233+
234+
member internal this.EWiseAddSparse
235+
(vector: SparseVector<'a>)
236+
(mask: Mask1D option)
237+
(semiring: Semiring<'a>) : OpenCLEvaluation<Vector<'a>> =
238+
239+
let (BinaryOp append) = semiring.PlusMonoid.Append
240+
let zero = semiring.PlusMonoid.Zero
241+
242+
//It is useful to consider that the first array is longer than the second one
243+
let firstIndices, firstValues, secondIndices, secondValues, plus =
244+
if this.Indices.Length > vector.Indices.Length
245+
then this.Indices, this.Values, vector.Indices, vector.Values, append
246+
else vector.Indices, vector.Values, this.Indices, this.Values, <@ fun x y -> (%append) y x @>
247+
248+
let longSide = firstIndices.Length
249+
let shortSide = secondIndices.Length
250+
251+
let filterThroughMask =
252+
opencl {
253+
//TODO
254+
()
255+
}
256+
257+
let allIndices = Array.zeroCreate <| firstIndices.Length + secondIndices.Length
258+
let allValues = Array.init (firstIndices.Length + secondIndices.Length) (fun _ -> zero)
259+
260+
let createSortedConcatenation =
261+
<@
262+
fun (ndRange: _1D)
263+
(firstIndicesBuffer: int[])
264+
(firstValuesBuffer: 'a[])
265+
(secondIndicesBuffer: int[])
266+
(secondValuesBuffer: 'a[])
267+
(allIndicesBuffer: int[])
268+
(allValuesBuffer: 'a[]) ->
269+
270+
let i = ndRange.GlobalID0
271+
272+
let mutable leftEdge = max 0 (i + 1 - shortSide)
273+
let mutable rightEdge = min i (longSide - 1)
274+
275+
while leftEdge <= rightEdge do
276+
let middleIdx = (leftEdge + rightEdge) / 2
277+
if firstIndicesBuffer.[middleIdx] < secondIndicesBuffer.[i - middleIdx]
278+
then leftEdge <- middleIdx + 1
279+
else rightEdge <- middleIdx - 1
280+
281+
let boundaryX, boundaryY = rightEdge, i - leftEdge
282+
283+
if boundaryX < 0 || boundaryY >= 0 && firstIndicesBuffer.[boundaryX] < secondIndicesBuffer.[boundaryY]
284+
then
285+
allIndicesBuffer.[i] <- secondIndicesBuffer.[boundaryY]
286+
allValuesBuffer.[i] <- secondValuesBuffer.[boundaryY]
287+
else
288+
allIndicesBuffer.[i] <- firstIndicesBuffer.[boundaryX]
289+
allValuesBuffer.[i] <- firstValuesBuffer.[boundaryX]
290+
@>
291+
292+
let createSortedConcatenation =
293+
opencl {
294+
let binder kernelP =
295+
let ndRange = _1D(allIndices.Length)
296+
kernelP
297+
ndRange
298+
firstIndices
299+
firstValues
300+
secondIndices
301+
secondValues
302+
allIndices
303+
allValues
304+
do! RunCommand createSortedConcatenation binder
305+
}
306+
307+
let auxiliaryArray = Array.zeroCreate allIndices.Length
308+
309+
let fillAuxiliaryArray =
310+
<@
311+
fun (ndRange: _1D)
312+
(allIndicesBuffer: int[])
313+
(allValuesBuffer: 'a[])
314+
(auxiliaryArrayBuffer: int[]) ->
315+
316+
let i = ndRange.GlobalID0
317+
318+
if allIndicesBuffer.[i] = allIndicesBuffer.[i + 1]
319+
then
320+
auxiliaryArrayBuffer.[i + 1] <- 0
321+
//Prepare to drop explicit zeroes
322+
allValuesBuffer.[i] <- (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1]
323+
else auxiliaryArrayBuffer.[i + 1] <- 1
324+
@>
325+
326+
let fillAuxiliaryArray =
327+
opencl {
328+
let binder kernelP =
329+
let ndRange = _1D(allIndices.Length - 1)
330+
kernelP
331+
ndRange
332+
allIndices
333+
allValues
334+
auxiliaryArray
335+
do! RunCommand fillAuxiliaryArray binder
336+
}
337+
338+
let dropExplicitZeroes =
339+
<@
340+
fun (ndRange: _1D)
341+
(allValuesBuffer: 'a[])
342+
(auxiliaryArrayBuffer: int[]) ->
343+
344+
let i = ndRange.GlobalID0
345+
346+
if allValuesBuffer.[i] = zero
347+
then auxiliaryArrayBuffer.[i] <- 0
348+
@>
349+
350+
let dropExplicitZeroes =
351+
opencl {
352+
let binder kernelP =
353+
let ndRange = _1D(allIndices.Length)
354+
kernelP
355+
ndRange
356+
allValues
357+
auxiliaryArray
358+
do! RunCommand dropExplicitZeroes binder
359+
}
360+
361+
let createUnion =
362+
<@
363+
fun (ndRange: _1D)
364+
(allIndicesBuffer: int[])
365+
(allValuesBuffer: 'a[])
366+
(auxiliaryArrayBuffer: int[])
367+
(prefixSumArrayBuffer: int[])
368+
(resultIndicesBuffer: int[])
369+
(resultValuesBuffer: 'a[]) ->
370+
371+
let i = ndRange.GlobalID0
372+
373+
if auxiliaryArrayBuffer.[i] = 1
374+
then
375+
let index = prefixSumArrayBuffer.[i]
376+
377+
resultIndicesBuffer.[index] <- allIndicesBuffer.[i]
378+
resultValuesBuffer.[index] <- allValuesBuffer.[i]
379+
@>
380+
381+
let resultIndices = Array.zeroCreate allIndices.Length
382+
let resultValues = Array.init allValues.Length (fun _ -> zero)
383+
384+
opencl {
385+
do! createSortedConcatenation
386+
do! filterThroughMask
387+
do! fillAuxiliaryArray
388+
do! dropExplicitZeroes
389+
390+
let! prefixSumArray = this.CalcPrefixSum auxiliaryArray
391+
let binder kernelP =
392+
let ndRange = _1D(auxiliaryArray.Length)
393+
kernelP
394+
ndRange
395+
allIndices
396+
allValues
397+
auxiliaryArray
398+
prefixSumArray
399+
resultIndices
400+
resultValues
401+
do! RunCommand createUnion binder
402+
403+
return upcast SparseVector<'a>(this.Size, resultIndices, resultValues)
404+
}
405+
406+
override this.EWiseAdd
407+
(vector: Vector<'a>)
408+
(mask: Mask1D option)
409+
(semiring: Semiring<'a>) =
410+
411+
if vector.Size <> this.Size
412+
then
413+
invalidArg
414+
"vector"
415+
(sprintf "Argument has invalid dimension. Need %i, but given %i" this.Size vector.Size)
416+
417+
// let mask =
418+
// match mask with
419+
// | Some m ->
420+
// if m.Size <> this.Size then
421+
// invalidArg
422+
// "mask"
423+
// (sprintf "Argument has invalid dimension. Need %i, but given %i" this.Size m.Size)
424+
// m
425+
// | _ -> Mask1D(Array.empty, this.Size, true) // Empty complemented mask is equal to none
426+
427+
match vector with
428+
| :? SparseVector<'a> -> this.EWiseAddSparse (downcast vector) mask semiring
429+
| _ -> failwith "Not Implemented"
430+
138431
override this.EWiseMult a b c = failwith "Not Implemented"
139432
override this.Apply a b = failwith "Not Implemented"
140433
override this.Prune a b = failwith "Not Implemented"
@@ -155,6 +448,7 @@ and DenseVector<'a when 'a : struct and 'a : equality>(vector: 'a[], monoid: Mon
155448
override this.GetMask(?isComplemented: bool) =
156449
let isComplemented = defaultArg isComplemented false
157450
failwith "Not Implemented"
451+
override this.ToHost () = failwith "Not Implemented"
158452

159453
override this.Extract (mask: Mask1D option) : OpenCLEvaluation<Vector<'a>> = failwith "Not Implemented"
160454
override this.Extract (idx: int) : OpenCLEvaluation<Scalar<'a>> = failwith "Not Implemented"

0 commit comments

Comments
 (0)