add: Vector.map

Author: IgorErin

benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs

@@ -83,7 +83,7 @@ type MxmBenchmarks<'elem when 'elem : struct>(
  member this.FunCSC2CSR =
  match funCSC2CSR with
  | None ->
- let x = Matrix.toCSRInplace this.OclContext this.WorkGroupSize
+ let x = Matrix.toCSRInPlace this.OclContext this.WorkGroupSize
  funCSC2CSR <- Some x
  x
  | Some x -> x

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

@@ -412,35 +412,82 @@ module ClArray =
  |> Seq.map (fun lazyValue -> lazyValue.Value)
  |> Seq.toArray
 
- let append<'a> (clContext: ClContext) workGroupSize =
+ let assign<'a> (clContext: ClContext) workGroupSize =
 
- let set =
- <@ fun (ndRange: Range1D) sourceArrayLength appendedArrayLength (inputArray: ClArray<'a>) (result: ClArray<'a>) ->
+ let assign =
+ <@ fun (ndRange: Range1D) startPosition appendedArrayLength (inputArray: ClArray<'a>) (result: ClArray<'a>) ->
 
  let gid = ndRange.GlobalID0
 
- let resultPosition = gid + sourceArrayLength
+ let resultPosition = gid + startPosition
 
  if gid < appendedArrayLength then
 
  result.[resultPosition] <- inputArray.[gid] @>
 
- let kernel = clContext.Compile set
+ let kernel = clContext.Compile assign
 
- fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) (appendedArray: ClArray<'a>) ->
-
- let resultLength = sourceArray.Length + appendedArray.Length
-
- let result =
- clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+ fun (processor: MailboxProcessor<_>) allocationMode (targetArray: ClArray<'a>) startPosition (appendedArray: ClArray<'a>) ->
+ if startPosition < 0 then failwith "The starting position cannot be less than zero"
+ if startPosition + appendedArray.Length > targetArray.Length then
+ failwith "The array should fit completely"
 
  let ndRange =
  Range1D.CreateValid(appendedArray.Length, workGroupSize)
 
  let kernel = kernel.GetKernel()
 
- processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange sourceArray.Length appendedArray.Length appendedArray result))
+ processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange appendedArray.Length appendedArray.Length appendedArray targetArray))
 
  processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
+ let concat (clContext: ClContext) workGroupSize =
+
+ let assign = assign clContext workGroupSize
+
+ fun (processor: MailboxProcessor<_>) allocationMode (sourceArrays: ClArray<'a> seq) ->
+
+ let resultLength =
+ sourceArrays |> Seq.sumBy (fun array -> array.Length)
+
+ let result = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength)
+
+ let assign = assign processor allocationMode result
+
+ // write each array to result
+ Seq.fold (fun previousLength array ->
+ assign previousLength array
+ previousLength + array.Length) 0 sourceArrays
+ |> ignore
+
  result
+
+ let fill (clContext: ClContext) workGroupSize =
+
+ let fill =
+ <@ fun (ndRange: Range1D) firstPosition endPosition (value: ClCell<'a>) (targetArray: ClArray<'a>) ->
+
+ let gid = ndRange.GlobalID0
+ let writePosition = gid + firstPosition
+
+ if writePosition < endPosition then
+
+ targetArray.[writePosition] <- value.Value @>
+
+ let kernel = clContext.Compile fill
+
+ fun (processor: MailboxProcessor<_>) value firstPosition count (targetArray: ClArray<'a>) ->
+ if firstPosition + count > targetArray.Length then failwith ""
+ if firstPosition < 0 then failwith ""
+ if count <= 0 then failwith "" // TODO()
+
+ let ndRange =
+ Range1D.CreateValid(count, workGroupSize)
+
+ let kernel = kernel.GetKernel()
+
+ processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange firstPosition (firstPosition + count) value targetArray))
+
+ processor.Post(Msg.CreateRunMsg<_, _>(kernel))
+
+ ()

src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj

@@ -34,11 +34,12 @@
  <Compile Include="Common/Sort/Radix.fs" />
  <Compile Include="Common/Sort/Bitonic.fs" />
  <Compile Include="Common/Sum.fs" />
