@@ -13,17 +13,138 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
1313
1414
1515module Matrix =
16+ let expandRowPointers ( clContext : ClContext ) workGroupSize =
17+
18+ let kernel =
19+ <@ fun ( ndRange : Range1D ) columnsLength pointersLength ( pointers : ClArray < int >) ( results : ClArray < int >) ->
20+
21+ let gid = ndRange.GlobalID0
22+
23+ if gid < columnsLength then
24+ let result =
25+ (% Search.Bin.lowerBound) pointersLength gid pointers
26+
27+ results.[ gid] <- result - 1 @>
28+
29+ let program = clContext.Compile kernel
30+
31+ fun ( processor : MailboxProcessor < _ >) allocationMode ( matrix : ClMatrix.CSR < 'a >) ->
32+
33+ let rows =
34+ clContext.CreateClArrayWithSpecificAllocationMode( allocationMode, matrix.Columns.Length)
35+
36+ let kernel = program.GetKernel()
37+
38+ let ndRange =
39+ Range1D.CreateValid( matrix.Columns.Length, workGroupSize)
40+
41+ processor.Post(
42+ Msg.MsgSetArguments
43+ ( fun () ->
44+ kernel.KernelFunc
45+ ndRange
46+ matrix.Columns.Length
47+ matrix.RowPointers.Length
48+ matrix.RowPointers
49+ rows)
50+ )
51+
52+ processor.Post( Msg.CreateRunMsg<_, _> kernel)
53+
54+ rows
55+
56+ let subRows ( clContext : ClContext ) workGroupSize =
57+
58+ let kernel =
59+ <@ fun ( ndRange : Range1D ) resultLength sourceRow pointersLength ( pointers : ClArray < int >) ( results : ClArray < int >) ->
60+
61+ let gid = ndRange.GlobalID0
62+
63+ let shift = pointers.[ sourceRow]
64+ let shiftedId = gid + shift
65+
66+ if gid < resultLength then
67+ let result =
68+ (% Search.Bin.lowerBound) pointersLength shiftedId pointers
69+
70+ results.[ gid] <- result - 1 @>
71+
72+ let program = clContext.Compile kernel
73+
74+ let blit = ClArray.blit clContext workGroupSize
75+
76+ let blitData = ClArray.blit clContext workGroupSize
77+
78+ fun ( processor : MailboxProcessor < _ >) allocationMode startIndex count ( matrix : ClMatrix.CSR < 'a >) ->
79+ if count <= 0 then
80+ failwith " Count must be greater than zero"
81+
82+ if startIndex < 0 then
83+ failwith " startIndex must be greater then zero"
84+
85+ if startIndex + count > matrix.RowCount then
86+ failwith " startIndex and count sum is larger than the matrix row count"
87+
88+ // extract rows
89+ let rowPointers = matrix.RowPointers.ToHost processor
90+
91+ let resultLength =
92+ rowPointers.[ startIndex + count]
93+ - rowPointers.[ startIndex]
94+
95+ let rows =
96+ clContext.CreateClArrayWithSpecificAllocationMode( allocationMode, resultLength)
97+
98+ let kernel = program.GetKernel()
99+
100+ let ndRange =
101+ Range1D.CreateValid( matrix.Columns.Length, workGroupSize)
102+
103+ processor.Post(
104+ Msg.MsgSetArguments
105+ ( fun () ->
106+ kernel.KernelFunc
107+ ndRange
108+ resultLength
109+ startIndex
110+ matrix.RowPointers.Length
111+ matrix.RowPointers
112+ rows)
113+ )
114+
115+ processor.Post( Msg.CreateRunMsg<_, _> kernel)
116+
117+ let startPosition = rowPointers.[ startIndex]
118+
119+ // extract values
120+ let values =
121+ clContext.CreateClArrayWithSpecificAllocationMode( allocationMode, resultLength)
122+
123+ blitData processor matrix.Values startPosition values 0 resultLength
124+
125+ // extract indices
126+ let columns =
127+ clContext.CreateClArrayWithSpecificAllocationMode( allocationMode, resultLength)
128+
129+ blit processor matrix.Columns startPosition columns 0 resultLength
130+
131+ { Context = clContext
132+ RowCount = matrix.RowCount
133+ ColumnCount = matrix.ColumnCount
134+ Rows = rows
135+ Columns = columns
136+ Values = values }
137+
16138 let toCOO ( clContext : ClContext ) workGroupSize =
17139 let prepare =
18- Common. expandRowPointers clContext workGroupSize
140+ expandRowPointers clContext workGroupSize
19141
20142 let copy = ClArray.copy clContext workGroupSize
21143
22144 let copyData = ClArray.copy clContext workGroupSize
23145
24146 fun ( processor : MailboxProcessor < _ >) allocationMode ( matrix : ClMatrix.CSR < 'a >) ->
25- let rows =
26- prepare processor allocationMode matrix.RowPointers matrix.Columns.Length matrix.RowCount
147+ let rows = prepare processor allocationMode matrix
27148
28149 let cols =
29150 copy processor allocationMode matrix.Columns
@@ -40,11 +161,10 @@ module Matrix =
40161
41162 let toCOOInPlace ( clContext : ClContext ) workGroupSize =
42163 let prepare =
43- Common. expandRowPointers clContext workGroupSize
164+ expandRowPointers clContext workGroupSize
44165
45166 fun ( processor : MailboxProcessor < _ >) allocationMode ( matrix : ClMatrix.CSR < 'a >) ->
46- let rows =
47- prepare processor allocationMode matrix.RowPointers matrix.Columns.Length matrix.RowCount
167+ let rows = prepare processor allocationMode matrix
48168
49169 processor.Post( Msg.CreateFreeMsg( matrix.RowPointers))
50170
@@ -92,7 +212,6 @@ module Matrix =
92212 let toCSRInPlace =
93213 COO.Matrix.toCSRInPlace clContext workGroupSize
94214
95-
96215 fun ( queue : MailboxProcessor < _ >) allocationMode ( matrix : ClMatrix.CSR < 'a >) ->
97216 toCOO queue allocationMode matrix
98217 |> transposeInPlace queue
0 commit comments