Fix merge

Author: kirillgarbar

benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj

@@ -25,8 +25,9 @@
     <Compile Include="Matrix/Map2/MathNET.fs" />
     <Compile Include="Vector/Map2.fs" />
     <Compile Include="Algorithms/BFS.fs" />
+    <Compile Include="Algorithms/PageRank.fs" />  
     <Compile Include="Program.fs" />
     <Folder Include="Datasets" />
   </ItemGroup>
   <Import Project="..\..\.paket\Paket.Restore.targets" />
-</Project>
+</Project>

benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs

@@ -4,7 +4,7 @@ open BenchmarkDotNet.Running
 [<EntryPoint>]
 let main argv =
     let benchmarks =
-        BenchmarkSwitcher [| typeof<Algorithms.BFS.BFSWithoutTransferBenchmarkBool>
+        BenchmarkSwitcher [| typeof<Algorithms.BFS.BFSWithoutTransferBenchmarkBool> |]
 
     benchmarks.Run argv |> ignore
     0

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

@@ -19,3 +19,8 @@ module Algorithms =
 
     module SSSP =
         let run = SSSP.run
+
+    module PageRank =
+        let run = PageRank.run
+
+        let prepareMatrix = PageRank.prepareMatrix

src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs

@@ -34,7 +34,7 @@ module internal BFS =
         let containsNonZero =
             Vector.exists Predicates.isSome clContext workGroupSize
 
-        fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix<'a>) (source: int) ->
+        fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix<bool>) (source: int) ->
             let vertexCount = matrix.RowCount
 
             let levels =

src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs

@@ -76,6 +76,4 @@ module SSSP =
             front1.Dispose queue
             front2.Dispose queue
 
-            match distance with
-            | ClVector.Dense dist -> dist
-            | _ -> failwith "not implemented"
+            distance

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

@@ -71,6 +71,7 @@
     <Compile Include="Algorithms/BFS.fs" />
     <Compile Include="Algorithms/MSBFS.fs" />
     <Compile Include="Algorithms/SSSP.fs" />
+    <Compile Include="Algorithms/PageRank.fs" />  
     <Compile Include="Algorithms/Algorithms.fs" />
 
   </ItemGroup>

src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs

@@ -257,3 +257,16 @@ module ArithmeticOperations =
         <@ fun (x: 'a) (y: 'a) -> Some(min x y) @>
 
     let fst<'a> = <@ fun (x: 'a) (_: 'a) -> Some x @>
+
+    //PageRank specific
+    let squareOfDifference =
+        <@ fun (x: float32 option) (y: float32 option) ->
+            let mutable res = 0.0f
+
+            match x, y with
+            | Some f, Some s -> res <- (f - s) * (f - s)
+            | Some f, None -> res <- f * f
+            | None, Some s -> res <- s * s
+            | None, None -> ()
+
+            if res = 0.0f then None else Some res @>

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

@@ -15,29 +15,30 @@ open GraphBLAS.FSharp.Backend.Vector
 [<RequireQualifiedAccess>]
 module Vector =
     /// <summary>
-    /// Builds vector of given format with fixed size and fills it with the default values of desired type.
+    /// Builds vector of given format with fixed size and fills it with the given value.
     /// </summary>
     /// <param name="clContext">OpenCL context.</param>
     /// <param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
-    let zeroCreate (clContext: ClContext) workGroupSize =
-        let zeroCreate =
-            ClArray.zeroCreate clContext workGroupSize
+    let create (clContext: ClContext) workGroupSize =
+        let create = ClArray.create clContext workGroupSize
 
-        fun (processor: MailboxProcessor<_>) allocationMode size format ->
+        fun (processor: MailboxProcessor<_>) allocationMode size format value ->
             match format with
-            | Sparse ->
-                ClVector.Sparse
-                    { Context = clContext
-                      Indices = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, [| 0 |])
-                      Values =
-                          clContext.CreateClArrayWithSpecificAllocationMode(
-                              allocationMode,
-                              [| Unchecked.defaultof<'a> |]
-                          ) // TODO empty vector
-                      Size = size }
+            | Sparse -> failwith "Attempting to create full sparse vector"
             | Dense ->
                 ClVector.Dense
-                <| zeroCreate processor allocationMode size
+                <| create processor allocationMode size value
+
+    /// <summary>
+    /// Builds vector of given format with fixed size and fills it with the default values of desired type.
+    /// </summary>
+    /// <param name="clContext">OpenCL context.</param>
+    /// <param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
+    let zeroCreate (clContext: ClContext) workGroupSize =
+        let create = create clContext workGroupSize
+
+        fun (processor: MailboxProcessor<_>) allocationMode size format ->
+            create processor allocationMode size format None
 
     /// <summary>
     /// Builds vector of given format with fixed size and fills it with the values from the given list.

tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs

@@ -60,7 +60,7 @@ let makeLevelsTest context queue bfs (matrix: int [,]) =
 let createLevelsTest<'a> context queue testFun =
     testFun
     |> makeLevelsTest context queue
-    |> testPropertyWithConfig config $"test on %A{typeof<'a>}"
+    |> testPropertyWithConfig config $"test on %A{typeof<'a>}, %A{context}"
 
 let levelsTestFixtures (testContext: TestContext) =
     [ let context = testContext.ClContext
@@ -112,7 +112,7 @@ let makeParentsTest context queue bfs (matrix: int [,]) =
 let createParentsTest<'a> context queue testFun =
     testFun
     |> makeParentsTest context queue
-    |> testPropertyWithConfig config $"test on %A{typeof<'a>}"
+    |> testPropertyWithConfig config $"test on %A{typeof<'a>}, %A{context}"
 
 let parentsTestFixtures (testContext: TestContext) =
     [ let context = testContext.ClContext

tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs

@@ -0,0 +1,118 @@
+module GraphBLAS.FSharp.Tests.Backend.Algorithms.PageRank
+
+open Expecto
+open GraphBLAS.FSharp
+open GraphBLAS.FSharp.Tests
+open GraphBLAS.FSharp.Tests.Context
+open GraphBLAS.FSharp.Objects.ClVectorExtensions
+open GraphBLAS.FSharp.Objects
+
+let private alpha = 0.85f
+let private accuracy = 0.00001f
+
+let prepareNaive (matrix: float32 [,]) =
+    let result = Array2D.copy matrix
+    let rowCount = Array2D.length1 matrix
+    let outDegrees = Array.zeroCreate rowCount
+
+    //Count degree
+    Array2D.iteri (fun r c v -> outDegrees.[r] <- outDegrees.[r] + (if v <> 0f then 1f else 0f)) matrix
+
+    //Set value
+    Array2D.iteri
+        (fun r c v ->
+            result.[r, c] <-
+                if v <> 0f then
+                    alpha / outDegrees.[r]
+                else
+                    0f)
+        matrix
+
+    //Transpose
+    Array2D.iteri
+        (fun r c _ ->
+            if r > c then
+                let temp = result.[r, c]
+                result.[r, c] <- result.[c, r]
+                result.[c, r] <- temp)
+        matrix
+
+    result
+
+let pageRankNaive (matrix: float32 [,]) =
+    let rowCount = Array2D.length1 matrix
+    let mutable result = Array.zeroCreate rowCount
+
+    let mutable prev =
+        Array.create rowCount (1f / (float32 rowCount))
+
+    let mutable error = accuracy + 1f
+    let addConst = (1f - alpha) / (float32 rowCount)
+
+    while (error > accuracy) do
+        for r in 0 .. rowCount - 1 do
+            result.[r] <- 0f
+
+            for c in 0 .. rowCount - 1 do
+                result.[r] <- result.[r] + matrix.[r, c] * prev.[c]
+
+            result.[r] <- result.[r] + addConst
+
+        error <-
+            sqrt
+            <| Array.fold2 (fun e x1 x2 -> e + (x1 - x2) * (x1 - x2)) 0f result prev
+
+        let temp = result
+        result <- prev
+        prev <- temp
+
+    prev
+
+let testFixtures (testContext: TestContext) =
+    [ let config = Utils.undirectedAlgoConfig
+      let context = testContext.ClContext
+      let queue = testContext.Queue
+      let workGroupSize = Utils.defaultWorkGroupSize
+
+      let testName =
+          sprintf "Test on %A" testContext.ClContext
+
+      let pageRank =
+          Algorithms.PageRank.run context workGroupSize
+
+      testPropertyWithConfig config testName
+      <| fun (matrix: float32 [,]) ->
+          let matrixHost =
+              Utils.createMatrixFromArray2D CSR matrix ((=) 0f)
+
+          if matrixHost.NNZ > 0 then
+              let preparedMatrixExpected = prepareNaive matrix
+
+              let expected = pageRankNaive preparedMatrixExpected
+
+              let matrix = matrixHost.ToDevice context
+
+              let preparedMatrix =
+                  Algorithms.PageRank.prepareMatrix context workGroupSize queue matrix
+
+              let res = pageRank queue preparedMatrix accuracy
+
+              let resHost = res.ToHost queue
+
+              preparedMatrix.Dispose queue
+              matrix.Dispose queue
+              res.Dispose queue
+
+              match resHost with
+              | Vector.Dense resHost ->
+                  let actual = resHost |> Utils.unwrapOptionArray 0f
+
+                  for i in 0 .. actual.Length - 1 do
+                      Expect.isTrue
+                          ((abs (actual.[i] - expected.[i])) < accuracy)
+                          (sprintf "Values should be equal. Expected %A, actual %A" expected.[i] actual.[i])
+
+              | _ -> failwith "Not implemented" ]
+
+let tests =
+    TestCases.gpuTests "PageRank tests" testFixtures