- <Compile Include="Vector/SparseVector/Common.fs" />
- <Compile Include="Vector/SparseVector/Map2.fs" />
- <Compile Include="Vector/SparseVector/Map2AtLeastOne.fs" />
- <Compile Include="Vector/SparseVector/SparseVector.fs" />
- <Compile Include="Vector/DenseVector/DenseVector.fs" />
+ <Compile Include="Vector\Sparse\Common.fs" />
+ <Compile Include="Vector\Sparse\Map2.fs" />
+ <Compile Include="Vector\Sparse\Map2AtLeastOne.fs" />
+ <Compile Include="Vector\Sparse\SparseVector.fs" />
+ <Compile Include="Vector\Sparse\Map.fs" />
+ <Compile Include="Vector\Dense\DenseVector.fs" />
  <Compile Include="Vector/Vector.fs" />
  <Compile Include="Vector/SpMV.fs" />
  <Compile Include="Matrix/Common.fs" />

src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs

@@ -155,3 +155,33 @@ module Matrix =
  Columns = copy queue allocationMode matrix.Columns
  Values = copyData queue allocationMode matrix.Values }
  |> transposeInplace queue
+
+ let concat (clContext: ClContext) workGroupSize =
+
+ let concatValues = ClArray.concat clContext workGroupSize
+
+ let concatIndices = ClArray.concat clContext workGroupSize
+
+ fun (processor: MailboxProcessor<_>) allocationMode columnCount rowCount (matrices: ClMatrix.COO<'a> seq) ->
+
+ let resultValues =
+ matrices
+ |> Seq.map (fun matrix -> matrix.Values)
+ |> concatValues processor allocationMode
+
+ let resultColumns =
+ matrices
+ |> Seq.map (fun matrix -> matrix.Columns)
+ |> concatIndices processor allocationMode
+
+ let resultRows =
+ matrices
+ |> Seq.map (fun matrix -> matrix.Rows)
+ |> concatIndices processor allocationMode
+
+ { Context = clContext
+ RowCount = rowCount
+ ColumnCount = columnCount
+ Rows = resultRows
+ Columns = resultColumns
+ Values = resultValues }

src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs

@@ -45,9 +45,7 @@ module Matrix =
  Values = copyData processor allocationMode m.Values }
  | ClMatrix.Rows matrix ->
  matrix.Rows
- |> Array.map (function
- Some vector -> Some <| vectorCopy processor allocationMode vector
- | None -> None)
+ |> Array.map (Option.bind <| (Some << (vectorCopy processor allocationMode)))
  |> fun rows ->
  { Context = clContext
  RowCount = matrix.RowCount
@@ -69,6 +67,8 @@ module Matrix =
  let transpose =
  CSR.Matrix.transpose clContext workGroupSize
 
+ let rowsToCSR = Rows.Matrix.toCSR clContext workGroupSize
+
  fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) ->
  match matrix with
  | ClMatrix.COO m -> toCSR processor allocationMode m |> ClMatrix.CSR
@@ -77,30 +77,36 @@ module Matrix =
  m.ToCSR
  |> transpose processor allocationMode
  |> ClMatrix.CSR
+ | ClMatrix.Rows m ->
+ rowsToCSR processor allocationMode m
+ |> ClMatrix.CSR
 
  /// <summary>
  /// Returns the matrix, represented in CSR format, that is equal to the given one.
  /// The given matrix should neither be used afterwards nor be disposed.
  /// </summary>
  ///<param name="clContext">OpenCL context.</param>
  ///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
- let toCSRInplace (clContext: ClContext) workGroupSize =
- let toCSRInplace =
+ let toCSRInPlace (clContext: ClContext) workGroupSize =
+ let toCSRInPlace =
  COO.Matrix.toCSRInplace clContext workGroupSize
 
- let transposeInplace =
+ let transposeInPlace =
  CSR.Matrix.transposeInplace clContext workGroupSize
 
+ let rowsToCSR = Rows.Matrix.toCSR clContext workGroupSize
+
  fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) ->
  match matrix with
  | ClMatrix.COO m ->
- toCSRInplace processor allocationMode m
+ toCSRInPlace processor allocationMode m
  |> ClMatrix.CSR
  | ClMatrix.CSR _ -> matrix
  | ClMatrix.CSC m ->
  m.ToCSR
- |> transposeInplace processor allocationMode
+ |> transposeInPlace processor allocationMode
  |> ClMatrix.CSR
+ | _ -> failwith "not yet supported"
 
  /// <summary>
  /// Creates a new matrix, represented in COO format, that is equal to the given one.
@@ -115,6 +121,9 @@ module Matrix =
  let transposeInplace =
  COO.Matrix.transposeInplace clContext workGroupSize
 
+ let rowsToCOO =
+ Rows.Matrix.toCOO clContext workGroupSize
+
  fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) ->
  match matrix with
  | ClMatrix.COO _ -> copy processor allocationMode matrix
@@ -124,39 +133,46 @@ module Matrix =
  |> toCOO processor allocationMode
  |> transposeInplace processor
  |> ClMatrix.COO
