diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index 96f4102..4de3d64 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -13,6 +13,7 @@ + diff --git a/QuadTree.Tests/Tests.BFS.fs b/QuadTree.Tests/Tests.BFS.fs index 6c40600..df5d0f3 100644 --- a/QuadTree.Tests/Tests.BFS.fs +++ b/QuadTree.Tests/Tests.BFS.fs @@ -64,7 +64,7 @@ let ``Simple level bfs.`` () = ) let store = Vector.Storage(4UL, tree) - Result.Success(SparseVector(4UL, 4UL, store)) + Ok(SparseVector(4UL, 4UL, store)) let actual = Graph.BFS.bfs_level graph startVertices diff --git a/QuadTree.Tests/Tests.Boruvka.fs b/QuadTree.Tests/Tests.Boruvka.fs new file mode 100644 index 0000000..6f2e2a0 --- /dev/null +++ b/QuadTree.Tests/Tests.Boruvka.fs @@ -0,0 +1,1096 @@ +module Graph.Boruvka.Tests + +open System +open Xunit + +open Matrix +open Vector +open Common + +let checkResult name actual expected = + match actual with + | Ok tree -> + let tree_transposed = Matrix.transpose tree + + let actual = + Matrix.map2 tree tree_transposed (fun x y -> + match (x, y) with + | (Some(x), _) + | (_, Some x) -> Some x + | _ -> None) + + Assert.Equal(expected, actual) + | x -> Assert.Fail(sprintf "Boruvka failed: %A" x) + +[] +let ``Boruvka MST 2 nodes.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 2UL, + 2UL, + [ 0UL, 1UL, 5UL; 1UL, 0UL, 5UL ] + ) + + 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.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 3UL, + 3UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL ] + ) + + 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.`` () = + + let graph = + 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 + + 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.`` () = + + let graph = + 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 + + 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.`` () = + + let graph = + 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 + + 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.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 5UL, + 5UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 0UL, 2UL, 2UL + 2UL, 0UL, 2UL + 0UL, 3UL, 3UL + 3UL, 0UL, 3UL + 0UL, 4UL, 4UL + 4UL, 0UL, 4UL + 1UL, 2UL, 5UL + 2UL, 1UL, 5UL + 1UL, 3UL, 6UL + 3UL, 1UL, 6UL + 1UL, 4UL, 7UL + 4UL, 1UL, 7UL + 2UL, 3UL, 8UL + 3UL, 2UL, 8UL + 2UL, 4UL, 9UL + 4UL, 2UL, 9UL + 3UL, 4UL, 10UL + 4UL, 3UL, 10UL ] + ) + + Matrix.fromCoordinateList clist + + let expected = + let clist = + Matrix.CoordinateList( + 5UL, + 5UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 0UL, 2UL, 2UL + 2UL, 0UL, 2UL + 0UL, 3UL, 3UL + 3UL, 0UL, 3UL + 0UL, 4UL, 4UL + 4UL, 0UL, 4UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + +[] +let ``Boruvka MST two components.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 6UL, + 6UL, + [ + // Component 1: vertices 0,1,2 + 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + 0UL, 2UL, 3UL + 2UL, 0UL, 3UL + // Component 2: vertices 3,4,5 + 3UL, 4UL, 1UL + 4UL, 3UL, 1UL + 4UL, 5UL, 2UL + 5UL, 4UL, 2UL + 3UL, 5UL, 3UL + 5UL, 3UL, 3UL ] + ) + + Matrix.fromCoordinateList clist + + let expected = + let clist = + Matrix.CoordinateList( + 6UL, + 6UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + 3UL, 4UL, 1UL + 4UL, 3UL, 1UL + 4UL, 5UL, 2UL + 5UL, 4UL, 2UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + +[] +let ``Boruvka MST cycle graph 6 nodes.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 6UL, + 6UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + 2UL, 3UL, 3UL + 3UL, 2UL, 3UL + 3UL, 4UL, 4UL + 4UL, 3UL, 4UL + 4UL, 5UL, 5UL + 5UL, 4UL, 5UL + 5UL, 0UL, 6UL + 0UL, 5UL, 6UL ] + ) + + Matrix.fromCoordinateList clist + + let expected = + let clist = + Matrix.CoordinateList( + 6UL, + 6UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + 2UL, 3UL, 3UL + 3UL, 2UL, 3UL + 3UL, 4UL, 4UL + 4UL, 3UL, 4UL + 4UL, 5UL, 5UL + 5UL, 4UL, 5UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Boruvka MST complete bipartite K3,3.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 6UL, + 6UL, + [ + // K3,3: vertices 0,1,2 connected to 3,4,5 + 0UL, 3UL, 1UL + 3UL, 0UL, 1UL + + 0UL, 4UL, 2UL + 4UL, 0UL, 2UL + + 0UL, 5UL, 3UL + 5UL, 0UL, 3UL + + 1UL, 3UL, 4UL + 3UL, 1UL, 4UL + + 1UL, 4UL, 5UL + 4UL, 1UL, 5UL + + 1UL, 5UL, 6UL + 5UL, 1UL, 6UL + + 2UL, 3UL, 7UL + 3UL, 2UL, 7UL + + 2UL, 4UL, 8UL + 4UL, 2UL, 8UL + + 2UL, 5UL, 9UL + 5UL, 2UL, 9UL ] + ) + + Matrix.fromCoordinateList clist + + let expected = + let clist = + Matrix.CoordinateList( + 6UL, + 6UL, + [ 0UL, 3UL, 1UL + 3UL, 0UL, 1UL + 1UL, 3UL, 4UL + 3UL, 1UL, 4UL + 2UL, 3UL, 7UL + 3UL, 2UL, 7UL + 0UL, 4UL, 2UL + 4UL, 0UL, 2UL + 0UL, 5UL, 3UL + 5UL, 0UL, 3UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Boruvka MST random weights.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 8UL, + 8UL, + [ 0UL, 1UL, 7UL + 1UL, 0UL, 7UL + 0UL, 2UL, 5UL + 2UL, 0UL, 5UL + 0UL, 3UL, 9UL + 3UL, 0UL, 9UL + 1UL, 2UL, 3UL + 2UL, 1UL, 3UL + 1UL, 3UL, 4UL + 3UL, 1UL, 4UL + 2UL, 3UL, 2UL + 3UL, 2UL, 2UL + 4UL, 5UL, 1UL + 5UL, 4UL, 1UL + 4UL, 6UL, 6UL + 6UL, 4UL, 6UL + 4UL, 7UL, 8UL + 7UL, 4UL, 8UL + 5UL, 6UL, 3UL + 6UL, 5UL, 3UL + 5UL, 7UL, 5UL + 7UL, 5UL, 5UL + 6UL, 7UL, 2UL + 7UL, 6UL, 2UL + // Connect two components + 3UL, 4UL, 10UL + 4UL, 3UL, 10UL ] + ) + + Matrix.fromCoordinateList clist + + let expected = + let clist = + Matrix.CoordinateList( + 8UL, + 8UL, + [ 0UL, 2UL, 5UL + 2UL, 0UL, 5UL + 1UL, 2UL, 3UL + 2UL, 1UL, 3UL + 2UL, 3UL, 2UL + 3UL, 2UL, 2UL + 1UL, 3UL, 4UL + 3UL, 1UL, 4UL + 4UL, 5UL, 1UL + 5UL, 4UL, 1UL + 5UL, 6UL, 3UL + 6UL, 5UL, 3UL + 6UL, 7UL, 2UL + 7UL, 6UL, 2UL + 3UL, 4UL, 10UL + 4UL, 3UL, 10UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Boruvka MST 8 nodes grid.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 8UL, + 8UL, + [ + // Row 0-1 connections + 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + // Row 2-3 connections + 0UL, 4UL, 3UL + 4UL, 0UL, 3UL + 1UL, 5UL, 4UL + 5UL, 1UL, 4UL + 2UL, 6UL, 5UL + 6UL, 2UL, 5UL + 3UL, 7UL, 6UL + 7UL, 3UL, 6UL + // Cross row connections + 4UL, 5UL, 2UL + 5UL, 4UL, 2UL + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + 6UL, 7UL, 3UL + 7UL, 6UL, 3UL ] + ) + + Matrix.fromCoordinateList clist + + let expected = + let clist = + Matrix.CoordinateList( + 8UL, + 8UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + 4UL, 5UL, 2UL + 5UL, 4UL, 2UL + 0UL, 4UL, 3UL + 4UL, 0UL, 3UL + 6UL, 7UL, 3UL + 7UL, 6UL, 3UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + +[] +let ``Boruvka MST 10 nodes random.`` () = + + let graph = + 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 + + 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.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 3UL, + 3UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 0UL, 2UL, 1UL + 2UL, 0UL, 1UL + + 1UL, 2UL, 1UL + 2UL, 1UL, 1UL + + ] + ) + + Matrix.fromCoordinateList clist + + + let expected = + let clist = + Matrix.CoordinateList( + 3UL, + 3UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 0UL, 2UL, 1UL + 2UL, 0UL, 1UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + +[] +let ``Boruvka MST simple square.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 4UL, + 4UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 1UL, 2UL, 1UL + 2UL, 1UL, 1UL + + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + + 0UL, 3UL, 1UL + 3UL, 0UL, 1UL + + ] + ) + + Matrix.fromCoordinateList clist + + + let expected = + let clist = + Matrix.CoordinateList( + 4UL, + 4UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 0UL, 3UL, 1UL + 3UL, 0UL, 1UL + + 1UL, 2UL, 1UL + 2UL, 1UL, 1UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + + + +[] +let ``Boruvka MST simple square in two steps.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 4UL, + 4UL, + [ 0UL, 1UL, 2UL + 1UL, 0UL, 2UL + + 1UL, 2UL, 1UL + 2UL, 1UL, 1UL + + 2UL, 3UL, 2UL + 3UL, 2UL, 2UL + + 0UL, 3UL, 1UL + 3UL, 0UL, 1UL + + ] + ) + + Matrix.fromCoordinateList clist + + + let expected = + let clist = + Matrix.CoordinateList( + 4UL, + 4UL, + [ 0UL, 1UL, 2UL + 1UL, 0UL, 2UL + + 0UL, 3UL, 1UL + 3UL, 0UL, 1UL + + 1UL, 2UL, 1UL + 2UL, 1UL, 1UL ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + + + +[] +let ``Boruvka MST.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 7UL, + 7UL, + [ 0UL, 1UL, 7UL + 1UL, 0UL, 7UL + + 0UL, 4UL, 4UL + 4UL, 0UL, 4UL + + 1UL, 2UL, 11UL + 2UL, 1UL, 11UL + + 1UL, 3UL, 10UL + 3UL, 1UL, 10UL + + 1UL, 4UL, 9UL + 4UL, 1UL, 9UL + + 2UL, 3UL, 5UL + 3UL, 2UL, 5UL + + 4UL, 3UL, 15UL + 3UL, 4UL, 15UL + + 4UL, 5UL, 6UL + 5UL, 4UL, 6UL + + 5UL, 3UL, 12UL + 3UL, 5UL, 12UL + + 6UL, 3UL, 8UL + 3UL, 6UL, 8UL + + 5UL, 6UL, 13UL + 6UL, 5UL, 13UL ] + ) + + Matrix.fromCoordinateList clist + + + let expected = + let clist = + Matrix.CoordinateList( + 7UL, + 7UL, + [ 0UL, 1UL, 7UL + 1UL, 0UL, 7UL + + 0UL, 4UL, 4UL + 4UL, 0UL, 4UL + + 1UL, 3UL, 10UL + 3UL, 1UL, 10UL + + 2UL, 3UL, 5UL + 3UL, 2UL, 5UL + + 4UL, 5UL, 6UL + 5UL, 4UL, 6UL + + 6UL, 3UL, 8UL + 3UL, 6UL, 8UL + + ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + +[] +let ``Boruvka MST big.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 12UL, + 12UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 1UL, 11UL, 1UL + 11UL, 1UL, 1UL + + 0UL, 11UL, 1UL + 11UL, 0UL, 1UL + //================================================= + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + + 3UL, 4UL, 1UL + 4UL, 3UL, 1UL + + 2UL, 4UL, 1UL + 4UL, 2UL, 1UL + //================================================= + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + + 6UL, 7UL, 1UL + 7UL, 6UL, 1UL + + 5UL, 7UL, 1UL + 7UL, 5UL, 1UL + //================================================= + 8UL, 9UL, 1UL + 9UL, 8UL, 1UL + + 9UL, 10UL, 1UL + 10UL, 9UL, 1UL + + 8UL, 10UL, 1UL + 10UL, 8UL, 1UL + //================================================ + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + + 11UL, 4UL, 2UL + 4UL, 11UL, 2UL + + 10UL, 5UL, 2UL + 5UL, 10UL, 2UL + + 8UL, 7UL, 2UL + 7UL, 8UL, 2UL + //================================================ + 10UL, 11UL, 3UL + 11UL, 10UL, 3UL + + 5UL, 4UL, 3UL + 4UL, 5UL, 3UL + + ] + ) + + Matrix.fromCoordinateList clist + + + let expected = + let clist = + Matrix.CoordinateList( + 12UL, + 12UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 0UL, 11UL, 1UL + 11UL, 0UL, 1UL + + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + + 2UL, 4UL, 1UL + 4UL, 2UL, 1UL + + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + + 5UL, 7UL, 1UL + 7UL, 5UL, 1UL + + 8UL, 9UL, 1UL + 9UL, 8UL, 1UL + + 8UL, 10UL, 1UL + 10UL, 8UL, 1UL + + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + + 5UL, 10UL, 2UL + 10UL, 5UL, 2UL + + 4UL, 5UL, 3UL + 5UL, 4UL, 3UL + + ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + +[] +let ``Boruvka MST complex line.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 10UL, + 10UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + + 3UL, 4UL, 3UL + 4UL, 3UL, 3UL + + 4UL, 5UL, 1UL + 5UL, 4UL, 1UL + + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + + 6UL, 7UL, 2UL + 7UL, 6UL, 2UL + + 7UL, 8UL, 1UL + 8UL, 7UL, 1UL + + 8UL, 9UL, 1UL + 9UL, 8UL, 1UL + + + ] + ) + + Matrix.fromCoordinateList clist + + + let expected = + let clist = + Matrix.CoordinateList( + 10UL, + 10UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + + 3UL, 4UL, 3UL + 4UL, 3UL, 3UL + + 4UL, 5UL, 1UL + 5UL, 4UL, 1UL + + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + + 6UL, 7UL, 2UL + 7UL, 6UL, 2UL + + 7UL, 8UL, 1UL + 8UL, 7UL, 1UL + + 8UL, 9UL, 1UL + 9UL, 8UL, 1UL + + + ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected + + +[] +let ``Boruvka MST complex line 2.`` () = + + let graph = + let clist = + Matrix.CoordinateList( + 10UL, + 10UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + + 3UL, 9UL, 3UL + 9UL, 3UL, 3UL + + 9UL, 8UL, 1UL + 8UL, 9UL, 1UL + + 8UL, 7UL, 1UL + 7UL, 8UL, 1UL + + 6UL, 7UL, 2UL + 7UL, 6UL, 2UL + + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + + 5UL, 4UL, 1UL + 4UL, 5UL, 1UL + + + ] + ) + + Matrix.fromCoordinateList clist + + + let expected = + let clist = + Matrix.CoordinateList( + 10UL, + 10UL, + [ 0UL, 1UL, 1UL + 1UL, 0UL, 1UL + + 1UL, 2UL, 2UL + 2UL, 1UL, 2UL + + 2UL, 3UL, 1UL + 3UL, 2UL, 1UL + + 3UL, 9UL, 3UL + 9UL, 3UL, 3UL + + 9UL, 8UL, 1UL + 8UL, 9UL, 1UL + + 8UL, 7UL, 1UL + 7UL, 8UL, 1UL + + 6UL, 7UL, 2UL + 7UL, 6UL, 2UL + + 5UL, 6UL, 1UL + 6UL, 5UL, 1UL + + 5UL, 4UL, 1UL + 4UL, 5UL, 1UL + + ] + ) + + Matrix.fromCoordinateList clist |> Ok + + checkResult (Graph.Boruvka.mst graph) expected diff --git a/QuadTree.Tests/Tests.LinearAlgebra.fs b/QuadTree.Tests/Tests.LinearAlgebra.fs index 8e3dd45..3bde7b3 100644 --- a/QuadTree.Tests/Tests.LinearAlgebra.fs +++ b/QuadTree.Tests/Tests.LinearAlgebra.fs @@ -30,6 +30,17 @@ let op_mult x y = | Some(a), Some(b) -> Some(a * b) | _ -> None + +let op_add_i x y = + match (x, y) with + | Some(a), Some(b) -> Some(min a b) + | Some(a), _ + | _, Some(a) -> Some(a) + | _ -> None + +let op_mult_i (i, x) (row, col, y) = Some(i, row, col) + + let leaf_v v = qtree.Leaf << UserValue <| Some v let leaf_n () = qtree.Leaf << UserValue <| None let leaf_d () = qtree.Leaf Dummy @@ -64,7 +75,7 @@ let ``Simple vxm. All sizes are power of two.`` () = let tree = Vector.btree.Node(vleaf_v 6, Vector.btree.Node(vleaf_v 14, vleaf_v 10)) let store = Vector.Storage(4UL, tree) - Result.Success(SparseVector(4UL, 4UL, store)) + Ok(SparseVector(4UL, 4UL, store)) let actual = LinearAlgebra.vxm op_add op_mult v m @@ -104,7 +115,7 @@ let ``Simple vxm. 3 * (3x4)`` () = let tree = Vector.btree.Node(vleaf_v 6, Vector.btree.Node(vleaf_v 8, vleaf_v 10)) let store = Vector.Storage(4UL, tree) - Result.Success(SparseVector(4UL, 4UL, store)) + Ok(SparseVector(4UL, 4UL, store)) let actual = LinearAlgebra.vxm op_add op_mult v m @@ -146,7 +157,7 @@ let ``Simple vxm. 4 * (4x3).`` () = let tree = Vector.btree.Node(vleaf_v 6, Vector.btree.Node(vleaf_v 14, vleaf_d ())) let store = Vector.Storage(4UL, tree) - Result.Success(SparseVector(3UL, 3UL, store)) + Ok(SparseVector(3UL, 3UL, store)) let actual = LinearAlgebra.vxm op_add op_mult v m @@ -205,12 +216,136 @@ let ``Simple vxm. 3 * (3x5)`` () = ) let store = Vector.Storage(8UL, tree) - Result.Success(SparseVector(5UL, 5UL, store)) + Ok(SparseVector(5UL, 5UL, store)) let actual = LinearAlgebra.vxm op_add op_mult v m Assert.Equal(expected, actual) +(* +2,2,2,D +* +N,1,1,N,N,D,D,D +3,2,2,3,1,D,D,D +N,N,1,2,N,D,D,D +D,D,D,D,D,D,D,D +D,D,D,D,D,D,D,D +D,D,D,D,D,D,D,D +D,D,D,D,D,D,D,D +D,D,D,D,D,D,D,D += +// 6,6,8,10,2,D,D,D +(1,1,0),(0,0,1),(0,0,2),(1,1,3),(1,1,4) +*) +[] +let ``Simple vxmi_values. 3 * (3x5)`` () = + let m = + let tree = + Matrix.qtree.Node( + Matrix.qtree.Node( + Matrix.qtree.Node(leaf_n (), leaf_v 1, leaf_v 3, leaf_v 2), + Matrix.qtree.Node(leaf_v 1, leaf_n (), leaf_v 2, leaf_v 3), + Matrix.qtree.Node(leaf_n (), leaf_n (), leaf_d (), leaf_d ()), + Matrix.qtree.Node(leaf_v 1, leaf_v 2, leaf_d (), leaf_d ()) + ), + Matrix.qtree.Node( + Matrix.qtree.Node(leaf_n (), leaf_d (), leaf_v 1, leaf_d ()), + leaf_d (), + Matrix.qtree.Node(leaf_n (), leaf_d (), leaf_d (), leaf_d ()), + leaf_d () + ), + leaf_d (), + leaf_d () + ) + + let store = Matrix.Storage(8UL, tree) + SparseMatrix(3UL, 5UL, 9UL, store) + + let v = + let tree = Vector.btree.Node(vleaf_v 2, Vector.btree.Node(vleaf_v 2, vleaf_d ())) + + let store = Vector.Storage(4UL, tree) + SparseVector(3UL, 3UL, store) + + let expected = + let tree = + Vector.btree.Node( + Vector.btree.Node( + Vector.btree.Node( + vleaf_v (1UL, 1UL, 0UL), + vleaf_v (0UL, 0UL, 1UL) + ), + Vector.btree.Node( + vleaf_v (0UL, 0UL, 2UL), + vleaf_v (1UL, 1UL, 3UL) + ) + ), + Vector.btree.Node( + Vector.btree.Node( + vleaf_v (1UL, 1UL, 4UL), + vleaf_d () + ), + vleaf_d () + ) + ) + + let store = Vector.Storage(8UL, tree) + Ok(SparseVector(5UL, 5UL, store)) + + let actual = LinearAlgebra.vxmi_values op_add_i op_mult_i v m + + Assert.Equal(expected, actual) + + +(* +2,2,2,2 +* +N,1,1,D +3,2,2,D +N,N,1,D +N,N,3,D += +6,6,14,D +*) +[] +let ``Simple vxmi_values. 4 * (4x3).`` () = + let m = + let tree = + Matrix.qtree.Node( + Matrix.qtree.Node(leaf_n (), leaf_v 1, leaf_v 3, leaf_v 2), + Matrix.qtree.Node(leaf_v 1, leaf_d (), leaf_v 2, leaf_d ()), + leaf_n (), + Matrix.qtree.Node(leaf_v 1, leaf_d (), leaf_v 3, leaf_d ()) + ) + + let store = Matrix.Storage(4UL, tree) + SparseMatrix(4UL, 3UL, 7UL, store) + + let v = + let tree = vleaf_v 2 + + let store = Vector.Storage(4UL, tree) + SparseVector(4UL, 4UL, store) + + + let expected = + let tree = + Vector.btree.Node( + Vector.btree.Node( + vleaf_v (1UL, 1UL, 0UL), + vleaf_v (0UL, 0UL, 1UL) + ), + Vector.btree.Node(vleaf_v (0UL, 0UL, 2UL), vleaf_d ()) + ) + + let store = Vector.Storage(4UL, tree) + Ok(SparseVector(3UL, 3UL, store)) + + let actual = LinearAlgebra.vxmi_values op_add_i op_mult_i v m + + Assert.Equal(expected, actual) + + [] let ``Simple mxm`` () = // 222D @@ -243,7 +378,7 @@ let ``Simple mxm`` () = let actual = match LinearAlgebra.mxm op_add op_mult m1 m2 with - | Result.Success m -> m + | Ok m -> m | _ -> failwith "Unreachable" Assert.Equal(expected.storage.data, actual.storage.data) @@ -279,8 +414,8 @@ let ``Sparse mxm`` () = let actual = match LinearAlgebra.mxm op_add op_mult m1 m2 with - | Result.Success m -> m - | Result.Failure e -> failwith (e.ToString()) + | Ok m -> m + | Error e -> failwith (e.ToString()) Assert.Equal(expected, actual) @@ -325,8 +460,8 @@ let ``Shrinking mxm`` () = let actual = match LinearAlgebra.mxm op_add op_mult m1 m2 with - | Result.Success m -> m - | Result.Failure e -> failwith (e.ToString()) + | Ok m -> m + | Error e -> failwith (e.ToString()) Assert.Equal(expected, actual) @@ -374,7 +509,7 @@ let ``Expanding mxm`` () = let actual = match LinearAlgebra.mxm op_add op_mult m1 m2 with - | Result.Success m -> m - | Result.Failure e -> failwith (e.ToString()) + | Ok m -> m + | Error e -> failwith (e.ToString()) Assert.Equal(expected, actual) diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index a7f4553..816b4a2 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -15,6 +15,16 @@ let printMatrix (matrix: SparseMatrix<_>) = printfn " size: %A" matrix.storage.size printfn " Data: %A" matrix.storage.data +let printMatrixCoordinate (matrix: SparseMatrix<_>) = + printfn "Matrix:" + printfn " Rows: %A" matrix.nrows + printfn " Columns: %A" matrix.ncols + printfn " Nvals: %A" matrix.nvals + printfn " Storage:" + printfn " size: %A" matrix.storage.size + printfn " Data: %A" (Matrix.toCoordinateList matrix).list + + let leaf_v v = qtree.Leaf << UserValue <| Some v let leaf_n () = qtree.Leaf << UserValue <| None let leaf_d () = qtree.Leaf Dummy @@ -81,7 +91,7 @@ let ``Simple Matrix.map2. Square where number of cols and rows are power of two. ) let store = Storage(4UL, tree) - Result.Success(SparseMatrix(4UL, 4UL, 6UL, store)) + Ok(SparseMatrix(4UL, 4UL, 6UL, store)) let actual = Matrix.map2 m1 m2 f @@ -144,12 +154,229 @@ let ``Simple Matrix.map2. Square where number of cols and rows are not power of ) let store = Storage(4UL, tree) - Result.Success(SparseMatrix(3UL, 3UL, 5UL, store)) + Ok(SparseMatrix(3UL, 3UL, 5UL, store)) let actual = Matrix.map2 m1 m2 f Assert.Equal(expected, actual) +[] +let ``Simple Matrix.map2i. Square where number of cols and rows are power of two.`` () = + let m1 = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + let m2 = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 10) + (0UL, 1UL, 20) + (1UL, 0UL, 30) + (1UL, 1UL, 40) ] + ) + ) + + let f row col x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b + int row + int col) + | _ -> None + + let expected = + Matrix.CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 11) + (0UL, 1UL, 23) + (1UL, 0UL, 34) + (1UL, 1UL, 46) ] + ) + |> Matrix.fromCoordinateList + |> Ok + + let actual = Matrix.map2i m1 m2 f + + Assert.Equal(expected, actual) + +[] +let ``Simple Matrix.map2i. Square where number of cols and rows are not power of two.`` () = + let m1 = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + let m2 = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 10) + (0UL, 1UL, 10) + (0UL, 2UL, 10) + (1UL, 0UL, 10) + (1UL, 1UL, 10) + (1UL, 2UL, 10) ] + ) + ) + + let f row col x y = + match (x, y) with + | Some(a), Some(b) -> Some(a * (int row + 1) + b * (int col + 1)) + | _ -> None + + let actual = Matrix.map2i m1 m2 f + + let expected = + Matrix.CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 11) + (0UL, 1UL, 22) + (0UL, 2UL, 33) + (1UL, 0UL, 18) + (1UL, 1UL, 30) + (1UL, 2UL, 42) ] + ) + |> Matrix.fromCoordinateList + |> Ok + + Assert.Equal(expected, actual) + +[] +let ``Simple Matrix.map2i. Mixed values.`` () = + let m1 = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1); (2UL, 2UL, 3) ] + ) + ) + + let m2 = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 4UL, + 4UL, + [ (1UL, 1UL, 10); (3UL, 3UL, 30) ] + ) + ) + + let f row col x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b) + | Some(a), None -> Some(int col + a * 2) + | None, Some(b) -> Some(int row + b * 3) + | _ -> None + + let actual = Matrix.map2i m1 m2 f + + let expected = + Matrix.CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 2) + (1UL, 1UL, 31) + (2UL, 2UL, 8) + (3UL, 3UL, 93) ] + ) + |> Matrix.fromCoordinateList + |> Ok + + Assert.Equal(expected, actual) + +[] +let ``Simple Matrix.mapi. Square where number of cols and rows are power of two.`` () = + let m = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + let f row col x = + match x with + | Some(a) -> Some(a + int row + int col) + | _ -> None + + let actual = Matrix.mapi m f + let actualCL = Matrix.toCoordinateList actual + + Assert.Equal(4UL, actual.nvals) + +[] +let ``Simple Matrix.mapi. Square where number of cols and rows are not power of two.`` () = + let m = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + let f row col x = + match x with + | Some(a) -> Some(a * (int row + 1) * (int col + 1)) + | _ -> None + + let actual = Matrix.mapi m f + let actualCL = Matrix.toCoordinateList actual + + Assert.Equal(6UL, actual.nvals) + +[] +let ``Simple Matrix.mapi. Multiply row index by value.`` () = + let m = + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (1UL, 1UL, 2) + (2UL, 2UL, 3) + (3UL, 3UL, 4) ] + ) + ) + + let f row col x = + match x with + | Some(a) -> Some(a * int row) + | _ -> None + + let actual = Matrix.mapi m f + let actualCL = Matrix.toCoordinateList actual + + Assert.Equal(4UL, actual.nvals) + [] let ``Conversion identity`` () = let id = toCoordinateList << fromCoordinateList @@ -211,7 +438,7 @@ let ``Simple addition`` () = let result = match map2 m1 m2 addition with - | Result.Success x -> x + | Ok x -> x | _ -> failwith "Unreachable" toCoordinateList result diff --git a/QuadTree.Tests/Tests.SSSP.fs b/QuadTree.Tests/Tests.SSSP.fs index 1f62db8..ff28383 100644 --- a/QuadTree.Tests/Tests.SSSP.fs +++ b/QuadTree.Tests/Tests.SSSP.fs @@ -54,7 +54,7 @@ let ``Simple SSSP.`` () = ) let store = Vector.Storage(4UL, tree) - Result.Success(SparseVector(4UL, 4UL, store)) + Ok(SparseVector(4UL, 4UL, store)) let actual = Graph.SSSP.sssp graph 0UL @@ -97,7 +97,7 @@ let ``SSSP with recalculation`` () = (4UL, 5.0) ] ) - Result.Success(Vector.fromCoordinateList clist) + Ok(Vector.fromCoordinateList clist) let actual = Graph.SSSP.sssp graph 0UL diff --git a/QuadTree.Tests/Tests.TriangleCount.fs b/QuadTree.Tests/Tests.TriangleCount.fs index 1a59982..1b95cae 100644 --- a/QuadTree.Tests/Tests.TriangleCount.fs +++ b/QuadTree.Tests/Tests.TriangleCount.fs @@ -54,7 +54,7 @@ let ``7V Triangle count`` () = let actual = match triangle_count g with - | Result.Success(Some x) -> x + | Ok(Some x) -> x | _ -> failwith "Unreachable" Assert.Equal(expected, actual) @@ -88,7 +88,7 @@ let ``5V Triangle count`` () = let actual = match triangle_count g with - | Result.Success(Some x) -> x + | Ok(Some x) -> x | _ -> failwith "Unreachable" Assert.Equal(expected, actual) diff --git a/QuadTree.Tests/Tests.Vector.fs b/QuadTree.Tests/Tests.Vector.fs index ad1a525..c74216a 100644 --- a/QuadTree.Tests/Tests.Vector.fs +++ b/QuadTree.Tests/Tests.Vector.fs @@ -77,6 +77,127 @@ let ``Simple Vector.map. Length is not power of two.`` () = Assert.Equal(expected, actual) +[] +let ``Simple Vector.mapi. Length is power of two, multiply by index.`` () = + let v = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 1) + (2UL, 1) + (3UL, 1) + (4UL, 2) + (5UL, 2) + (6UL, 2) + (7UL, 2) ] + ) + ) + + let f (idx: uint64) x = + match x with + | Some(a) -> Some(a * int idx) + | _ -> None + + let expected = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 8UL, + [ (0UL, 0) + (1UL, 1) + (2UL, 2) + (3UL, 3) + (4UL, 8) + (5UL, 10) + (6UL, 12) + (7UL, 14) ] + ) + ) + + let actual = Vector.mapi v f + + Assert.Equal(expected, actual) + +[] +let ``Simple Vector.mapi. Length is not power of two.`` () = + // Build vector [1, 1, 1, 1, 1, 1] with dummy at end + let v = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 1) + (2UL, 1) + (3UL, 1) + (4UL, 1) + (5UL, 1) ] + ) + ) + + // f idx x = x * idx + let f (idx: uint64) x = + match x with + | Some(a) -> Some(a * int idx) + | _ -> None + + // Expected: [0, 1, 2, 3, 4, 5] (1*idx for each position) + let expected = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 6UL, + [ (0UL, 0) + (1UL, 1) + (2UL, 2) + (3UL, 3) + (4UL, 4) + (5UL, 5) ] + ) + ) + + let actual = Vector.mapi v f + + Assert.Equal(expected, actual) + +[] +let ``Simple Vector.mapi. Uniform leaf expansion.`` () = + // Vector of length 1 with value 5 + let v = + let tree = Vector.btree.Leaf(UserValue(Some(5))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + // f idx x = x + idx (5 + 0 = 5) + let f (idx: uint64) x = + match x with + | Some(a) -> Some(a + int idx) + | _ -> None + + let expected = + let tree = Vector.btree.Leaf(UserValue(Some(5))) + let store = Storage(1UL, tree) + SparseVector(1UL, 1UL, store) + + let actual = Vector.mapi v f + + Assert.Equal(expected, actual) + +[] +let ``Simple Vector.mapi. All indices identity.`` () = + // Vector with values matching their indices + let v = + Vector.fromCoordinateList (Vector.CoordinateList(4UL, [ (0UL, 0); (2UL, 2) ])) + + let f (idx: uint64) x = + match x with + | Some(a) when a = int idx -> Some a + | _ -> None + + let actual = Vector.mapi v f + let outputCL = Vector.toCoordinateList actual + + Assert.Equal(2UL, actual.nvals) + Assert.Equal * int>>([ (0UL, 0); (2UL, 2) ], outputCL.data) + [] let ``Simple Vector.map2. Length is power of two.`` () = @@ -113,7 +234,7 @@ let ``Simple Vector.map2. Length is power of two.`` () = ) let store = Storage(8UL, tree) - Result.Success(SparseVector(8UL, 4UL, store)) + Ok(SparseVector(8UL, 4UL, store)) let actual = Vector.map2 v1 v2 f @@ -154,12 +275,126 @@ let ``Simple Vector.map2. Length is not power of two.`` () = ) let store = Storage(8UL, tree) - Result.Success(SparseVector(6UL, 2UL, store)) + Ok(SparseVector(6UL, 2UL, store)) let actual = Vector.map2 v1 v2 f Assert.Equal(expected, actual) +[] +let ``Simple Vector.map2i. Length is power of two.`` () = + let v1 = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 4UL, + [ (0UL, 1); (1UL, 2); (2UL, 3); (3UL, 4) ] + ) + ) + + let v2 = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 4UL, + [ (0UL, 10); (1UL, 20); (2UL, 30); (3UL, 40) ] + ) + ) + + let f idx x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b + int idx) + | _ -> None + + let expected = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 4UL, + [ (0UL, 11); (1UL, 23); (2UL, 35); (3UL, 47) ] + ) + ) + |> Ok + + let actual = Vector.map2i v1 v2 f + + Assert.Equal(expected, actual) + +[] +let ``Simple Vector.map2i. Length is not power of two.`` () = + let v1 = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + let v2 = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 6UL, + [ (0UL, 10) + (1UL, 10) + (2UL, 10) + (3UL, 10) + (4UL, 10) + (5UL, 10) ] + ) + ) + + let f idx x y = + match (x, y) with + | Some(a), Some(b) -> Some(a * int idx + b) + | _ -> None + + let expected = + Vector.fromCoordinateList ( + Vector.CoordinateList( + 6UL, + [ (0UL, 10) + (1UL, 12) + (2UL, 16) + (3UL, 22) + (4UL, 30) + (5UL, 40) ] + ) + ) + |> Ok + + let actual = Vector.map2i v1 v2 f + + Assert.Equal(expected, actual) + +[] +let ``Simple Vector.map2i. Mixed values.`` () = + let v1 = + Vector.fromCoordinateList (Vector.CoordinateList(4UL, [ (0UL, 1); (2UL, 3) ])) + + let v2 = + Vector.fromCoordinateList (Vector.CoordinateList(4UL, [ (1UL, 10); (3UL, 30) ])) + + let f idx x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b) + | Some(a), None -> Some(int idx + a * 2) + | None, Some(b) -> Some(int idx * b * 3) + | _ -> None + + let actual = Vector.map2i v1 v2 f + + let expected = + Vector.CoordinateList( + 4UL, + [ (0UL, 2); (1UL, 30); (2UL, 8); (3UL, 270) ] + ) + |> Vector.fromCoordinateList + |> Ok + + Assert.Equal(expected, actual) + [] let ``Conversion identity`` () = let id = toCoordinateList << fromCoordinateList @@ -202,7 +437,7 @@ let ``Simple addition`` () = let result = match map2 v1 v2 addition with - | Result.Success x -> x + | Ok x -> x | _ -> failwith "Unreachable" toCoordinateList result @@ -227,3 +462,137 @@ let ``Condensation of empty`` () = SparseVector(clist.length, 0UL, Storage(16UL, tree)) Assert.Equal(expected, actual) + + +[] +let ``Gather`` () = + let data = + Vector.CoordinateList(5UL, [ (0UL, 0.0); (1UL, 1.0); (4UL, 5.0) ]) + |> Vector.fromCoordinateList + + let indices = + Vector.CoordinateList( + 5UL, + [ (0UL, 1UL); (1UL, 4UL); (3UL, 1UL) ] + ) + |> Vector.fromCoordinateList + + let actual = Vector.gather data indices + + let expected = + Vector.CoordinateList(5UL, [ (0UL, 1.0); (1UL, 5.0); (3UL, 1.0) ]) + |> Vector.fromCoordinateList + + Assert.Equal(expected, actual) + +[] +let ``Scatter`` () = + let data = + Vector.CoordinateList(5UL, [ (0UL, 4.0); (2UL, 5.0) ]) + |> Vector.fromCoordinateList + + let indices = + Vector.CoordinateList(5UL, [ (0UL, 3UL); (2UL, 3UL) ]) + |> Vector.fromCoordinateList + + let result = + Vector.CoordinateList(5UL, [ (3UL, 1.0); (4UL, 3.0) ]) + |> Vector.fromCoordinateList + + let actual = + Vector.scatter result data indices (fun x y -> + match (x, y) with + | Some x, Some y -> Some(x + y) + | Some x, _ + | _, Some x -> Some x + | _ -> None) + + let expected = + Vector.CoordinateList(5UL, [ (3UL, 10.0); (4UL, 3.0) ]) + |> Vector.fromCoordinateList + |> Result.Ok + + Assert.Equal(expected, actual) + +let compare x y = + match (x, y) with + | Some x, None -> -1 + | Some x, Some y -> + if x < y then -1 + elif x > y then 1 + else 0 + | None, Some x -> 1 + | _ -> 0 + +[] +let ``Sort one element vector`` () = + let data = + Vector.CoordinateList(1UL, [ (0UL, 0.0) ]) + |> Vector.fromCoordinateList + + let actual = Vector.mergeSort data compare + Assert.Equal(data, actual) + +[] +let ``Sort vector of two equal elements`` () = + let data = + Vector.CoordinateList(2UL, [ (0UL, 0.0); (1UL, 0.0) ]) + |> Vector.fromCoordinateList + + let actual = Vector.mergeSort data compare + Assert.Equal(data, actual) + +[] +let ``Sort vector of three equal elements`` () = + let data = + Vector.CoordinateList(3UL, [ (0UL, 2.0); (1UL, 2.0); (2UL, 2.0) ]) + |> Vector.fromCoordinateList + + let actual = Vector.mergeSort data compare + Assert.Equal(data, actual) + + +[] +let ``Sort vector of three different unordered elements`` () = + let data = + Vector.CoordinateList(3UL, [ (0UL, 2.0); (1UL, 1.0); (2UL, 4.0) ]) + |> Vector.fromCoordinateList + + let expected = + Vector.CoordinateList(3UL, [ (0UL, 1.0); (1UL, 2.0); (2UL, 4.0) ]) + |> Vector.fromCoordinateList + + let actual = Vector.mergeSort data compare + Assert.Equal(expected, actual) + + + +[] +let ``Sort long vector with one element`` () = + let data = + Vector.CoordinateList(5UL, [ (0UL, 0.0) ]) + |> Vector.fromCoordinateList + + let actual = Vector.mergeSort data compare + Assert.Equal(data, actual) + + + +[] +let ``Sort sorted vector`` () = + let data = + Vector.CoordinateList(5UL, [ (0UL, 0.0); (1UL, 0.0) ]) + |> Vector.fromCoordinateList + + let actual = Vector.mergeSort data compare + Assert.Equal(data, actual) + + +[] +let ``Init vector`` () = + let expected = + Vector.CoordinateList(3UL, [ (0UL, 0); (1UL, 1); (2UL, 2) ]) + |> Vector.fromCoordinateList + + let actual = Vector.init 3UL (fun i -> Some(int i)) + Assert.Equal(expected, actual) diff --git a/QuadTree/BFS.fs b/QuadTree/BFS.fs index b2ffc3c..0ba2fc5 100644 --- a/QuadTree/BFS.fs +++ b/QuadTree/BFS.fs @@ -1,48 +1,48 @@ module Graph.BFS open Common +open Result -type Error<'t1, 't2> = - | NewFrontierCalculationProblem of LinearAlgebra.Error<'t1, 't2, 't1> - | FrontierCalculationProblem of Vector.Error<'t1, 't1> - | VisitedCalculationProblem of Vector.Error<'t1, 't1> +type Error = + | NewFrontierCalculationProblem of LinearAlgebra.Error + | FrontierCalculationProblem of Vector.Error + | VisitedCalculationProblem of Vector.Error let bfs_level graph startVertices = let rec inner level (frontier: Vector.SparseVector<_>) (visited: Vector.SparseVector<_>) = if frontier.nvals > 0UL then - let op_add x y = - match (x, y) with - | Some(v), _ - | _, Some(v) -> Some(v) - | _ -> None - - let op_mult x y = - match (x, y) with - | Some(v), Some(_) -> Some(v) - | _ -> None - - let new_frontier = LinearAlgebra.vxm op_add op_mult frontier graph - - match new_frontier with - | Result.Failure(e) -> Result.Failure(NewFrontierCalculationProblem(e)) - | Result.Success(new_frontier) -> - let frontier = Vector.mask new_frontier visited (fun x -> x.IsNone) - - match frontier with - | Result.Failure(e) -> Result.Failure(FrontierCalculationProblem(e)) - | Result.Success(frontier) -> - let op_add x y = + resultM { + let! new_frontier = + LinearAlgebra.vxm + (fun x y -> + match (x, y) with + | Some(v), _ + | _, Some(v) -> Some(v) + | _ -> None) + (fun x y -> + match (x, y) with + | Some(v), Some(_) -> Some(v) + | _ -> None) + frontier + graph + |> Result.mapError NewFrontierCalculationProblem + + let! frontier = + Vector.mask new_frontier visited (fun x -> x.IsNone) + |> Result.mapError FrontierCalculationProblem + + let! visited = + Vector.map2 visited new_frontier (fun x y -> match (x, y) with - | (Some(_), _) -> x - | (None, Some(_)) -> Some(level) - | _ -> None - - let visited = Vector.map2 visited new_frontier op_add + | Some(_), _ -> x + | None, Some(_) -> Some(level) + | _ -> None) + |> Result.mapError VisitedCalculationProblem - match visited with - | Result.Failure(e) -> Result.Failure(VisitedCalculationProblem(e)) - | Result.Success(visited) -> inner (level + 1UL) frontier visited + return! inner (level + 1UL) frontier visited + } else - Result.Success visited + Ok visited - inner 1UL startVertices (Vector.map startVertices (Option.map (fun x -> 0UL))) + let initialVisited = Vector.map startVertices (Option.map (fun x -> 0UL)) + inner 1UL startVertices initialVisited diff --git a/QuadTree/Boruvka.fs b/QuadTree/Boruvka.fs new file mode 100644 index 0000000..c0ed119 --- /dev/null +++ b/QuadTree/Boruvka.fs @@ -0,0 +1,167 @@ +module Graph.Boruvka + +open Common +open Result + + +type Error = + | EdgesCalculationProblem of LinearAlgebra.Error + | CEdgesCalculationProblem of Vector.Error + | IndexCalculationProblem of Vector.Error + | ScatterProblem of Vector.Error + | FoldValuesProblem of Vector.Error + | TreeSelectionProblem of Matrix.Error + | IndexInnerCalculationProblem of Vector.Error + | DataForUpgradeParentCalculationProblem of Vector.Error + +let mst (graph: Matrix.SparseMatrix<_>) = + + let op_mult (i, x) (row, col, w) = Some(w, row) + + let op_min x y = + match x, y with + | Some v, Some u -> Some(min v u) + | Some v, _ -> Some v + | None, Some v -> Some v + | _ -> None + + let fixPoint p = + let rec inner p iter = + let p2 = Vector.gather p p + if p2 = p then p else inner p2 (iter + 1) + + let res = inner p 0 + res + + let treeFilter edges index = + fun i j g -> + let i = uint64 i * 1UL + let j = uint64 j * 1UL + let edge = Vector.unsafeGet edges i + let idx = Vector.unsafeGet index i + + let result = + match edge, idx with + | Some(w, dst), Some idxVal -> g = w && idxVal = i && uint64 dst = uint64 j + | _ -> false + + result + + let graphFilter parent = + fun i j -> + let i = uint64 i * 1UL + let j = uint64 j * 1UL + let parent_i = Vector.unsafeGet parent i + let parent_j = Vector.unsafeGet parent j + + match parent_i, parent_j with + | Some v1, Some v2 when v1 <> v2 -> true + | _ -> false + + let length = uint64 graph.nrows * 1UL + + let parent = Vector.init length (fun i -> Some i) + + let rec inner (graph: Matrix.SparseMatrix<_>) (tree: Matrix.SparseMatrix<_>) parent iteration = + + if graph.nvals > 0UL then + + // Cheapest outgoing edge for each vertex + // For each vertex j, find the smallest weight edge (i, j, w) + // such that i and j are in different components. + // Because graph contains only cross‑component edges, + // we simply take the min over all neighbors. + resultM { + let! edges = + LinearAlgebra.vxmi_values op_min op_mult parent graph + |> Result.mapError EdgesCalculationProblem + + // Per‑component cheapest edge + // For each component, keep the smallest edges among its vertices. + let! cedges = + Vector.scatter (Vector.empty length) edges parent op_min + |> Result.mapError CEdgesCalculationProblem + + // Propagate component's cheapest edge to all its vertices + // Each vertex gets its component's edge + let t = Vector.gather cedges parent + + // Identify a representative vertex for each component + // For each vertex, if its own edge is the component's cheapest, mark it. + let! indexInner = + Vector.map2i t edges (fun i t e -> + match (t, e) with + | Some v1, Some v2 when v1 = v2 -> Some i + | _ -> None) + |> Result.mapError IndexInnerCalculationProblem + // Among the marked vertices in a component, keep the smallest index. + let! index = + Vector.scatter (Vector.empty length) indexInner parent op_min + |> Result.mapError IndexCalculationProblem + // now each vertex knows its component's representative + let index = Vector.gather index parent + + // Add selected edges to the MST tree + // An edge (i, j, w) is added if vertex i is the representative for its component + // and (i, j, w) is the cheapest edge of that component. + let treeFilter = treeFilter edges index + + let! tree = + Matrix.map2i tree graph (fun i j t g -> + match t, g with + | Some t, _ -> Some t + | None, Some g when treeFilter i j g -> Some g + | _ -> None) + |> Result.mapError TreeSelectionProblem + + // Compute new parent assignments (merge components) + // For each component representative i with cheapest edge (w, j), we want to merge + // the component of i with the component of j. Choose the smaller root. + let! data_for_update_parent = + Vector.map2i edges index (fun i e idx -> + match e, idx with + | Some(v, j), Some(_i) when _i = i -> + let j = uint64 j * 1UL + let parent_i = Vector.unsafeGet parent i + let parent_j = Vector.unsafeGet parent j + + match parent_i, parent_j with + | Some p_i, Some p_j -> if p_i < p_j then Some(j, p_i) else Some(i, p_j) + | x -> failwithf "Unreachable: %A" x + | _ -> None) + |> Result.mapError DataForUpgradeParentCalculationProblem + + // Apply the updates + let! initial_parent_update = + Vector.foldValues + data_for_update_parent + (fun state (i, v) -> + match state with + | Ok state -> + let updateResult = Vector.update state i (Some v) (fun _ _new -> _new) + + match updateResult with + | Ok u -> Ok u + | Error e -> Error e + | Error e -> Error e) + (Ok parent) + |> Result.mapError FoldValuesProblem + + let! parent = + Vector.scatter parent initial_parent_update parent op_min + |> Result.mapError ScatterProblem + + // Then ensure that all vertices in a merged component point to the same root. + // This is done by a fixpoint (path compression) that repeatedly gathers parents. + let parent = fixPoint parent + + // Filter the graph to keep only edges between different components + let graphFilter = graphFilter parent + let graph = Matrix.mapi graph (fun i j v -> if graphFilter i j then v else None) + + return! inner graph tree parent (iteration + 1) + } + else + Ok tree + + inner graph (Matrix.empty graph.nrows graph.ncols) parent 0 diff --git a/QuadTree/Common.fs b/QuadTree/Common.fs index 61a3572..0ce5854 100644 --- a/QuadTree/Common.fs +++ b/QuadTree/Common.fs @@ -10,7 +10,6 @@ type 'value treeValue = | Dummy | UserValue of 'value - type BinSearchTree<'value> = | Leaf of 'value | Node of BinSearchTree<'value> * 'value * BinSearchTree<'value> diff --git a/QuadTree/LinearAlgebra.fs b/QuadTree/LinearAlgebra.fs index 34eda4d..7405e02 100644 --- a/QuadTree/LinearAlgebra.fs +++ b/QuadTree/LinearAlgebra.fs @@ -2,10 +2,15 @@ module LinearAlgebra open Common -type Error<'value1, 'value2, 'value3> = - | InconsistentStructureOfStorages of Vector.btree> * Matrix.qtree> - | InconsistentSizeOfArguments of Vector.SparseVector<'value1> * Matrix.SparseMatrix<'value2> - | VectorAdditionProblem of Vector.Error<'value3, 'value3> +type MXMError = + | InconsistentSizeOfArguments + | MatrixAdditionProblem of Matrix.Error + +type Error = + | InconsistentStructureOfStorages + | InconsistentSizeOfArguments + | VectorAdditionProblem of Vector.Error + | MXMError of MXMError let rec multScalar op_add (x: uint64) y = @@ -24,10 +29,7 @@ let vxm op_add op_mult (vector: Vector.SparseVector<'a>) (matrix: Matrix.SparseM let new_size = size / 2UL match (inner new_size x1 y1), (inner new_size x1 y2), (inner new_size x2 y3), (inner new_size x2 y4) with - | Result.Success((t1, nvals1)), - Result.Success((t2, nvals2)), - Result.Success((t3, nvals3)), - Result.Success((t4, nvals4)) -> + | Ok((t1, nvals1)), Ok((t2, nvals2)), Ok((t3, nvals3)), Ok((t4, nvals4)) -> let data_length = (uint64 new_size) * 1UL let v1 = Vector.SparseVector(data_length, nvals1, (Vector.Storage(new_size, t1))) let v2 = Vector.SparseVector(data_length, nvals2, (Vector.Storage(new_size, t2))) @@ -36,22 +38,21 @@ let vxm op_add op_mult (vector: Vector.SparseVector<'a>) (matrix: Matrix.SparseM let vAdd v1 (v2: Vector.SparseVector<_>) = match v2.storage.data with - | Vector.Leaf(Dummy) -> Result.Success(v1) + | Vector.Leaf(Dummy) -> Ok(v1) | _ -> Vector.map2 v1 v2 op_add let z1 = vAdd v1 v3 let z2 = vAdd v2 v4 match (z1, z2) with - | Result.Success(v1), Result.Success(v2) -> - Result.Success((Vector.mkNode v1.storage.data v2.storage.data), v1.nvals + v2.nvals) - | Result.Failure(e), _ - | _, Result.Failure(e) -> Result.Failure(VectorAdditionProblem(e)) + | Ok(v1), Ok(v2) -> Ok((Vector.mkNode v1.storage.data v2.storage.data), v1.nvals + v2.nvals) + | Error(e), _ + | _, Error(e) -> Error(VectorAdditionProblem(e)) - | Result.Failure(e), _, _, _ - | _, Result.Failure(e), _, _ - | _, _, Result.Failure(e), _ - | _, _, _, Result.Failure(e) -> Result.Failure(e) + | Error(e), _, _, _ + | _, Error(e), _, _ + | _, _, Error(e), _ + | _, _, _, Error(e) -> Error(e) match (vector, matrix) with | Vector.btree.Leaf(UserValue(v1)), Matrix.qtree.Leaf(UserValue(v2)) -> @@ -62,15 +63,14 @@ let vxm op_add op_mult (vector: Vector.SparseVector<'a>) (matrix: Matrix.SparseM | None -> 0UL | _ -> (uint64 size) * 1UL - Result.Success(Vector.btree.Leaf(UserValue(res)), nnz) + Ok(Vector.btree.Leaf(UserValue(res)), nnz) | Vector.btree.Leaf(UserValue(_)), Matrix.qtree.Node(y1, y2, y3, y4) -> _do vector vector y1 y2 y3 y4 | Vector.btree.Node(x1, x2), Matrix.qtree.Leaf(UserValue(_)) -> _do x1 x2 matrix matrix matrix matrix | Vector.btree.Node(x1, x2), Matrix.qtree.Node(y1, y2, y3, y4) -> _do x1 x2 y1 y2 y3 y4 | Vector.btree.Leaf(Dummy), _ - | _, Matrix.qtree.Leaf(Dummy) -> Result.Success(Vector.btree.Leaf(Dummy), 0UL) - | (x, y) -> Result.Failure <| Error.InconsistentStructureOfStorages(x, y) + | _, Matrix.qtree.Leaf(Dummy) -> Ok(Vector.btree.Leaf(Dummy), 0UL) if uint64 vector.length = uint64 matrix.nrows then let vector_storage = @@ -90,21 +90,143 @@ let vxm op_add op_mult (vector: Vector.SparseVector<'a>) (matrix: Matrix.SparseM vector.storage match inner vector_storage.size vector_storage.data matrix.storage.data with - | Result.Failure x -> Result.Failure x - | Result.Success(storage, nvals) -> + | Error x -> Error x + | Ok(storage, nvals) -> (Vector.SparseVector( (uint64 matrix.ncols) * 1UL, nvals, (Vector.Storage(matrix.storage.size, storage)) )) - |> Result.Success + |> Ok else - (Error.InconsistentSizeOfArguments(vector, matrix)) |> Result.Failure + Error Error.InconsistentSizeOfArguments + +let vxmi_values + (op_add: 'c option -> 'c option -> 'c option) + (op_mult: uint64 * 'a -> uint64 * uint64 * 'b -> Option<'c>) + (vector: Vector.SparseVector<'a>) + (matrix: Matrix.SparseMatrix<'b>) + = + + let rec inner + (size: uint64) + vector + (vectorIdx: uint64) + matrix + (rowIdx: uint64) + (colIdx: uint64) + = + let _do x1 x2 y1 y2 y3 y4 = + let new_size = size / 2UL + match + (inner new_size x1 vectorIdx y1 rowIdx colIdx), + (inner new_size x1 vectorIdx y2 rowIdx (colIdx + (uint64 new_size) * 1UL)), + (inner + new_size + x2 + (vectorIdx + (uint64 new_size) * 1UL) + y3 + (rowIdx + (uint64 new_size) * 1UL) + colIdx), + (inner + new_size + x2 + (vectorIdx + (uint64 new_size) * 1UL) + y4 + (rowIdx + (uint64 new_size) * 1UL) + (colIdx + (uint64 new_size) * 1UL)) + with + | Ok((t1, nvals1)), Ok((t2, nvals2)), Ok((t3, nvals3)), Ok((t4, nvals4)) -> + let data_length = (uint64 new_size) * 1UL + let v1 = Vector.SparseVector(data_length, nvals1, (Vector.Storage(new_size, t1))) + let v2 = Vector.SparseVector(data_length, nvals2, (Vector.Storage(new_size, t2))) + let v3 = Vector.SparseVector(data_length, nvals3, (Vector.Storage(new_size, t3))) + let v4 = Vector.SparseVector(data_length, nvals4, (Vector.Storage(new_size, t4))) -type MXMError<'value1, 'value2, 'value3> = - | InconsistentSizeOfArguments of Matrix.SparseMatrix<'value1> * Matrix.SparseMatrix<'value2> - | MatrixAdditionProblem of Matrix.Error<'value3, 'value3> + let vAdd v1 (v2: Vector.SparseVector<_>) = + match v2.storage.data with + | Vector.Leaf(Dummy) -> Ok(v1) + | _ -> Vector.map2 v1 v2 op_add + + let z1 = vAdd v1 v3 + let z2 = vAdd v2 v4 + + match (z1, z2) with + | Ok(v1), Ok(v2) -> Ok((Vector.mkNode v1.storage.data v2.storage.data), v1.nvals + v2.nvals) + | Error(e), _ + | _, Error(e) -> Error(VectorAdditionProblem(e)) + + | Error(e), _, _, _ + | _, Error(e), _, _ + | _, _, Error(e), _ + | _, _, _, Error(e) -> Error(e) + + match (vector, matrix) with + | Vector.btree.Leaf(UserValue(Some(v1))), Matrix.qtree.Leaf(UserValue(Some(v2))) -> + if size = 1UL then + let res = op_mult (vectorIdx, v1) (rowIdx, colIdx, v2) + + let nnz = + match res with + | None -> 0UL + | _ -> 1UL + + Ok(Vector.btree.Leaf(UserValue(res)), nnz) + else + inner + size + (Vector.btree.Node(vector, vector)) + vectorIdx + (Matrix.qtree.Node(matrix, matrix, matrix, matrix)) + rowIdx + colIdx + + | Vector.btree.Leaf(UserValue(Some(_))), Matrix.qtree.Node(y1, y2, y3, y4) -> _do vector vector y1 y2 y3 y4 + | Vector.btree.Node(x1, x2), Matrix.qtree.Leaf(UserValue(Some(_))) -> _do x1 x2 matrix matrix matrix matrix + | Vector.btree.Node(x1, x2), Matrix.qtree.Node(y1, y2, y3, y4) -> _do x1 x2 y1 y2 y3 y4 + | Vector.btree.Leaf(UserValue(None)), _ + | _, Matrix.qtree.Leaf(UserValue(None)) -> Ok(Vector.btree.Leaf(UserValue(None)), 0UL) + + | Vector.btree.Leaf(Dummy), _ + | _, Matrix.qtree.Leaf(Dummy) -> Ok(Vector.btree.Leaf(Dummy), 0UL) + + if uint64 vector.length = uint64 matrix.nrows then + let vector_storage = + if uint64 vector.storage.size < uint64 matrix.storage.size then + let rec increaseStorage storage_data (current_size: uint64) bound = + if current_size = bound then + storage_data + else + increaseStorage + (Vector.btree.Node(storage_data, Vector.btree.Leaf(Dummy))) + (current_size * 2UL) + bound + + let target_size = matrix.storage.size + Vector.Storage(target_size, increaseStorage vector.storage.data vector.storage.size target_size) + else + vector.storage + + match + inner + vector_storage.size + vector_storage.data + 0UL + matrix.storage.data + 0UL + 0UL + with + | Error x -> Error x + | Ok(storage, nvals) -> + (Vector.SparseVector( + (uint64 matrix.ncols) * 1UL, + nvals, + (Vector.Storage(matrix.storage.size, storage)) + )) + |> Ok + else + Error Error.InconsistentSizeOfArguments let mxm @@ -143,14 +265,14 @@ let mxm (multiply halfSize se1 se2) match nw1_x_nw2, ne1_x_sw2, nw1_x_ne2, ne1_x_se2, sw1_x_nw2, se1_x_sw2, sw1_x_ne2, se1_x_se2 with - | Result.Success(tnw1_x_nw2, nvals_nw1_x_nw2), - Result.Success(tne1_x_sw2, nvals_ne1_x_sw2), - Result.Success(tnw1_x_ne2, nvals_nw1_x_ne2), - Result.Success(tne1_x_se2, nvals_ne1_x_se2), - Result.Success(tsw1_x_nw2, nvals_sw1_x_nw2), - Result.Success(tse1_x_sw2, nvals_se1_x_sw2), - Result.Success(tsw1_x_ne2, nvals_sw1_x_ne2), - Result.Success(tse1_x_se2, nvals_se1_x_se2) -> + | Ok(tnw1_x_nw2, nvals_nw1_x_nw2), + Ok(tne1_x_sw2, nvals_ne1_x_sw2), + Ok(tnw1_x_ne2, nvals_nw1_x_ne2), + Ok(tne1_x_se2, nvals_ne1_x_se2), + Ok(tsw1_x_nw2, nvals_sw1_x_nw2), + Ok(tse1_x_sw2, nvals_se1_x_sw2), + Ok(tsw1_x_ne2, nvals_sw1_x_ne2), + Ok(tse1_x_se2, nvals_se1_x_se2) -> let nrows = (uint64 halfSize) * 1UL let ncols = (uint64 halfSize) * 1UL let storageSize = halfSize @@ -181,7 +303,7 @@ let mxm let mAdd m1 (m2: Matrix.SparseMatrix<_>) = match m2.storage.data with - | Matrix.qtree.Leaf Dummy -> Result.Success m1 + | Matrix.qtree.Leaf Dummy -> Ok m1 | _ -> Matrix.map2 m1 m2 op_add let rnw = mAdd nw1_x_nw2 ne1_x_sw2 @@ -190,24 +312,24 @@ let mxm let rse = mAdd sw1_x_ne2 se1_x_se2 match rnw, rne, rsw, rse with - | Result.Success(nw), Result.Success(ne), Result.Success(sw), Result.Success(se) -> - Result.Success( + | Ok(nw), Ok(ne), Ok(sw), Ok(se) -> + Ok( Matrix.mkNode nw.storage.data ne.storage.data sw.storage.data se.storage.data, nw.nvals + ne.nvals + sw.nvals + se.nvals ) - | Result.Failure(e), _, _, _ - | _, Result.Failure(e), _, _ - | _, _, Result.Failure(e), _ - | _, _, _, Result.Failure(e) -> Result.Failure(MXMError.MatrixAdditionProblem(e)) - - | Result.Failure(e), _, _, _, _, _, _, _ - | _, Result.Failure(e), _, _, _, _, _, _ - | _, _, Result.Failure(e), _, _, _, _, _ - | _, _, _, Result.Failure(e), _, _, _, _ - | _, _, _, _, Result.Failure(e), _, _, _ - | _, _, _, _, _, Result.Failure(e), _, _ - | _, _, _, _, _, _, Result.Failure(e), _ - | _, _, _, _, _, _, _, Result.Failure(e) -> Result.Failure(e) + | Error(e), _, _, _ + | _, Error(e), _, _ + | _, _, Error(e), _ + | _, _, _, Error(e) -> Error(Error.MXMError(MXMError.MatrixAdditionProblem(e))) + + | Error(e), _, _, _, _, _, _, _ + | _, Error(e), _, _, _, _, _, _ + | _, _, Error(e), _, _, _, _, _ + | _, _, _, Error(e), _, _, _, _ + | _, _, _, _, Error(e), _, _, _ + | _, _, _, _, _, Error(e), _, _ + | _, _, _, _, _, _, Error(e), _ + | _, _, _, _, _, _, _, Error(e) -> Error(e) match m1, m2 with | Matrix.qtree.Leaf(UserValue v1), Matrix.qtree.Leaf(UserValue v2) -> @@ -218,7 +340,7 @@ let mxm | None -> 0UL | _ -> (uint64 <| size * size) * 1UL - Result.Success(Matrix.qtree.Leaf(UserValue res), nnz) + Ok(Matrix.qtree.Leaf(UserValue res), nnz) | Matrix.qtree.Leaf(UserValue(_)), Matrix.qtree.Node(nw2, ne2, sw2, se2) -> divided (m1, m1, m1, m1) (nw2, ne2, sw2, se2) | Matrix.qtree.Node(nw1, ne1, sw1, se1), Matrix.qtree.Leaf(UserValue(_)) -> @@ -226,7 +348,7 @@ let mxm | Matrix.qtree.Node(nw1, ne1, sw1, se1), Matrix.qtree.Node(nw2, ne2, sw2, se2) -> divided (nw1, ne1, sw1, se1) (nw2, ne2, sw2, se2) | Matrix.qtree.Leaf Dummy, _ - | _, Matrix.qtree.Leaf Dummy -> Result.Success(Matrix.qtree.Leaf Dummy, 0UL) + | _, Matrix.qtree.Leaf Dummy -> Ok(Matrix.qtree.Leaf Dummy, 0UL) if uint64 m1.ncols = uint64 m2.nrows then let nrows = m1.nrows @@ -242,11 +364,11 @@ let mxm m1.storage.data, m2.storage.data match multiply storageSize m1_tree m2_tree with - | Result.Success(tree, nvals) -> + | Ok(tree, nvals) -> // in case the resulting storageSize can be smaller // e.g. (2x3) * (3x2) matrices let tree, storageSize = shrink tree storageSize - Result.Success(Matrix.SparseMatrix(nrows, ncols, nvals, Matrix.Storage(storageSize, tree))) - | Result.Failure(e) -> Result.Failure(e) + Ok(Matrix.SparseMatrix(nrows, ncols, nvals, Matrix.Storage(storageSize, tree))) + | Error(e) -> Error(e) else - MXMError.InconsistentSizeOfArguments(m1, m2) |> Result.Failure + Error(Error.MXMError MXMError.InconsistentSizeOfArguments) diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index 7697762..68ea7d7 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -38,9 +38,9 @@ type SparseMatrix<'value> = nvals = _nvals storage = _storage } -type Error<'value1, 'value2> = - | InconsistentStructureOfStorages of qtree> * qtree> - | InconsistentSizeOfArguments of SparseMatrix<'value1> * SparseMatrix<'value2> +type Error = + | InconsistentStructureOfStorages + | InconsistentSizeOfArguments let mkNode x1 x2 x3 x4 = @@ -137,25 +137,24 @@ let toCoordinateList (matrix: SparseMatrix<'a>) = CoordinateList(nrows, ncols, coo) +let empty nrows ncols = + fromCoordinateList (CoordinateList(nrows, ncols, [])) + let map2 (matrix1: SparseMatrix<_>) (matrix2: SparseMatrix<_>) f = let rec inner (size: uint64) matrix1 matrix2 = let _do x1 x2 x3 x4 y1 y2 y3 y4 = let new_size = size / 2UL match (inner new_size x1 y1), (inner new_size x2 y2), (inner new_size x3 y3), (inner new_size x4 y4) with - | Result.Success((new_t1, nvals1)), - Result.Success((new_t2, nvals2)), - Result.Success((new_t3, nvals3)), - Result.Success((new_t4, nvals4)) -> - ((mkNode new_t1 new_t2 new_t3 new_t4), nvals1 + nvals2 + nvals3 + nvals4) - |> Result.Success - | Result.Failure(e), _, _, _ - | _, Result.Failure(e), _, _ - | _, _, Result.Failure(e), _ - | _, _, _, Result.Failure(e) -> Result.Failure(e) + | Ok((new_t1, nvals1)), Ok((new_t2, nvals2)), Ok((new_t3, nvals3)), Ok((new_t4, nvals4)) -> + ((mkNode new_t1 new_t2 new_t3 new_t4), nvals1 + nvals2 + nvals3 + nvals4) |> Ok + | Error(e), _, _, _ + | _, Error(e), _, _ + | _, _, Error(e), _ + | _, _, _, Error(e) -> Error(e) match (matrix1, matrix2) with - | Leaf(Dummy), Leaf(Dummy) -> Result.Success(Leaf(Dummy), 0UL) + | Leaf(Dummy), Leaf(Dummy) -> Ok(Leaf(Dummy), 0UL) | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> let res = f v1 v2 @@ -164,21 +163,137 @@ let map2 (matrix1: SparseMatrix<_>) (matrix2: SparseMatrix<_>) f = | None -> 0UL | _ -> (uint64 size) * (uint64 size) * 1UL - (Leaf(UserValue(res)), nnz) |> Result.Success + (Leaf(UserValue(res)), nnz) |> Ok | Node(x1, x2, x3, x4), Node(y1, y2, y3, y4) -> _do x1 x2 x3 x4 y1 y2 y3 y4 | Node(x1, x2, x3, x4), Leaf(v) -> _do x1 x2 x3 x4 matrix2 matrix2 matrix2 matrix2 | Leaf(v), Node(x1, x2, x3, x4) -> _do matrix1 matrix1 matrix1 matrix1 x1 x2 x3 x4 - | (x, y) -> Result.Failure <| Error.InconsistentStructureOfStorages(x, y) + | (x, y) -> Error Error.InconsistentStructureOfStorages if matrix1.nrows = matrix2.nrows && matrix1.ncols = matrix2.ncols then match inner matrix1.storage.size matrix1.storage.data matrix2.storage.data with - | Result.Failure x -> Result.Failure x - | Result.Success(storage, nvals) -> + | Error x -> Error x + | Ok(storage, nvals) -> (SparseMatrix(matrix1.nrows, matrix1.ncols, nvals, (Storage(matrix1.storage.size, storage)))) - |> Result.Success + |> Ok else - (Error.InconsistentSizeOfArguments(matrix1, matrix2)) |> Result.Failure + Error Error.InconsistentSizeOfArguments + +let map2i (matrix1: SparseMatrix<_>) (matrix2: SparseMatrix<_>) f = + let rec inner (prow: uint64) (pcol: uint64) (size: uint64) matrix1 matrix2 = + match (matrix1, matrix2) with + | Node(x1, x2, x3, x4), Node(y1, y2, y3, y4) -> + let halfSize = size / 2UL + + let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = + getQuadrantCoords (prow, pcol) (uint64 halfSize) + + let t1, nvals1 = inner nwR nwC halfSize x1 y1 + let t2, nvals2 = inner neR neC halfSize x2 y2 + let t3, nvals3 = inner swR swC halfSize x3 y3 + let t4, nvals4 = inner seR seC halfSize x4 y4 + (mkNode t1 t2 t3 t4), nvals1 + nvals2 + nvals3 + nvals4 + | Node(x1, x2, x3, x4), Leaf(v2) -> + let halfSize = size / 2UL + + let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = + getQuadrantCoords (prow, pcol) (uint64 halfSize) + + let t1, nvals1 = inner nwR nwC halfSize x1 (Leaf(v2)) + let t2, nvals2 = inner neR neC halfSize x2 (Leaf(v2)) + let t3, nvals3 = inner swR swC halfSize x3 (Leaf(v2)) + let t4, nvals4 = inner seR seC halfSize x4 (Leaf(v2)) + (mkNode t1 t2 t3 t4), nvals1 + nvals2 + nvals3 + nvals4 + | Leaf(v1), Node(y1, y2, y3, y4) -> + let halfSize = size / 2UL + + let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = + getQuadrantCoords (prow, pcol) (uint64 halfSize) + + let t1, nvals1 = inner nwR nwC halfSize (Leaf(v1)) y1 + let t2, nvals2 = inner neR neC halfSize (Leaf(v1)) y2 + let t3, nvals3 = inner swR swC halfSize (Leaf(v1)) y3 + let t4, nvals4 = inner seR seC halfSize (Leaf(v1)) y4 + (mkNode t1 t2 t3 t4), nvals1 + nvals2 + nvals3 + nvals4 + | Leaf(Dummy), Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> + let res = f prow pcol v1 v2 + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + | Leaf(UserValue(v)), Leaf(Dummy) -> + let res = f prow pcol v None + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + | Leaf(Dummy), Leaf(UserValue(v)) -> + let res = f prow pcol None v + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + + if matrix1.nrows = matrix2.nrows && matrix1.ncols = matrix2.ncols then + let storage, nvals = + inner 0UL 0UL matrix1.storage.size matrix1.storage.data matrix2.storage.data + + SparseMatrix(matrix1.nrows, matrix1.ncols, nvals, (Storage(matrix1.storage.size, storage))) + |> Ok + else + Error Error.InconsistentSizeOfArguments + +let mapi (matrix: SparseMatrix<'a>) f = + let rec inner (prow: uint64) (pcol: uint64) (size: uint64) matrix = + match matrix with + | Node(x1, x2, x3, x4) -> + let halfSize = size / 2UL + + let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = + getQuadrantCoords (prow, pcol) (uint64 halfSize) + + let t1, nvals1 = inner nwR nwC halfSize x1 + let t2, nvals2 = inner neR neC halfSize x2 + let t3, nvals3 = inner swR swC halfSize x3 + let t4, nvals4 = inner seR seC halfSize x4 + (mkNode t1 t2 t3 t4), nvals1 + nvals2 + nvals3 + nvals4 + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v)) -> + if size = 1UL then + let res = f prow pcol v + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + else + let halfSize = size / 2UL + + let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = + getQuadrantCoords (prow, pcol) (uint64 halfSize) + + let t1, nvals1 = inner nwR nwC halfSize (Leaf(UserValue(v))) + let t2, nvals2 = inner neR neC halfSize (Leaf(UserValue(v))) + let t3, nvals3 = inner swR swC halfSize (Leaf(UserValue(v))) + let t4, nvals4 = inner seR seC halfSize (Leaf(UserValue(v))) + (mkNode t1 t2 t3 t4), nvals1 + nvals2 + nvals3 + nvals4 + + let storage, nvals = + inner 0UL 0UL matrix.storage.size matrix.storage.data + + SparseMatrix(matrix.nrows, matrix.ncols, nvals, (Storage(matrix.storage.size, storage))) let foldAssociative (folder: 'T option -> 'T option -> 'T option) (state: 'T option) (matrix: SparseMatrix<'T>) = let rec traverse tree (size: uint64) (state: 'T option) = diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 2b2b699..438678c 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -13,6 +13,7 @@ + diff --git a/QuadTree/Result.fs b/QuadTree/Result.fs index c107bf6..09812d4 100644 --- a/QuadTree/Result.fs +++ b/QuadTree/Result.fs @@ -1,5 +1,45 @@ module Result -type Result<'success, 'failure> = - | Success of 'success - | Failure of 'failure +module Error = + let map (f: 'a -> 'b) (err: 'a) : 'b = f err + +let mapError (f: 'e1 -> 'e2) (result: Result<'ok, 'e1>) : Result<'ok, 'e2> = + match result with + | Ok ok -> Ok ok + | Error err -> Error(f err) + +type ResultBuilder() = + member _.Return(x: 'ok) : Result<'ok, 'err> = Ok x + member _.ReturnFrom(result: Result<'ok, 'err>) : Result<'ok, 'err> = result + + member _.Bind(result: Result<'ok, 'err>, f: 'ok -> Result<'ok2, 'err>) : Result<'ok2, 'err> = + match result with + | Ok ok -> f ok + | Error err -> Error err + + member _.Zero() : Result = Ok() + member _.Delay(f: unit -> Result<'ok, 'err>) = f + member _.Run(f: unit -> Result<'ok, 'err>) = f () + + member this.While(guard: unit -> bool, body: unit -> Result) = + if guard () then + this.Bind(body (), fun () -> this.While(guard, body)) + else + this.Zero() + + member this.For(sequence: seq<'ok>, f: 'ok -> Result) = + use en = sequence.GetEnumerator() + this.While(en.MoveNext, fun () -> f en.Current) + + member _.Combine(result1: Result, result2: Result<'ok, 'err>) : Result<'ok, 'err> = + match result1 with + | Ok() -> result2 + | Error err -> Error err + + member this.MergeSources(result1: Result<'ok1, 'err>, result2: Result<'ok2, 'err>) : Result<'ok1 * 'ok2, 'err> = + match result1, result2 with + | Ok ok1, Ok ok2 -> Ok(ok1, ok2) + | Error err, _ + | _, Error err -> Error err + +let resultM = ResultBuilder() diff --git a/QuadTree/SSSP.fs b/QuadTree/SSSP.fs index 543e060..9a40fde 100644 --- a/QuadTree/SSSP.fs +++ b/QuadTree/SSSP.fs @@ -1,11 +1,12 @@ module Graph.SSSP open Common +open Result -type Error<'t1, 't2> = - | NewFrontierCalculationProblem of LinearAlgebra.Error<'t1, 't2, 't1> - | FrontierCalculationProblem of Vector.Error<'t1, 't1> - | VisitedCalculationProblem of Vector.Error<'t1, 't1> +type Error = + | NewFrontierCalculationProblem of LinearAlgebra.Error + | FrontierCalculationProblem of Vector.Error + | VisitedCalculationProblem of Vector.Error let sssp graph (startVertex: uint64) = let op_add x y = @@ -22,31 +23,27 @@ let sssp graph (startVertex: uint64) = let rec inner (frontier: Vector.SparseVector<_>) (visited: Vector.SparseVector<_>) iter_num = if frontier.nvals > 0UL && iter_num <= int frontier.length then + resultM { + let! new_frontier = + LinearAlgebra.vxm op_add op_mult frontier graph + |> Result.mapError NewFrontierCalculationProblem - let new_frontier = LinearAlgebra.vxm op_add op_mult frontier graph - - match new_frontier with - | Result.Failure(e) -> Result.Failure(NewFrontierCalculationProblem(e)) - | Result.Success(new_frontier) -> let op_min x y = match (x, y) with | Some v, Some u -> if v < u then Some v else None | Some v, _ -> Some v | _ -> None - let frontier = Vector.map2 new_frontier visited op_min - - match frontier with - | Result.Failure(e) -> Result.Failure(FrontierCalculationProblem(e)) - | Result.Success(frontier) -> + let! frontier = + Vector.map2 new_frontier visited op_min + |> Result.mapError FrontierCalculationProblem - let visited = Vector.map2 visited frontier op_add + let! visited = Vector.map2 visited frontier op_add |> Result.mapError VisitedCalculationProblem - match visited with - | Result.Failure(e) -> Result.Failure(VisitedCalculationProblem(e)) - | Result.Success(visited) -> inner frontier visited (iter_num + 1) + return! inner frontier visited (iter_num + 1) + } else - Result.Success visited + Ok visited let frontier = Vector.CoordinateList((uint64 graph.ncols) * 1UL, [ startVertex * 1UL, 0.0 ]) diff --git a/QuadTree/TriangleCount.fs b/QuadTree/TriangleCount.fs index f1d41b6..3260a2d 100644 --- a/QuadTree/TriangleCount.fs +++ b/QuadTree/TriangleCount.fs @@ -1,14 +1,12 @@ module Graph.TriangleCount open Common +open Result -type TriangleCountError<'value1, 'value2, 'value3> = - | MXMError of LinearAlgebra.MXMError<'value1, 'value2, 'value3> - | MaskingError of Matrix.Error<'value3, 'value2> +type Error = + | MXMProblem of LinearAlgebra.Error + | MaskingProblem of Matrix.Error -// Assume non-oriented graph adjacency matrix -// Some _ -> edge, None -> no edge -// Computes triangle count let triangle_count (graph: Matrix.SparseMatrix<_>) = let graph = Matrix.getLowerTriangle graph @@ -24,19 +22,12 @@ let triangle_count (graph: Matrix.SparseMatrix<_>) = | Some _, Some _ -> Some 1UL | _ -> None - let C = LinearAlgebra.mxm op_add op_mult graph (Matrix.transpose graph) + resultM { + let! C = + LinearAlgebra.mxm op_add op_mult graph (Matrix.transpose graph) + |> Result.mapError MXMProblem - let CMasked = - match C with - | Result.Success matrix -> - match Matrix.mask matrix graph Option.isSome with - | Result.Success m -> Result.Success m - | Result.Failure e -> Result.Failure <| TriangleCountError.MaskingError e - | Result.Failure e -> Result.Failure <| TriangleCountError.MXMError e + let! CMasked = Matrix.mask C graph Option.isSome |> Result.mapError MaskingProblem - let result = - match CMasked with - | Result.Success matrix -> Result.Success(Matrix.foldAssociative op_add None matrix) - | Result.Failure e -> Result.Failure e - - result + return Matrix.foldAssociative op_add None CMasked + } diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index 0bf187d..f1ddb16 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -9,6 +9,9 @@ type 'value btree = [] type dataLength +[] +type index + [] type Storage<'value> = val size: uint64 @@ -26,15 +29,9 @@ type SparseVector<'value> = nvals = _nvals storage = _storage } -type Error<'value1, 'value2> = - | InconsistentStructureOfStorages of btree> * btree> - | InconsistentSizeOfArguments of SparseVector<'value1> * SparseVector<'value2> - -(* -let foldValues state f tree = - match tree with - | Leaf -*) +type Error = + | InconsistentStructureOfStorages + | InconsistentSizeOfArguments let mkNode t1 t2 = @@ -42,8 +39,6 @@ let mkNode t1 t2 = | Leaf(v1), Leaf(v2) when v1 = v2 -> Leaf(v1) | _ -> Node(t1, t2) -[] -type index [] type CoordinateList<'value> = @@ -51,6 +46,51 @@ type CoordinateList<'value> = val data: (uint64 * 'value) list new(_length, _data) = { length = _length; data = _data } +let update (vector: SparseVector<_>) i v op = + let rec inner vector (i: uint64) size = + match vector with + | Leaf(UserValue x) -> + if size = 1UL then + let res = op x v + + let deltaNNZ = + match (res, x) with + | Some _, None -> 1L + | None, Some _ -> -1L + | _ -> 0 + + Leaf(UserValue(op x v)), deltaNNZ + else + let halfSize = size / 2UL + + if uint64 i < uint64 halfSize then + let newVector, deltaNNZ = inner vector i halfSize + (mkNode newVector vector), deltaNNZ + else + let newVector, deltaNNZ = + inner vector ((uint64 i - uint64 halfSize) * 1UL) halfSize + + (mkNode vector newVector), deltaNNZ + | Node(x1, x2) -> + let halfSize = size / 2UL + + if uint64 i < uint64 halfSize then + let newVector, deltaNNZ = inner x1 i halfSize + (mkNode newVector x2), deltaNNZ + else + let newVector, deltaNNZ = + inner x2 ((uint64 i - uint64 halfSize) * 1UL) halfSize + + (mkNode x1 newVector), deltaNNZ + | _ -> failwith "Unreachable. But seams that index out of range." + + if uint64 i <= uint64 vector.length then + let storage, deltaNNZ = inner vector.storage.data i vector.storage.size + let nvals = uint64 (int64 vector.nvals + deltaNNZ) * 1UL + Ok(SparseVector(vector.length, nvals, Storage(vector.storage.size, storage))) + else + Error Error.InconsistentSizeOfArguments + let fromCoordinateList (lst: CoordinateList<'a>) : SparseVector<'a> = let length = lst.length let nvals = (uint64 <| List.length lst.data) * 1UL @@ -98,6 +138,22 @@ let toCoordinateList (vector: SparseVector<'a>) = CoordinateList(length, lst) +let empty length = + fromCoordinateList (CoordinateList(length, [])) + +let foldValues (vector: SparseVector<'a>) (f: 'b -> 'a -> 'b) (state: 'b) = + let rec inner state (size: uint64) vector = + match vector with + | Leaf(UserValue(Some v)) -> + let lst = List.replicate (int size) v + List.fold f state lst + | Node(x1, x2) -> + let halfSize = size / 2UL + inner (inner state halfSize x1) halfSize x2 + | _ -> state + + inner state vector.storage.size vector.storage.data + let map (vector: SparseVector<'a>) f = let rec inner (size: uint64) vector = match vector with @@ -120,6 +176,67 @@ let map (vector: SparseVector<'a>) f = SparseVector(vector.length, nvals, (Storage(vector.storage.size, storage))) + +let mapi (vector: SparseVector<'a>) f = + let rec inner (pointer: uint64) (size: uint64) vector = + match vector with + | Node(x1, x2) -> + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize x1 + let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 + (mkNode t1 t2), nvals1 + nvals2 + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v)) -> + if size = 1UL then + let res = f pointer v + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + else + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize (Leaf(UserValue(v))) + + let t2, nvals2 = + inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(UserValue(v))) + + (mkNode t1 t2), nvals1 + nvals2 + + let storage, nvals = inner 0UL vector.storage.size vector.storage.data + + SparseVector(vector.length, nvals, (Storage(vector.storage.size, storage))) + + +let init (length: uint64) (f: uint64 -> Option<'a>) : SparseVector<'a> = + let storageSize = (getNearestUpperPowerOfTwo <| uint64 length) * 1UL + + let rec build (pointer: uint64) (size: uint64) = + if uint64 pointer >= uint64 length then + Leaf Dummy, 0UL + elif size = 1UL then + if uint64 pointer >= uint64 length then + Leaf Dummy, 0UL + else + let v = f pointer + + Leaf(UserValue v), + (match v with + | Some _ -> 1UL + | None -> 0UL) + else + let halfSize = size / 2UL + let left, nvals1 = build pointer halfSize + let newPointer = (uint64 pointer + uint64 halfSize) * 1UL + let right, nvals2 = build newPointer halfSize + mkNode left right, nvals1 + nvals2 + + let storage, nvals = build 0UL storageSize + + SparseVector(length, nvals, Storage(storageSize, storage)) + let map2 (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = let len1 = vector1.length @@ -128,16 +245,15 @@ let map2 (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = let new_size = size / 2UL match (inner new_size x1 y1), (inner new_size x2 y2) with - | Result.Success((t1, nvals1)), Result.Success((t2, nvals2)) -> - ((mkNode t1 t2), nvals1 + nvals2) |> Result.Success - | Result.Failure(e), _ - | _, Result.Failure(e) -> Result.Failure(e) + | Ok((t1, nvals1)), Ok((t2, nvals2)) -> ((mkNode t1 t2), nvals1 + nvals2) |> Ok + | Error(e), _ + | _, Error(e) -> Error(e) match (vector1, vector2) with | Node(x1, x2), Leaf(_) -> _do x1 x2 vector2 vector2 | Leaf(_), Node(y1, y2) -> _do vector1 vector1 y1 y2 | Node(x1, x2), Node(y1, y2) -> _do x1 x2 y1 y2 - | Leaf(Dummy), Leaf(Dummy) -> Result.Success(Leaf(Dummy), 0UL) + | Leaf(Dummy), Leaf(Dummy) -> Ok(Leaf(Dummy), 0UL) | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> let res = f v1 v2 @@ -146,17 +262,159 @@ let map2 (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = | None -> 0UL | _ -> (uint64 size) * 1UL - Result.Success(Leaf(UserValue(res)), nnz) + Ok(Leaf(UserValue(res)), nnz) - | (x, y) -> Result.Failure <| Error.InconsistentStructureOfStorages(x, y) + | (x, y) -> Error Error.InconsistentStructureOfStorages if len1 = vector2.length then match inner vector1.storage.size vector1.storage.data vector2.storage.data with - | Result.Failure(e) -> Result.Failure(e) - | Result.Success((storage, nvals)) -> - Result.Success(SparseVector(len1, nvals, (Storage(vector1.storage.size, storage)))) + | Error(e) -> Error(e) + | Ok((storage, nvals)) -> Ok(SparseVector(len1, nvals, (Storage(vector1.storage.size, storage)))) else - Result.Failure <| Error.InconsistentSizeOfArguments(vector1, vector2) + Error Error.InconsistentSizeOfArguments let mask (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = map2 vector1 vector2 (fun v1 v2 -> if f v2 then v1 else None) + +let map2i (vector1: SparseVector<'a>) (vector2: SparseVector<'b>) f = + let len1 = vector1.length + + let rec inner (pointer: uint64) (size: uint64) vector1 vector2 = + match (vector1, vector2) with + | Node(x1, x2), Node(y1, y2) -> + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize x1 y1 + let t2, nvals2 = inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 y2 + (mkNode t1 t2), nvals1 + nvals2 + | Node(x1, x2), Leaf(v2) -> + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize x1 (Leaf(v2)) + + let t2, nvals2 = + inner (pointer + (uint64 halfSize) * 1UL) halfSize x2 (Leaf(v2)) + + (mkNode t1 t2), nvals1 + nvals2 + | Leaf(v1), Node(y1, y2) -> + let halfSize = size / 2UL + let t1, nvals1 = inner pointer halfSize (Leaf(v1)) y1 + + let t2, nvals2 = + inner (pointer + (uint64 halfSize) * 1UL) halfSize (Leaf(v1)) y2 + + (mkNode t1 t2), nvals1 + nvals2 + | Leaf(Dummy), Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> + let res = f pointer v1 v2 + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + | Leaf(UserValue(v)), Leaf(Dummy) -> + let res = f pointer v None + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + | Leaf(Dummy), Leaf(UserValue(v)) -> + let res = f pointer None v + + let nnz = + match res with + | Some _ -> 1UL + | None -> 0UL + + Leaf(UserValue(res)), nnz + + if len1 = vector2.length then + let storage, nvals = + inner 0UL vector1.storage.size vector1.storage.data vector2.storage.data + + SparseVector(len1, nvals, (Storage(vector1.storage.size, storage))) |> Ok + else + Error InconsistentSizeOfArguments + + +/// Returns None if index out of range +let unsafeGet (v: SparseVector<'a>) (index: uint64) = + let originalIndex = index + + let rec getFromTree (tree: btree>) (size: uint64) (index: uint64) = + match tree with + | Leaf Dummy -> None + | Leaf(UserValue v) -> v + | Node(l: Option<'a> btree, r) -> + let halfSize = size / 2UL + + if uint64 index < uint64 halfSize then + getFromTree l halfSize index + else + getFromTree r halfSize ((uint64 index - uint64 halfSize) * 1UL) + + getFromTree v.storage.data v.storage.size index + +/// Gather: w[i] = v[idx[i]] +let gather (v: SparseVector<'value>) (idx: SparseVector>) : SparseVector<'value> = + map idx (fun i -> + match i with + | Some i -> unsafeGet v i + | None -> None) + +let mergeSort (v: SparseVector<'a>) (compare: Option<'a> -> Option<'a> -> int) : SparseVector<'a> = + let storageSize = v.storage.size + let nvals = v.nvals + + // Extract values from tree + let rec extract tree = + match tree with + | Leaf Dummy -> [] + | Leaf(UserValue None) -> [] + | Leaf(UserValue v) -> [ v ] + | Node(l, r) -> extract l @ extract r + + // Place sorted values into original tree structure + let rec place tree sortedVals = + match tree, sortedVals with + | Leaf Dummy, rest -> Leaf Dummy, rest + | Leaf(UserValue None), rest -> Leaf(UserValue None), rest + | Leaf(UserValue _), v :: rest -> Leaf(UserValue v), rest + | Leaf(UserValue _), [] -> Leaf Dummy, [] + | Node(l, r), vals -> + let l', r1 = place l vals + let r', r2 = place r r1 + mkNode l' r', r2 + + let values = extract v.storage.data + let sortedVals = List.sortWith (fun a b -> compare a b) values + let newTree, _ = place v.storage.data sortedVals + + SparseVector(v.length, nvals, Storage(storageSize, newTree)) + +/// Scatter: w[idx[i]] = op(w[idx[i]], v[i]) +let scatter + (w: SparseVector<'value>) + (v: SparseVector<'value>) + (idx: SparseVector>) + (op: Option<'value> -> Option<'value> -> Option<'value>) + = + let pairsVec = + map2 idx v (fun i v -> + match i, v with + | Some i, Some v -> Some(i, v) + | _ -> None) + + match pairsVec with + | Ok pv -> + foldValues + pv + (fun state (idx, v) -> + match state with + | Ok state -> update state idx (Some v) op + | Error x -> Error x) + (Ok w) + | Error x -> Error Error.InconsistentStructureOfStorages diff --git a/README.md b/README.md index 075e8f5..8084adb 100644 --- a/README.md +++ b/README.md @@ -11,6 +11,7 @@ Infrastructure for benchmarking the implemented algorithms is available in the [ * Single-source level BFS * Single-source shortest path (SSSP) * Triangles counting +* Boruvka MSF ## TODO * [ ] Single-source parent BFS