SSSP dense

Author: kirillgarbar

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

@@ -0,0 +1,95 @@
+namespace GraphBLAS.FSharp.Backend.Algorithms
+
+open GraphBLAS.FSharp.Backend
+open Brahma.FSharp
+open FSharp.Quotations
+open GraphBLAS.FSharp.Backend.Objects
+open GraphBLAS.FSharp.Backend.Common
+open GraphBLAS.FSharp.Backend.Quotes
+open GraphBLAS.FSharp.Backend.Vector
+open GraphBLAS.FSharp.Backend.Vector.Dense
+open GraphBLAS.FSharp.Backend.Objects.ClContext
+open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
+open GraphBLAS.FSharp.Backend.Objects.ClCell
+
+module SSSP =
+    let run (clContext: ClContext) workGroupSize =
+
+        let less = ArithmeticOperations.less<int>
+        let min = ArithmeticOperations.min<int>
+        let plus = ArithmeticOperations.intSumAsMul
+
+        let spMVTo =
+            SpMV.runTo min plus clContext workGroupSize
+
+        let create = ClArray.create clContext workGroupSize
+
+        let createMask = ClArray.create clContext workGroupSize
+
+        let ofList = Vector.ofList clContext workGroupSize
+
+        let eWiseMulLess =
+            ClArray.map2InPlace less clContext workGroupSize
+
+        let eWiseAddMin =
+            ClArray.map2InPlace min clContext workGroupSize
+
+        let fillSubVectorTo =
+            Vector.assignByMaskInPlace (Convert.assignToOption Mask.assignComplemented) clContext workGroupSize
+
+        let containsNonZero =
+            ClArray.exists Predicates.isSome clContext workGroupSize
+
+        fun (queue: MailboxProcessor<Msg>) (matrix: ClMatrix.CSR<int>) (source: int) ->
+            let vertexCount = matrix.RowCount
+
+            //None is System.Int32.MaxValue
+            let distance =
+                ofList queue DeviceOnly Dense vertexCount [ source, 0 ]
+
+            let mutable f1 =
+                ofList queue DeviceOnly Dense vertexCount [ source, 0 ]
+
+            let mutable f2 =
+                create queue DeviceOnly vertexCount None
+                |> ClVector.Dense
+
+            let m =
+                createMask queue DeviceOnly vertexCount None
+                |> ClVector.Dense
+
+            let mutable stop = false
+
+            while not stop do
+                match f1, f2, distance, m with
+                | ClVector.Dense front1, ClVector.Dense front2, ClVector.Dense dist, ClVector.Dense mask ->
+                    //Getting new frontier
+                    spMVTo queue matrix front1 front2
+
+                    //Checking which distances were updated
+                    eWiseMulLess queue front2 dist mask
+                    //Updating
+                    eWiseAddMin queue dist front2 dist
+
+                    //Filtering unproductive vertices
+                    fillSubVectorTo queue front2 mask (clContext.CreateClCell 0) front2
+
+                    //Swap fronts
+                    let temp = f1
+                    f1 <- f2
+                    f2 <- temp
+
+                    //Checking if no distances were updated
+                    stop <-
+                        not
+                        <| (containsNonZero queue mask).ToHostAndFree(queue)
+
+                | _ -> failwith "not implemented"
+
+            f1.Dispose queue
+            f2.Dispose queue
+            m.Dispose queue
+
+            match distance with
+            | ClVector.Dense dist -> dist
+            | _ -> failwith "not implemented"

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

@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project Sdk="Microsoft.NET.Sdk">
 
   <PropertyGroup>
@@ -63,6 +63,7 @@
     <Compile Include="Matrix/Matrix.fs" />
 
     <Compile Include="Algorithms/BFS.fs" />
+    <Compile Include="Algorithms/SSSP.fs" />
   </ItemGroup>
   <Import Project="..\..\.paket\Paket.Restore.targets" />
 </Project>

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

@@ -36,6 +36,16 @@ module ArithmeticOperations =
 
             if res = zero then None else Some res @>
 
+    let inline mkNumericSumAsMul zero =
+        <@ fun (x: 't option) (y: 't option) ->
+            let mutable res = zero
+
+            match x, y with
+            | Some f, Some s -> res <- f + s
+            | _ -> ()
+
+            if res = zero then None else Some res @>
+
     let inline mkNumericMul zero =
         <@ fun (x: 't option) (y: 't option) ->
             let mutable res = zero
@@ -173,6 +183,8 @@ module ArithmeticOperations =
     let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0
     let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f
 
+    let intSumAsMul = mkNumericSumAsMul System.Int32.MaxValue
+
     let notOption =
         <@ fun x ->
             match x with
@@ -216,3 +228,20 @@ module ArithmeticOperations =
     let floatMul = createPair 0.0 (*) <@ (*) @>
 
     let float32Mul = createPair 0.0f (*) <@ (*) @>
+
+    // other
+    let less<'a when 'a: comparison> =
+        <@ fun (x: 'a option) (y: 'a option) ->
+            match x, y with
+            | Some x, Some y -> if (x < y) then Some 1 else None
+            | Some x, None -> Some 1
+            | _ -> None @>
+
+    //TODO: noneValue
+    let min<'a when 'a: comparison> =
+        <@ fun (x: 'a option) (y: 'a option) ->
+            match x, y with
+            | Some x, Some y -> Some(min x y)
+            | Some x, None -> Some x
+            | None, Some y -> Some y
+            | _ -> None @>

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