+ | ClMatrix.Rows m ->
+ rowsToCOO processor allocationMode m
+ |> ClMatrix.COO
 
  /// <summary>
  /// Returns the matrix, represented in COO format, that is equal to the given one.
  /// The given matrix should neither be used afterwards nor be disposed.
  /// </summary>
  ///<param name="clContext">OpenCL context.</param>
  ///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
- let toCOOInplace (clContext: ClContext) workGroupSize =
- let toCOOInplace =
+ let toCOOInPlace (clContext: ClContext) workGroupSize =
+ let toCOOInPlace =
  CSR.Matrix.toCOOInplace clContext workGroupSize
 
- let transposeInplace =
+ let transposeInPlace =
  COO.Matrix.transposeInplace clContext workGroupSize
 
+ let rowsToCOO =
+ Rows.Matrix.toCOO clContext workGroupSize
+
  fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) ->
  match matrix with
  | ClMatrix.COO _ -> matrix
  | ClMatrix.CSR m ->
- toCOOInplace processor allocationMode m
+ toCOOInPlace processor allocationMode m
  |> ClMatrix.COO
  | ClMatrix.CSC m ->
  m.ToCSR
- |> toCOOInplace processor allocationMode
- |> transposeInplace processor
+ |> toCOOInPlace processor allocationMode
+ |> transposeInPlace processor
  |> ClMatrix.COO
+ | _ -> failwith "not yet supported"
 
  /// <summary>
  /// Creates a new matrix, represented in CSC format, that is equal to the given one.
  /// </summary>
  ///<param name="clContext">OpenCL context.</param>
  ///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
  let toCSC (clContext: ClContext) workGroupSize =
- let toCSR = COO.Matrix.toCSR clContext workGroupSize
+ let COOtoCSR = COO.Matrix.toCSR clContext workGroupSize
 
  let copy = copy clContext workGroupSize
 
@@ -174,9 +190,10 @@ module Matrix =
  |> ClMatrix.CSC
  | ClMatrix.COO m ->
  (transposeCOO processor allocationMode m
- |> toCSR processor allocationMode)
+ |> COOtoCSR processor allocationMode)
  .ToCSC
  |> ClMatrix.CSC
+ | _ -> failwith "not yet supported"
 
  /// <summary>
  /// Returns the matrix, represented in CSC format, that is equal to the given one.
@@ -206,6 +223,7 @@ module Matrix =
  |> toCSRInplace processor allocationMode)
  .ToCSC
  |> ClMatrix.CSC
+ | _ -> failwith "not yet supported"
 
  let map (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) workGroupSize =
  let mapCOO =
@@ -271,7 +289,7 @@ module Matrix =
  let CSRElementwise =
  CSR.Matrix.map2AtLeastOneToCOO clContext opAdd workGroupSize
 
- let transposeCOOInplace =
+ let transposeCOOInPlace =
  COO.Matrix.transposeInplace clContext workGroupSize
 
  fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 ->
@@ -284,7 +302,7 @@ module Matrix =
  |> ClMatrix.COO
  | ClMatrix.CSC m1, ClMatrix.CSC m2 ->
  CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR
- |> transposeCOOInplace processor
+ |> transposeCOOInPlace processor
  |> ClMatrix.COO
  | _ -> failwith "Matrix formats are not matching"
 
@@ -301,15 +319,16 @@ module Matrix =
  /// </remarks>
  ///<param name="clContext">OpenCL context.</param>
  ///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
- let transposeInplace (clContext: ClContext) workGroupSize =
- let COOtransposeInplace =
+ let transposeInPlace (clContext: ClContext) workGroupSize =
+ let COOTransposeInPlace =
  COO.Matrix.transposeInplace clContext workGroupSize
 
  fun (processor: MailboxProcessor<_>) matrix ->
  match matrix with
- | ClMatrix.COO m -> COOtransposeInplace processor m |> ClMatrix.COO
+ | ClMatrix.COO m -> COOTransposeInPlace processor m |> ClMatrix.COO
  | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC
  | ClMatrix.CSC m -> ClMatrix.CSR m.ToCSR
+ | ClMatrix.Rows _ -> failwith "not yet supported"
 
  /// <summary>
  /// Transposes the given matrix and returns result as a new matrix.
@@ -352,6 +371,7 @@ module Matrix =
  Columns = copy processor allocationMode m.Rows
  Values = copyData processor allocationMode m.Values }
  |> ClMatrix.CSR
+ | ClMatrix.Rows _ -> failwith "not yet supported"
 
  let mxm
  (opAdd: Expr<'c -> 'c -> 'c option>)