Skip to content

Commit

Permalink
Fix merge
Browse files Browse the repository at this point in the history
  • Loading branch information
kirillgarbar committed Dec 10, 2023
1 parent ebdb250 commit 6f3819b
Show file tree
Hide file tree
Showing 13 changed files with 164 additions and 27 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -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>
2 changes: 1 addition & 1 deletion benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
5 changes: 5 additions & 0 deletions src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs
Original file line number Diff line number Diff line change
Expand Up @@ -19,3 +19,8 @@ module Algorithms =

module SSSP =
let run = SSSP.run

module PageRank =
let run = PageRank.run

let prepareMatrix = PageRank.prepareMatrix
2 changes: 1 addition & 1 deletion src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
4 changes: 1 addition & 3 deletions src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,4 @@ module SSSP =
front1.Dispose queue
front2.Dispose queue

match distance with
| ClVector.Dense dist -> dist
| _ -> failwith "not implemented"
distance
1 change: 1 addition & 0 deletions src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand Down
13 changes: 13 additions & 0 deletions src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 @>
33 changes: 17 additions & 16 deletions src/GraphBLAS-sharp.Backend/Vector/Vector.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
4 changes: 2 additions & 2 deletions tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
118 changes: 118 additions & 0 deletions tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs
Original file line number Diff line number Diff line change
@@ -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
3 changes: 1 addition & 2 deletions tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs
Original file line number Diff line number Diff line change
Expand Up @@ -45,8 +45,7 @@ let testFixtures (testContext: TestContext) =

let matrix = matrixHost.ToDevice context

let resDense =
ssspDense queue matrix source |> ClVector.Dense
let resDense = ssspDense queue matrix source

let resHost = resDense.ToHost queue

Expand Down
1 change: 1 addition & 0 deletions tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@
<Compile Include="Backend/Algorithms/BFS.fs" />
<Compile Include="Backend/Algorithms/SSSP.fs" />
<Compile Include="Backend/Algorithms/MSBFS.fs" />
<Compile Include="Backend/Algorithms/PageRank.fs" />
<Compile Include="Backend/Common/ClArray/Blit.fs" />
<Compile Include="Backend/Common/ClArray/Choose.fs" />
<Compile Include="Backend/Common/ClArray/ChunkBySize.fs" />
Expand Down
2 changes: 1 addition & 1 deletion tests/GraphBLAS-sharp.Tests/Program.fs
Original file line number Diff line number Diff line change
Expand Up @@ -94,7 +94,7 @@ let algorithmsTests =
"Algorithms tests"
[ Algorithms.BFS.tests
Algorithms.SSSP.tests
Algorithms.PageRank.tests ]
Algorithms.PageRank.tests
Algorithms.MSBFS.levelsTests
Algorithms.MSBFS.parentsTests ]
|> testSequenced
Expand Down

0 comments on commit 6f3819b

Please sign in to comment.