PageRank

Author: kirillgarbar

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

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

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

@@ -0,0 +1,196 @@
+namespace GraphBLAS.FSharp.Backend.Algorithms
+
+open GraphBLAS.FSharp.Backend
+open Brahma.FSharp
+open GraphBLAS.FSharp.Objects
+open GraphBLAS.FSharp.Backend.Quotes
+open GraphBLAS.FSharp.Backend.Vector.Dense
+open GraphBLAS.FSharp.Objects.ClMatrix
+open GraphBLAS.FSharp.Objects.ClContextExtensions
+open GraphBLAS.FSharp.Objects.ArraysExtensions
+open GraphBLAS.FSharp.Objects.ClCellExtensions
+
+module internal PageRank =
+    let alpha = 0.85f
+    let accuracy = 0.00000001f
+
+    let countOutDegree (clContext: ClContext) workGroupSize =
+
+        let one =
+            <@ fun (x: float32 option) (_: int option) ->
+                let mutable res = 0
+
+                match x with
+                | Some _ -> res <- 1
+                | None -> ()
+
+                if res = 0 then None else Some res @>
+
+        let spMV =
+            Operations.SpMV.runTo ArithmeticOperations.intSumOption one clContext workGroupSize
+
+        let zeroCreate =
+            GraphBLAS.FSharp.ClArray.zeroCreate clContext workGroupSize
+
+        fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix.CSR<float32>) ->
+            let outDegree: ClArray<int option> =
+                zeroCreate queue DeviceOnly matrix.ColumnCount
+
+            spMV queue matrix outDegree outDegree
+
+            outDegree
+
+    let prepareMatrix (clContext: ClContext) workGroupSize =
+
+        let alpha = 0.85f
+
+        let op =
+            <@ fun (x: float32 option) y ->
+                let mutable res = 0.0f
+
+                match x, y with
+                | Some _, Some y -> res <- alpha / (float32 y)
+                | Some _, None -> ()
+                | None, Some _ -> ()
+                | None, None -> ()
+
+                if res = 0.0f then None else Some res @>
+
+        //TODO: generalize to map2 Matrix x Vector
+        let multiply =
+            <@ fun (range: Range1D) (numberOfRows: int) (matrixRowPointers: ClArray<int>) (matrixValues: ClArray<float32>) (vectorValues: ClArray<int option>) (resultMatrixValues: ClArray<float32>) ->
+
+                let i = range.GlobalID0
+                let li = range.LocalID0
+                let group = i / workGroupSize
+
+                if group < numberOfRows then
+                    let rowStart = matrixRowPointers.[group]
+                    let rowEnd = matrixRowPointers.[group + 1]
+
+                    let vectorValue = vectorValues.[group]
+                    let mutable index = rowStart + li
+
+                    while index < rowEnd do
+                        let matrixValue = matrixValues.[index]
+                        let resultValue = (%op) (Some matrixValue) vectorValue
+
+                        match resultValue with
+                        | Some v -> resultMatrixValues.[index] <- v
+                        | None -> () //This should not be reachable
+
+                        index <- index + workGroupSize @>
+
+        let countOutDegree = countOutDegree clContext workGroupSize
+
+        let copy =
+            GraphBLAS.FSharp.ClArray.copy clContext workGroupSize
+
+        let transpose =
+            Matrix.CSR.Matrix.transposeInPlace clContext workGroupSize
+
+        let multiply = clContext.Compile multiply
+
+        fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix.CSR<float32>) ->
+
+            let outDegree = countOutDegree queue matrix
+
+            let resultValues =
+                clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, matrix.Values.Length)
+
+            let kernel = multiply.GetKernel()
+
+            let ndRange =
+                Range1D.CreateValid(matrix.RowCount * workGroupSize, workGroupSize)
+
+            queue.Post(
+                Msg.MsgSetArguments
+                    (fun () ->
+                        kernel.KernelFunc
+                            ndRange
+                            matrix.RowCount
+                            matrix.RowPointers
+                            matrix.Values
+                            outDegree
+                            resultValues)
+            )
+
+            queue.Post(Msg.CreateRunMsg<_, _> kernel)
+
+            outDegree.Free queue
+
+            let newMatrix =
+                { Context = clContext
+                  RowCount = matrix.RowCount
+                  ColumnCount = matrix.ColumnCount
+                  RowPointers = copy queue DeviceOnly matrix.RowPointers
+                  Columns = copy queue DeviceOnly matrix.Columns
+                  Values = resultValues }
+
+            let transposed = transpose queue DeviceOnly newMatrix
+            transposed
+
+    let run (clContext: ClContext) workGroupSize =
+
+        let alpha = 0.85f
+        let accuracy = 0.00000001f
+
+        let minusAndSquare = ArithmeticOperations.minusAndSquare
+        let plus = ArithmeticOperations.float32SumOption
+        let mul = ArithmeticOperations.float32MulOption
+
+        let spMVTo =
+            Operations.SpMV.runTo plus mul clContext workGroupSize
+
+        let addToResult =
+            Vector.map2InPlace plus clContext workGroupSize
+
+        let subtractAndSquare =
+            Vector.map2InPlace minusAndSquare clContext workGroupSize
+
+        let reduce =
+            Vector.reduce <@ (+) @> clContext workGroupSize
+
+        let create =
+            GraphBLAS.FSharp.ClArray.create clContext workGroupSize
+
+        fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix.CSR<float32>) ->
+
+            let vertexCount = matrix.RowCount
+
+            //None is 0
+            let mutable rank = create queue DeviceOnly vertexCount None
+
+            let mutable prevRank =
+                create queue DeviceOnly vertexCount (Some(1.0f / (float32 vertexCount)))
+
+            let mutable errors = create queue DeviceOnly vertexCount None
+
+            let addition =
+                create queue DeviceOnly vertexCount (Some((1.0f - alpha) / (float32 vertexCount)))
+
+            let mutable error = accuracy + 0.1f
+
+            let mutable i = 0
+
+            while error > accuracy do
+                i <- i + 1
+
+                // rank = matrix*rank + (1 - alpha)/N
+                spMVTo queue matrix prevRank rank
+                addToResult queue rank addition rank
+
+                // error
+                subtractAndSquare queue rank prevRank errors
+                error <- sqrt <| (reduce queue errors).ToHostAndFree queue
+
+                //Swap vectors
+                let temp = rank
+                rank <- prevRank
+                prevRank <- temp
+
+            prevRank.Free queue
+            errors.Free queue
+            addition.Free queue
+
+            rank

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

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

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

@@ -244,3 +244,16 @@ module ArithmeticOperations =
             | Some x, None -> Some x
             | None, Some y -> Some y
             | _ -> None @>
+
+    //PageRank specific
+    let minusAndSquare =
+        <@ 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 @>