diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index 4de3d64..bc76cf2 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -13,7 +13,7 @@ - + diff --git a/QuadTree.Tests/Tests.Boruvka.fs b/QuadTree.Tests/Tests.MST.fs similarity index 80% rename from QuadTree.Tests/Tests.Boruvka.fs rename to QuadTree.Tests/Tests.MST.fs index 6f2e2a0..258fc46 100644 --- a/QuadTree.Tests/Tests.Boruvka.fs +++ b/QuadTree.Tests/Tests.MST.fs @@ -1,11 +1,7 @@ module Graph.Boruvka.Tests -open System open Xunit - open Matrix -open Vector -open Common let checkResult name actual expected = match actual with @@ -20,11 +16,11 @@ let checkResult name actual expected = | _ -> None) Assert.Equal(expected, actual) - | x -> Assert.Fail(sprintf "Boruvka failed: %A" x) + | x -> Assert.Fail(sprintf "MST failed: %A" x) -[] -let ``Boruvka MST 2 nodes.`` () = +// ============== Shared test data ============== +let private ``test 2 nodes`` () = let graph = let clist = Matrix.CoordinateList( @@ -35,22 +31,9 @@ let ``Boruvka MST 2 nodes.`` () = Matrix.fromCoordinateList clist - let expected = - let clist = - Matrix.CoordinateList( - 2UL, - 2UL, - [ 0UL, 1UL, 5UL; 1UL, 0UL, 5UL ] - ) - - Matrix.fromCoordinateList clist |> Ok - - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST 3 nodes line.`` () = + graph, Ok graph +let private ``test 3 nodes line`` () = let graph = let clist = Matrix.CoordinateList( @@ -64,26 +47,9 @@ let ``Boruvka MST 3 nodes line.`` () = Matrix.fromCoordinateList clist - let expected = - let clist = - Matrix.CoordinateList( - 3UL, - 3UL, - [ 0UL, 1UL, 1UL - 1UL, 0UL, 1UL - 1UL, 2UL, 2UL - 2UL, 1UL, 2UL ] - ) - - Matrix.fromCoordinateList clist |> Ok - - checkResult (Graph.Boruvka.mst graph) expected - - - -[] -let ``Boruvka MST 4 nodes line.`` () = + graph, Ok graph +let private ``test 4 nodes line`` () = let graph = let clist = Matrix.CoordinateList( @@ -99,27 +65,9 @@ let ``Boruvka MST 4 nodes line.`` () = Matrix.fromCoordinateList clist - let expected = - let clist = - Matrix.CoordinateList( - 4UL, - 4UL, - [ 0UL, 1UL, 1UL - 1UL, 0UL, 1UL - 1UL, 2UL, 2UL - 2UL, 1UL, 2UL - 2UL, 3UL, 3UL - 3UL, 2UL, 3UL ] - ) - - Matrix.fromCoordinateList clist |> Ok - - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST 5 nodes line.`` () = + graph, Ok graph +let private ``test 5 nodes line`` () = let graph = let clist = Matrix.CoordinateList( @@ -137,29 +85,9 @@ let ``Boruvka MST 5 nodes line.`` () = Matrix.fromCoordinateList clist - let expected = - let clist = - Matrix.CoordinateList( - 5UL, - 5UL, - [ 0UL, 1UL, 1UL - 1UL, 0UL, 1UL - 1UL, 2UL, 2UL - 2UL, 1UL, 2UL - 2UL, 3UL, 3UL - 3UL, 2UL, 3UL - 3UL, 4UL, 4UL - 4UL, 3UL, 4UL ] - ) - - Matrix.fromCoordinateList clist |> Ok - - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST 5 nodes star.`` () = + graph, Ok graph +let private ``test 5 nodes star`` () = let graph = let clist = Matrix.CoordinateList( @@ -177,29 +105,9 @@ let ``Boruvka MST 5 nodes star.`` () = Matrix.fromCoordinateList clist - let expected = - let clist = - Matrix.CoordinateList( - 5UL, - 5UL, - [ 0UL, 1UL, 5UL - 1UL, 0UL, 5UL - 0UL, 2UL, 4UL - 2UL, 0UL, 4UL - 0UL, 3UL, 3UL - 3UL, 0UL, 3UL - 0UL, 4UL, 2UL - 4UL, 0UL, 2UL ] - ) - - Matrix.fromCoordinateList clist |> Ok - - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST 5 nodes complete.`` () = + graph, Ok graph +let private ``test 5 nodes complete`` () = let graph = let clist = Matrix.CoordinateList( @@ -246,12 +154,9 @@ let ``Boruvka MST 5 nodes complete.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST two components.`` () = + graph, expected +let private ``test two components`` () = let graph = let clist = Matrix.CoordinateList( @@ -293,12 +198,9 @@ let ``Boruvka MST two components.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST cycle graph 6 nodes.`` () = + graph, expected +let private ``test cycle graph 6 nodes`` () = let graph = let clist = Matrix.CoordinateList( @@ -339,11 +241,9 @@ let ``Boruvka MST cycle graph 6 nodes.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - -[] -let ``Boruvka MST complete bipartite K3,3.`` () = + graph, expected +let private ``test complete bipartite K3,3`` () = let graph = let clist = Matrix.CoordinateList( @@ -400,11 +300,9 @@ let ``Boruvka MST complete bipartite K3,3.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - -[] -let ``Boruvka MST random weights.`` () = + graph, expected +let private ``test random weights`` () = let graph = let clist = Matrix.CoordinateList( @@ -466,11 +364,9 @@ let ``Boruvka MST random weights.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - -[] -let ``Boruvka MST 8 nodes grid.`` () = + graph, expected +let private ``test 8 nodes grid`` () = let graph = let clist = Matrix.CoordinateList( @@ -527,11 +423,9 @@ let ``Boruvka MST 8 nodes grid.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - -[] -let ``Boruvka MST 10 nodes random.`` () = + graph, expected +let private ``test 10 nodes random`` () = let graph = let clist = Matrix.CoordinateList( @@ -567,47 +461,9 @@ let ``Boruvka MST 10 nodes random.`` () = Matrix.fromCoordinateList clist - let expected = - let clist = - Matrix.CoordinateList( - 10UL, - 10UL, - [ 0UL, 1UL, 4UL - 1UL, 0UL, 4UL - 0UL, 5UL, 2UL - 5UL, 0UL, 2UL - 1UL, 2UL, 3UL - 2UL, 1UL, 3UL - 1UL, 6UL, 5UL - 6UL, 1UL, 5UL - 2UL, 3UL, 1UL - 3UL, 2UL, 1UL - 2UL, 7UL, 4UL - 7UL, 2UL, 4UL - 3UL, 4UL, 2UL - 4UL, 3UL, 2UL - 3UL, 8UL, 6UL - 8UL, 3UL, 6UL - 4UL, 9UL, 3UL - 9UL, 4UL, 3UL - 5UL, 6UL, 1UL - 6UL, 5UL, 1UL - 6UL, 7UL, 2UL - 7UL, 6UL, 2UL - 7UL, 8UL, 1UL - 8UL, 7UL, 1UL - 8UL, 9UL, 4UL - 9UL, 8UL, 4UL ] - ) - - Matrix.fromCoordinateList clist |> Ok - - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST simple triangle.`` () = + graph, Ok graph +let private ``test simple triangle`` () = let graph = let clist = Matrix.CoordinateList( @@ -620,14 +476,11 @@ let ``Boruvka MST simple triangle.`` () = 2UL, 0UL, 1UL 1UL, 2UL, 1UL - 2UL, 1UL, 1UL - - ] + 2UL, 1UL, 1UL ] ) Matrix.fromCoordinateList clist - let expected = let clist = Matrix.CoordinateList( @@ -642,12 +495,9 @@ let ``Boruvka MST simple triangle.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST simple square.`` () = + graph, expected +let private ``test simple square`` () = let graph = let clist = Matrix.CoordinateList( @@ -663,14 +513,11 @@ let ``Boruvka MST simple square.`` () = 3UL, 2UL, 1UL 0UL, 3UL, 1UL - 3UL, 0UL, 1UL - - ] + 3UL, 0UL, 1UL ] ) Matrix.fromCoordinateList clist - let expected = let clist = Matrix.CoordinateList( @@ -688,14 +535,9 @@ let ``Boruvka MST simple square.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - - - - -[] -let ``Boruvka MST simple square in two steps.`` () = + graph, expected +let private ``test simple square in two steps`` () = let graph = let clist = Matrix.CoordinateList( @@ -711,14 +553,11 @@ let ``Boruvka MST simple square in two steps.`` () = 3UL, 2UL, 2UL 0UL, 3UL, 1UL - 3UL, 0UL, 1UL - - ] + 3UL, 0UL, 1UL ] ) Matrix.fromCoordinateList clist - let expected = let clist = Matrix.CoordinateList( @@ -736,14 +575,9 @@ let ``Boruvka MST simple square in two steps.`` () = Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - - - - -[] -let ``Boruvka MST.`` () = + graph, expected +let private ``test 7 nodes`` () = let graph = let clist = Matrix.CoordinateList( @@ -785,7 +619,6 @@ let ``Boruvka MST.`` () = Matrix.fromCoordinateList clist - let expected = let clist = Matrix.CoordinateList( @@ -807,19 +640,14 @@ let ``Boruvka MST.`` () = 5UL, 4UL, 6UL 6UL, 3UL, 8UL - 3UL, 6UL, 8UL - - ] + 3UL, 6UL, 8UL ] ) Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST big.`` () = + graph, expected +let private ``test big`` () = let graph = let clist = Matrix.CoordinateList( @@ -877,14 +705,11 @@ let ``Boruvka MST big.`` () = 11UL, 10UL, 3UL 5UL, 4UL, 3UL - 4UL, 5UL, 3UL - - ] + 4UL, 5UL, 3UL ] ) Matrix.fromCoordinateList clist - let expected = let clist = Matrix.CoordinateList( @@ -921,19 +746,14 @@ let ``Boruvka MST big.`` () = 10UL, 5UL, 2UL 4UL, 5UL, 3UL - 5UL, 4UL, 3UL - - ] + 5UL, 4UL, 3UL ] ) Matrix.fromCoordinateList clist |> Ok - checkResult (Graph.Boruvka.mst graph) expected - - -[] -let ``Boruvka MST complex line.`` () = + graph, expected +let private ``test complex line`` () = let graph = let clist = Matrix.CoordinateList( @@ -964,16 +784,15 @@ let ``Boruvka MST complex line.`` () = 8UL, 7UL, 1UL 8UL, 9UL, 1UL - 9UL, 8UL, 1UL - - - ] + 9UL, 8UL, 1UL ] ) Matrix.fromCoordinateList clist + graph, Ok graph - let expected = +let private ``test complex line 2`` () = + let graph = let clist = Matrix.CoordinateList( 10UL, @@ -987,110 +806,237 @@ let ``Boruvka MST complex line.`` () = 2UL, 3UL, 1UL 3UL, 2UL, 1UL - 3UL, 4UL, 3UL - 4UL, 3UL, 3UL + 3UL, 9UL, 3UL + 9UL, 3UL, 3UL - 4UL, 5UL, 1UL - 5UL, 4UL, 1UL + 9UL, 8UL, 1UL + 8UL, 9UL, 1UL - 5UL, 6UL, 1UL - 6UL, 5UL, 1UL + 8UL, 7UL, 1UL + 7UL, 8UL, 1UL 6UL, 7UL, 2UL 7UL, 6UL, 2UL - 7UL, 8UL, 1UL - 8UL, 7UL, 1UL + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL - 8UL, 9UL, 1UL - 9UL, 8UL, 1UL + 5UL, 4UL, 1UL + 4UL, 5UL, 1UL ] + ) + Matrix.fromCoordinateList clist - ] - ) + graph, Ok graph - Matrix.fromCoordinateList clist |> Ok +// ============== Tests ============== + +[] +let ``Boruvka MST 2 nodes.`` () = + let graph, expected = ``test 2 nodes`` () checkResult (Graph.Boruvka.mst graph) expected +[] +let ``Maggs-Plotkin MST 2 nodes.`` () = + let graph, expected = ``test 2 nodes`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + [] -let ``Boruvka MST complex line 2.`` () = +let ``Boruvka MST 3 nodes line.`` () = + let graph, expected = ``test 3 nodes line`` () + checkResult (Graph.Boruvka.mst graph) expected - let graph = - let clist = - Matrix.CoordinateList( - 10UL, - 10UL, - [ 0UL, 1UL, 1UL - 1UL, 0UL, 1UL +[] +let ``Maggs-Plotkin MST 3 nodes line.`` () = + let graph, expected = ``test 3 nodes line`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - 1UL, 2UL, 2UL - 2UL, 1UL, 2UL - 2UL, 3UL, 1UL - 3UL, 2UL, 1UL +[] +let ``Boruvka MST 4 nodes line.`` () = + let graph, expected = ``test 4 nodes line`` () + checkResult (Graph.Boruvka.mst graph) expected - 3UL, 9UL, 3UL - 9UL, 3UL, 3UL +[] +let ``Maggs-Plotkin MST 4 nodes line.`` () = + let graph, expected = ``test 4 nodes line`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - 9UL, 8UL, 1UL - 8UL, 9UL, 1UL - 8UL, 7UL, 1UL - 7UL, 8UL, 1UL - 6UL, 7UL, 2UL - 7UL, 6UL, 2UL +[] +let ``Boruvka MST 5 nodes line.`` () = + let graph, expected = ``test 5 nodes line`` () + checkResult (Graph.Boruvka.mst graph) expected - 5UL, 6UL, 1UL - 6UL, 5UL, 1UL +[] +let ``Maggs-Plotkin MST 5 nodes line.`` () = + let graph, expected = ``test 5 nodes line`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - 5UL, 4UL, 1UL - 4UL, 5UL, 1UL +[] +let ``Boruvka MST 5 nodes star.`` () = + let graph, expected = ``test 5 nodes star`` () + checkResult (Graph.Boruvka.mst graph) expected - ] - ) +[] +let ``Maggs-Plotkin MST 5 nodes star.`` () = + let graph, expected = ``test 5 nodes star`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - Matrix.fromCoordinateList clist +[] +let ``Boruvka MST 5 nodes complete.`` () = + let graph, expected = ``test 5 nodes complete`` () + checkResult (Graph.Boruvka.mst graph) expected - let expected = - let clist = - Matrix.CoordinateList( - 10UL, - 10UL, - [ 0UL, 1UL, 1UL - 1UL, 0UL, 1UL +[] +let ``Maggs-Plotkin MST 5 nodes complete.`` () = + let graph, expected = ``test 5 nodes complete`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - 1UL, 2UL, 2UL - 2UL, 1UL, 2UL - 2UL, 3UL, 1UL - 3UL, 2UL, 1UL +[] +let ``Boruvka MST two components.`` () = + let graph, expected = ``test two components`` () + checkResult (Graph.Boruvka.mst graph) expected - 3UL, 9UL, 3UL - 9UL, 3UL, 3UL +[] +let ``Maggs-Plotkin MST two components.`` () = + let graph, expected = ``test two components`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - 9UL, 8UL, 1UL - 8UL, 9UL, 1UL - 8UL, 7UL, 1UL - 7UL, 8UL, 1UL +[] +let ``Boruvka MST cycle graph 6 nodes.`` () = + let graph, expected = ``test cycle graph 6 nodes`` () + checkResult (Graph.Boruvka.mst graph) expected - 6UL, 7UL, 2UL - 7UL, 6UL, 2UL +[] +let ``Maggs-Plotkin MST cycle graph 6 nodes.`` () = + let graph, expected = ``test cycle graph 6 nodes`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - 5UL, 6UL, 1UL - 6UL, 5UL, 1UL - 5UL, 4UL, 1UL - 4UL, 5UL, 1UL +[] +let ``Boruvka MST complete bipartite K3,3.`` () = + let graph, expected = ``test complete bipartite K3,3`` () + checkResult (Graph.Boruvka.mst graph) expected - ] - ) +[] +let ``Maggs-Plotkin MST complete bipartite K3,3.`` () = + let graph, expected = ``test complete bipartite K3,3`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected - Matrix.fromCoordinateList clist |> Ok +[] +let ``Boruvka MST random weights.`` () = + let graph, expected = ``test random weights`` () checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST random weights.`` () = + let graph, expected = ``test random weights`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST 8 nodes grid.`` () = + let graph, expected = ``test 8 nodes grid`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST 8 nodes grid.`` () = + let graph, expected = ``test 8 nodes grid`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST 10 nodes random.`` () = + let graph, expected = ``test 10 nodes random`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST 10 nodes random.`` () = + let graph, expected = ``test 10 nodes random`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST simple triangle.`` () = + let graph, expected = ``test simple triangle`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST simple triangle.`` () = + let graph, expected = ``test simple triangle`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST simple square.`` () = + let graph, expected = ``test simple square`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST simple square.`` () = + let graph, expected = ``test simple square`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST simple square in two steps.`` () = + let graph, expected = ``test simple square in two steps`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST simple square in two steps.`` () = + let graph, expected = ``test simple square in two steps`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST.`` () = + let graph, expected = ``test 7 nodes`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST.`` () = + let graph, expected = ``test 7 nodes`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST big.`` () = + let graph, expected = ``test big`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST big.`` () = + let graph, expected = ``test big`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST complex line.`` () = + let graph, expected = ``test complex line`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST complex line.`` () = + let graph, expected = ``test complex line`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected + + +[] +let ``Boruvka MST complex line 2.`` () = + let graph, expected = ``test complex line 2`` () + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Maggs-Plotkin MST complex line 2.`` () = + let graph, expected = ``test complex line 2`` () + checkResult (Graph.Maggs_Plotkin_MST.mst graph) expected diff --git a/QuadTree/Maggs_Plotkin_MST.fs b/QuadTree/Maggs_Plotkin_MST.fs new file mode 100644 index 0000000..ce5bef3 --- /dev/null +++ b/QuadTree/Maggs_Plotkin_MST.fs @@ -0,0 +1,70 @@ +module Graph.Maggs_Plotkin_MST + +open Common +open Result +open Matrix + + +type Error = + | DiagAdditionProblem of Matrix.Error + | MSTComputationProblem of Matrix.Error + | ClosureComputationProblem of LinearAlgebra.Error + +let mst (graph: Matrix.SparseMatrix<'a>) = + + let diag = + let zero = Unchecked.defaultof<'a> + + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + graph.nrows, + graph.ncols, + [ for i in 0UL .. uint64 graph.nrows -> (i * 1UL, i * 1UL, zero) ] + ) + ) + + let _max x y = + match (x, y) with + | Some x, Some y -> max x y |> Some + | _ -> None + + let _min x y = + match (x, y) with + | Some x, Some y -> min x y |> Some + | Some x, None + | None, Some x -> Some x + | _ -> None + + resultM { + let! graph = + Matrix.map2 graph diag (fun x y -> + match y with + | None -> x + | _ -> y) + |> Result.mapError DiagAdditionProblem + + let! closure = + let rec compute (matrix: SparseMatrix<_>) = + let nnz = matrix.nvals + + resultM { + + let! step = LinearAlgebra.mxm _min _max matrix matrix + + if nnz = step.nvals && matrix.storage = step.storage then + return step + else + return! compute step + } + + compute graph |> Result.mapError ClosureComputationProblem + + let! mst = + Matrix.map2i graph closure (fun i j x y -> + if uint64 i = uint64 j then None + elif x = y then x + else None) + |> Result.mapError MSTComputationProblem + + return mst + } diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 438678c..abfc6ec 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -14,6 +14,7 @@ +