@@ -7,6 +7,12 @@ module Mask =
             | _, None -> left
             | _ -> right @>
 
+    let assignComplemented<'a when 'a: struct> =
+        <@ fun (left: 'a option) (right: 'a option) ->
+            match left, right with
+            | _, None -> right
+            | _ -> left @>
+
     let op<'a, 'b when 'a: struct and 'b: struct> =
         <@ fun (left: 'a option) (right: 'b option) ->
             match right with

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

@@ -0,0 +1,72 @@
+module GraphBLAS.FSharp.Tests.Backend.Algorithms.SSSP
+
+open Expecto
+open GraphBLAS.FSharp.Backend
+open GraphBLAS.FSharp.Backend.Common
+open GraphBLAS.FSharp.Backend.Quotes
+open GraphBLAS.FSharp.Tests
+open GraphBLAS.FSharp.Tests.Context
+open GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms
+open GraphBLAS.FSharp.Tests.Backend.QuickGraph.CreateGraph
+open GraphBLAS.FSharp.Backend.Objects
+open GraphBLAS.FSharp.Objects.ClVectorExtensions
+open GraphBLAS.FSharp.Objects
+
+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 ssspDense =
+          Algorithms.SSSP.run context workGroupSize
+
+      testPropertyWithConfig config testName
+      <| fun (matrix: int [,]) ->
+
+          let matrix = Array2D.map (fun x -> abs x) matrix
+
+          let graph = undirectedFromArray2D matrix 0
+
+          let largestComponent =
+              ConnectedComponents.largestComponent graph
+
+          if largestComponent.Length > 0 then
+              let source = largestComponent.[0]
+
+              let expected =
+                  SSSP.runUndirected matrix (directedFromArray2D matrix 0) source
+                  |> Array.map
+                      (fun x ->
+                          match x with
+                          | Some x -> Some(int x)
+                          | None -> None)
+
+              let matrixHost =
+                  Utils.createMatrixFromArray2D CSR matrix ((=) 0)
+
+              let matrix = matrixHost.ToDevice context
+
+              match matrix with
+              | ClMatrix.CSR mtx ->
+                  let resDense =
+                      ssspDense queue mtx source |> ClVector.Dense
+
+                  let resHost = resDense.ToHost queue
+
+                  (mtx :> IDeviceMemObject).Dispose queue
+                  resDense.Dispose queue
+
+                  match resHost with
+                  | Vector.Dense resHost ->
+                      let actual = resHost
+
+                      Expect.sequenceEqual actual expected "Sequences must be equal"
+                  | _ -> failwith "Not implemented"
+              | _ -> failwith "Not implemented" ]
+
+let tests =
+    TestCases.gpuTests "SSSP tests" testFixtures

tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/SSSP.fs

@@ -0,0 +1,37 @@
+namespace GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms
+
+open QuikGraph
+open QuikGraph.Algorithms.ShortestPath
+open QuikGraph.Algorithms.Observers
+
+module SSSP =
+    let runUndirected (matrix: int [,]) (graph: AdjacencyGraph<int, Edge<int>>) source =
+        let weight =
+            fun (e: Edge<int>) -> float matrix.[e.Source, e.Target]
+
+        let dijkstra =
+            DijkstraShortestPathAlgorithm<int, Edge<int>>(graph, weight)
+
+        // Attach a distance observer to give us the shortest path distances
+        let distObserver =
+            VertexDistanceRecorderObserver<int, Edge<int>>(weight)
+
+        distObserver.Attach(dijkstra) |> ignore
+
+        // Attach a Vertex Predecessor Recorder Observer to give us the paths
+        let predecessorObserver =
+            VertexPredecessorRecorderObserver<int, Edge<int>>()
+
+        predecessorObserver.Attach(dijkstra) |> ignore
+
+        // Run the algorithm with A set to be the source
+        dijkstra.Compute(source)
+
+        let res: array<float option> =
+            Array.zeroCreate (Array2D.length1 matrix)
+
+        for kvp in distObserver.Distances do
+            res.[kvp.Key] <- Some kvp.Value
+
+        res.[source] <- Some 0.0
+        res

tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj

@@ -1,4 +1,4 @@
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="utf-8"?>
 <Project Sdk="Microsoft.NET.Sdk">
     <PropertyGroup>
         <OutputType>Exe</OutputType>
@@ -15,8 +15,10 @@
         <Compile Include="Helpers.fs" />
         <Compile Include="Backend/QuickGraph/Algorithms/BFS.fs" />
         <Compile Include="Backend/QuickGraph/Algorithms/ConnectedComponents.fs" />
+        <Compile Include="Backend/QuickGraph/Algorithms/SSSP.fs" />
         <Compile Include="Backend/QuickGraph/CreateGraph.fs" />
         <Compile Include="Backend/Algorithms/BFS.fs" />
+        <Compile Include="Backend/Algorithms/SSSP.fs" />
         <Compile Include="Backend/Common/ClArray/Blit.fs" />
         <Compile Include="Backend/Common/ClArray/Choose.fs" />
         <Compile Include="Backend/Common/ClArray/ChunkBySize.fs" />

tests/GraphBLAS-sharp.Tests/Program.fs

@@ -87,7 +87,10 @@ let vectorTests =
     |> testSequenced
 
 let algorithmsTests =
-    testList "Algorithms tests" [ Algorithms.BFS.tests ]
+    testList
+        "Algorithms tests"
+        [ Algorithms.BFS.tests
+          Algorithms.SSSP.tests ]
     |> testSequenced
 
 let deviceTests =