From 030535348da0774ee8139560a417916d9f99afda Mon Sep 17 00:00:00 2001 From: Narysev Date: Fri, 12 Jun 2026 22:04:49 +0300 Subject: [PATCH 01/13] feat(quadtree): add filter, exists, forall with tests and benchmarks Implement: - Vector.filter / Matrix.filter - Vector.exists / Vector.forall (short-circuit || / &&) - Matrix.exists / Matrix.forall (short-circuit || / &&) Tests (64 total): - Vector.filter: 9 - Vector.exists: 12 - Vector.forall: 12 - Matrix.filter: 9 - Matrix.exists: 11 - Matrix.forall: 11 Benchmarks: - Filters.fs: Vector/Matrix filter (dense + sparse), N=64,256,4096 - Exists.fs: Vector/Matrix exists (dense + sparse), N=64,256,4096 - Forall.fs: Vector/Matrix forall (dense + sparse), N=64,256,4096 - Register in BenchmarkSwitcher and .fsproj --- QuadTree.Benchmark/Exists.fs | 52 +++ QuadTree.Benchmark/Filters.fs | 52 +++ QuadTree.Benchmark/Forall.fs | 52 +++ QuadTree.Benchmark/Main.fs | 5 +- QuadTree.Benchmark/QuadTree.Benchmark.fsproj | 3 + QuadTree.Tests/Tests.Matrix.fs | 354 +++++++++++++++++ QuadTree.Tests/Tests.Vector.fs | 383 +++++++++++++++++++ QuadTree/Matrix.fs | 50 +++ QuadTree/Vector.fs | 40 +- 9 files changed, 989 insertions(+), 2 deletions(-) create mode 100644 QuadTree.Benchmark/Exists.fs create mode 100644 QuadTree.Benchmark/Filters.fs create mode 100644 QuadTree.Benchmark/Forall.fs diff --git a/QuadTree.Benchmark/Exists.fs b/QuadTree.Benchmark/Exists.fs new file mode 100644 index 0000000..2fc08a8 --- /dev/null +++ b/QuadTree.Benchmark/Exists.fs @@ -0,0 +1,52 @@ +namespace QuadTree.Benchmarks.Exists + + +open BenchmarkDotNet.Attributes +open QuadTree.Benchmarks.Utils + +[)>] +type Benchmark() = + + let mutable denseVec = Unchecked.defaultof> + let mutable sparseVec = Unchecked.defaultof> + let mutable denseMat = Unchecked.defaultof> + let mutable sparseMat = Unchecked.defaultof> + + [] + member val N = 0 with get, set + + [] + member this.Setup() = + let denseData = [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + denseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, denseData)) + + let sparseData = [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + sparseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + + let denseMatData = [ + for r in 0UL .. uint64 this.N - 1UL do + for c in 0UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + denseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, denseMatData)) + + let sparseMatData = [ + for r in 0UL .. 10UL .. uint64 this.N - 1UL do + for c in 0UL .. 10UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + sparseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, sparseMatData)) + + [] + member this.VectorExistsDense() = + Vector.exists denseVec (fun x -> x < 0) + + [] + member this.VectorExistsSparse() = + Vector.exists sparseVec (fun x -> x < 0) + + [] + member this.MatrixExistsDense() = + Matrix.exists denseMat (fun x -> x < 0) + + [] + member this.MatrixExistsSparse() = + Matrix.exists sparseMat (fun x -> x < 0) diff --git a/QuadTree.Benchmark/Filters.fs b/QuadTree.Benchmark/Filters.fs new file mode 100644 index 0000000..075e339 --- /dev/null +++ b/QuadTree.Benchmark/Filters.fs @@ -0,0 +1,52 @@ +namespace QuadTree.Benchmarks.Filters + +open BenchmarkDotNet.Attributes +open QuadTree.Benchmarks.Utils + +[)>] +type Benchmark() = + + let mutable denseVec = Unchecked.defaultof> + let mutable sparseVec = Unchecked.defaultof> + let mutable denseMat = Unchecked.defaultof> + let mutable sparseMat = Unchecked.defaultof> + + // [] + [] + member val N = 0 with get, set + + [] + member this.Setup() = + let denseData = [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + denseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, denseData)) + + let sparseData = [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + sparseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + + let denseMatData = [ + for r in 0UL .. uint64 this.N - 1UL do + for c in 0UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + denseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, denseMatData)) + + let sparseMatData = [ + for r in 0UL .. 10UL .. uint64 this.N - 1UL do + for c in 0UL .. 10UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + sparseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, sparseMatData)) + + [] + member this.VectorFilterDense() = + Vector.filter denseVec (fun x -> x % 2 = 0) + + [] + member this.VectorFilterSparse() = + Vector.filter sparseVec (fun x -> x % 2 = 0) + + [] + member this.MatrixFilterDense() = + Matrix.filter denseMat (fun x -> x % 2 = 0) + + [] + member this.MatrixFilterSparse() = + Matrix.filter sparseMat (fun x -> x % 2 = 0) diff --git a/QuadTree.Benchmark/Forall.fs b/QuadTree.Benchmark/Forall.fs new file mode 100644 index 0000000..8d8ad46 --- /dev/null +++ b/QuadTree.Benchmark/Forall.fs @@ -0,0 +1,52 @@ +namespace QuadTree.Benchmarks.Forall + + +open BenchmarkDotNet.Attributes +open QuadTree.Benchmarks.Utils + +[)>] +type Benchmark() = + + let mutable denseVec = Unchecked.defaultof> + let mutable sparseVec = Unchecked.defaultof> + let mutable denseMat = Unchecked.defaultof> + let mutable sparseMat = Unchecked.defaultof> + + [] + member val N = 0 with get, set + + [] + member this.Setup() = + let denseData = [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + denseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, denseData)) + + let sparseData = [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + sparseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + + let denseMatData = [ + for r in 0UL .. uint64 this.N - 1UL do + for c in 0UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + denseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, denseMatData)) + + let sparseMatData = [ + for r in 0UL .. 10UL .. uint64 this.N - 1UL do + for c in 0UL .. 10UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + sparseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, sparseMatData)) + + [] + member this.VectorForallDense() = + Vector.forall denseVec (fun x -> x > 0) + + [] + member this.VectorForallSparse() = + Vector.forall sparseVec (fun x -> x > 0) + + [] + member this.MatrixForallDense() = + Matrix.forall denseMat (fun x -> x > 0) + + [] + member this.MatrixForallSparse() = + Matrix.forall sparseMat (fun x -> x > 0) diff --git a/QuadTree.Benchmark/Main.fs b/QuadTree.Benchmark/Main.fs index 61394af..3fb2bf4 100644 --- a/QuadTree.Benchmark/Main.fs +++ b/QuadTree.Benchmark/Main.fs @@ -4,7 +4,10 @@ open BenchmarkDotNet.Running let main argv = let benchmarks = BenchmarkSwitcher - [| typeof + [| typeof + typeof + typeof + typeof typeof typeof |] diff --git a/QuadTree.Benchmark/QuadTree.Benchmark.fsproj b/QuadTree.Benchmark/QuadTree.Benchmark.fsproj index 4edb362..ba98b9d 100644 --- a/QuadTree.Benchmark/QuadTree.Benchmark.fsproj +++ b/QuadTree.Benchmark/QuadTree.Benchmark.fsproj @@ -8,6 +8,9 @@ + + + diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index 816b4a2..b65c53d 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -642,3 +642,357 @@ let ``Fold sum`` () = let actual = foldAssociative op_add None m1 |> Option.get Assert.Equal(expected, actual) + +[] +let ``Matrix.filter all pass, none changed`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + let actual = Matrix.filter m (fun x -> x > 0) + Assert.Equal(m, actual) + +[] +let ``Matrix.filter none pass, all reset to zero`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + let expected = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, [])) + let actual = Matrix.filter m (fun x -> x < 0) + + Assert.Equal(expected, actual) + +[] +let ``Matrix.filter length is not a power of 2, all reset to zero`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) + (2UL, 0UL, 7) + (2UL, 1UL, 8) + (2UL, 2UL, 9) ])) + let expected = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, [])) + let actual = Matrix.filter m (fun x -> x < 0) + + Assert.Equal(expected, actual) + +[] +let ``Matrix.filter some pass, odd set to zero`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (0UL, 3UL, 4) + (1UL, 0UL, 5) + (1UL, 1UL, 6) + (1UL, 2UL, 7) + (1UL, 3UL, 8) + (2UL, 0UL, 9) + (2UL, 1UL, 10) + (2UL, 2UL, 11) + (2UL, 3UL, 12) + (3UL, 0UL, 13) + (3UL, 1UL, 14) + (3UL, 2UL, 15) + (3UL, 3UL, 16) ])) + let expected = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 1UL, 2) + (0UL, 3UL, 4) + (1UL, 1UL, 6) + (1UL, 3UL, 8) + (2UL, 1UL, 10) + (2UL, 3UL, 12) + (3UL, 1UL, 14) + (3UL, 3UL, 16) ])) + let actual = Matrix.filter m (fun x -> x % 2 = 0) + + Assert.Equal(expected, actual) + +[] +let ``Matrix.filter length is not a power of 2, not all reset to zero`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) + (2UL, 0UL, 7) + (2UL, 1UL, 8) + (2UL, 2UL, 9) ])) + let expected = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 1UL, 2) + (1UL, 0UL, 4) + (1UL, 2UL, 6) + (2UL, 1UL, 8) ])) + let actual = Matrix.filter m (fun x -> x % 2 = 0) + + Assert.Equal(expected, actual) + +[] +let ``Matrix.filter none pass, length is not a power of 2, none changed`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, [])) + let actual = Matrix.filter m (fun x -> x > 0) + Assert.Equal(m, actual) + +[] +let ``Matrix.filter none pass, length is a power of 2, none changed`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, [])) + let actual = Matrix.filter m (fun x -> x > 0) + Assert.Equal(m, actual) + +[] +let ``Matrix.filter single element, passes`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, + [ (0UL, 0UL, 1) ])) + let expected = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, + [ (0UL, 0UL, 1) ])) + let actual = Matrix.filter m (fun x -> x > 0) + + Assert.Equal(expected, actual) + +[] +let ``Matrix.filter single element, fails`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, + [ (0UL, 0UL, 1) ])) + let expected = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, [])) + let actual = Matrix.filter m (fun x -> x < 0) + + Assert.Equal(expected, actual) + +[] +let ``Matrix.exists the first element fits, length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.True (Matrix.exists m (fun x -> x = 1)) + Assert.False (Matrix.exists m (fun x -> x = 10)) + +[] +let ``Matrix.exists the first element fits, length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.True (Matrix.exists m (fun x -> x = 1)) + +[] +let ``Matrix.exists no element fits, length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.False (Matrix.exists m (fun x -> x = 10)) + +[] +let ``Matrix.exists no element fits, length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.False (Matrix.exists m (fun x -> x = 10)) + +[] +let ``Matrix.exists empty matrix`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, [])) + Assert.False (Matrix.exists m (fun x -> x = 1)) + +[] +let ``Matrix.exists single element, fits`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, + [ (0UL, 0UL, 1) ])) + Assert.True (Matrix.exists m (fun x -> x = 1)) + +[] +let ``Matrix.exists single element, does not fit`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, + [ (0UL, 0UL, 1) ])) + Assert.False (Matrix.exists m (fun x -> x = 10)) + +[] +let ``Matrix.exists all elements fit,length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.True (Matrix.exists m (fun x -> x > 0)) + +[] +let ``Matrix.exists all elements fit,length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.True (Matrix.exists m (fun x -> x > 0)) +[] +let ``Matrix.exists some elements fit, length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.True (Matrix.exists m (fun x -> x = 2 || x = 10)) + +[] +let ``Matrix.exists some elements fit, length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.True (Matrix.exists m (fun x -> x = 2 || x = 10)) + +[] +let ``Matrix.forall the first element fits, length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.True (Matrix.forall m (fun x -> x > 0)) + +[] +let ``Matrix.forall the first element fits, length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.True (Matrix.forall m (fun x -> x > 0)) + +[] +let ``Matrix.forall no element fits, length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.False (Matrix.forall m (fun x -> x > 10)) + +[] +let ``Matrix.forall no element fits, length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.False (Matrix.forall m (fun x -> x > 10)) + +[] +let ``Matrix.forall all elements fit,length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.True (Matrix.forall m (fun x -> x > 0)) + +[] +let ``Matrix.forall all elements fit,length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.True (Matrix.forall m (fun x -> x > 0)) + +[] +let ``Matrix.forall some elements fit, length is a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(4UL, 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ])) + Assert.False (Matrix.forall m (fun x -> x = 2 || x = 10)) + +[] +let ``Matrix.forall some elements fit, length is not a power of 2`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ])) + Assert.False (Matrix.forall m (fun x -> x = 2 || x = 10)) + +[] +let ``Matrix.forall empty matrix`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(3UL, 3UL, [])) + Assert.True (Matrix.forall m (fun x -> x = 1)) + +[] +let ``Matrix.forall single element, fits`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, + [ (0UL, 0UL, 1) ])) + Assert.True (Matrix.forall m (fun x -> x = 1)) + +[] +let ``Matrix.forall single element, does not fit`` () = + let m = Matrix.fromCoordinateList ( + CoordinateList(1UL, 1UL, + [ (0UL, 0UL, 1) ])) + Assert.False (Matrix.forall m (fun x -> x = 10)) \ No newline at end of file diff --git a/QuadTree.Tests/Tests.Vector.fs b/QuadTree.Tests/Tests.Vector.fs index 4eb1af9..6ef2cbd 100644 --- a/QuadTree.Tests/Tests.Vector.fs +++ b/QuadTree.Tests/Tests.Vector.fs @@ -903,3 +903,386 @@ let ``Init vector`` () = let actual = Vector.init 3UL (fun i -> Some(int i)) Assert.Equal(expected, actual) + + +[] +let ``Vector.filter all pass, none changed`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + let actual = Vector.filter v (fun x -> x > 0) + Assert.Equal(v, actual) + +[] +let ``Vector.filter none pass, all reset to zero`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + let expected = + Vector.empty 8UL + let actual = Vector.filter v (fun x -> x < 0) + + Assert.Equal(expected, actual) + +[] +let ``Vector.filter length is not a power of 2, all reset to zero`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + let expected = + Vector.empty 6UL + let actual = Vector.filter v (fun x -> x < 0) + + Assert.Equal(expected, actual) + +[] +let ``Vector.filter some pass, odd set to zero`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + let expected = + Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (1UL, 2) + (3UL, 4) + (5UL, 6) + (7UL, 8) ])) + let actual = Vector.filter v (fun x -> ((x % 2) = 0)) + + Assert.Equal(expected, actual) + +[] +let ``Vector.filter length is not a power of 2, not all reset to zero`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + let expected = + Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (1UL, 2) + (3UL, 4) + (5UL, 6) ])) + let actual = Vector.filter v (fun x -> ((x % 2) = 0)) + + Assert.Equal(expected, actual) + +[] +let ``Vector.filter none pass, length is not a power of 2, none changed`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [])) + let actual = Vector.filter v (fun x -> x > 0) + Assert.Equal(v, actual) + +[] +let ``Vector.filter none pass, length is a power of 2, none changed`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [])) + let actual = Vector.filter v (fun x -> x > 0) + Assert.Equal(v, actual) + +[] +let ``Vector.filter single element, passes`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(1UL, + [ (0UL, 1) ])) + let expected = + Vector.fromCoordinateList ( + CoordinateList(1UL, + [ (0UL, 1) ])) + let actual = Vector.filter v (fun x -> x > 0) + + Assert.Equal(expected, actual) + +[] +let ``Vector.filter single element, fails`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(1UL, + [ (0UL, 1) ])) + let expected = + Vector.empty 1UL + let actual = Vector.filter v (fun x -> x < 0) + + Assert.Equal(expected, actual) + +[] +let ``Vector.exists the first element fits, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.True (Vector.exists v (fun x -> x > 0)) + +[] +let ``Vector.exists the first element fits, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.True (Vector.exists v (fun x -> x > 0)) + +[] +let ``Vector.exists the last item fits, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.True (Vector.exists v (fun x -> x > 7)) + +[] +let ``Vector.exists the last item fits, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.True (Vector.exists v (fun x -> x > 5)) + +[] +let ``Vector.exists empty list`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [])) + Assert.False (Vector.exists v (fun x -> x > 0)) + +[] +let ``Vector.exists no matching elements, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.False (Vector.exists v (fun x -> x > 8)) + +[] +let ``Vector.exists no matching elements, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.False (Vector.exists v (fun x -> x > 6)) + +[] +let ``Vector.exists single element matches`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(1UL, + [ (0UL, 1) ])) + Assert.True (Vector.exists v (fun x -> x = 1)) + +[] +let ``Vector.exists single element does not match`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(1UL, + [ (0UL, 1) ])) + Assert.False (Vector.exists v (fun x -> x = 2)) + +[] +let ``Vector.exists all elements match, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.True (Vector.exists v (fun x -> x > 0)) + +[] +let ``Vector.exists all elements match, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.True (Vector.exists v (fun x -> x > 0)) + +[] +let ``Vector.forall the first element not fits, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.False (Vector.forall v (fun x -> x > 1)) + +[] +let ``Vector.forall the first element not fits, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.False (Vector.forall v (fun x -> x > 1)) + +[] +let ``Vector.forall the last item not fits, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.False (Vector.forall v (fun x -> x < 8)) + +[] +let ``Vector.forall the last item not fits, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.False (Vector.forall v (fun x -> x < 6)) + +[] +let ``Vector.forall empty list`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [])) + Assert.True (Vector.forall v (fun x -> x > 0)) + +[] +let ``Vector.forall no matching elements, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.False (Vector.forall v (fun x -> x > 8)) + +[] +let ``Vector.forall no matching elements, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.False (Vector.forall v (fun x -> x > 6)) + +[] +let ``Vector.forall single element matches`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(1UL, + [ (0UL, 1) ])) + Assert.True (Vector.forall v (fun x -> x = 1)) + +[] +let ``Vector.forall single element does not match`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(1UL, + [ (0UL, 1) ])) + Assert.False (Vector.forall v (fun x -> x = 2)) + +[] +let ``Vector.forall all elements match, length is a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ])) + Assert.True (Vector.forall v (fun x -> x > 0)) + +[] +let ``Vector.forall all elements match, length is not a power of 2`` () = + let v = Vector.fromCoordinateList ( + CoordinateList(6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ])) + Assert.True (Vector.forall v (fun x -> x > 0)) diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index 68ea7d7..47bade8 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -394,3 +394,53 @@ let transpose (matrix: SparseMatrix<_>) = let mask (m1: SparseMatrix<'a>) (m2: SparseMatrix<'b>) f = map2 m1 m2 (fun m1 m2 -> if f m2 then m1 else None) + + +let filter (matrix: SparseMatrix<'a>) (predicate: 'a -> bool) : SparseMatrix<'a> = + 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(None)) -> Leaf(UserValue(None)), 0UL + | Leaf(UserValue(Some(v))) -> + if predicate v then + Leaf(UserValue(Some v)), (uint64 size) * (uint64 size) * 1UL + else + Leaf(UserValue(None)), 0UL + + let storage, nvals = + inner 0UL 0UL matrix.storage.size matrix.storage.data + + SparseMatrix(matrix.nrows, matrix.ncols, nvals, (Storage(matrix.storage.size, storage))) + +let exists (matrix: SparseMatrix<'a>) (predicate: 'a -> bool) : bool = + let rec inner tree = + match tree with + | Leaf(Dummy) -> false + | Leaf(UserValue(None)) -> false + | Leaf(UserValue(Some(v))) -> predicate v + | Node(nw, ne, sw, se) -> + inner nw || inner ne || inner sw || inner se + + inner matrix.storage.data + +let forall (matrix: SparseMatrix<'a>) (predicate: 'a -> bool) : bool = + let rec inner tree = + match tree with + | Leaf(Dummy) -> true + | Leaf(UserValue(None)) -> true + | Leaf(UserValue(Some(v))) -> predicate v + | Node(nw, ne, sw, se) -> + inner nw && inner ne && inner sw && inner se + + inner matrix.storage.data \ No newline at end of file diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index b7bcb44..6ea0ee4 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -353,7 +353,7 @@ let toCoordinateList (vector: SparseVector<'a>) = CoordinateList(length, lst) -let empty length = +let empty (length: uint64) = fromCoordinateList (CoordinateList(length, [])) let foldValues (vector: SparseVector<'a>) (f: 'b -> 'a -> 'b) (state: 'b) = @@ -561,3 +561,41 @@ let scatter | Error x -> Error x) (Ok w) | Error x -> Error Error.InconsistentStructureOfStorages + +let filter (vector: SparseVector<'a>) (predicate: 'a -> bool) : SparseVector<'a> = + let rec inner (size: uint64) vector = + match vector with + | Node(x1, x2) -> + let t1, nvals1 = inner (size / 2UL) x1 + let t2, nvals2 = inner (size / 2UL) x2 + (mkNode t1 t2), nvals1 + nvals2 + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(None)) -> Leaf(UserValue(None)), 0UL + | Leaf(UserValue(Some(v))) -> + if predicate v then + Leaf(UserValue(Some(v))), (uint64 size) * 1UL + else + Leaf(UserValue(None)), 0UL + + let storage, nvals = inner vector.storage.size vector.storage.data + SparseVector(vector.length, nvals, Storage(vector.storage.size, storage)) + +let exists (vector: SparseVector<'a>) (predicate: 'a -> bool) : bool = + let rec inner vector = + match vector with + | Leaf(Dummy) -> false + | Leaf(UserValue(None)) -> false + | Leaf(UserValue(Some(v))) -> predicate v + | Node(x1, x2) -> inner x1 || inner x2 + + inner vector.storage.data + +let forall (vector: SparseVector<'a>) (predicate: 'a -> bool) : bool = + let rec inner vector = + match vector with + | Leaf(Dummy) -> true + | Leaf(UserValue(None)) -> true + | Leaf(UserValue(Some(v))) -> predicate v + | Node(x1, x2) -> inner x1 && inner x2 + + inner vector.storage.data \ No newline at end of file From bbd6db16db7c8c32da0aabadc95d118e1d305e65 Mon Sep 17 00:00:00 2001 From: Narysev Date: Sat, 13 Jun 2026 11:07:42 +0300 Subject: [PATCH 02/13] fix: formatting --- QuadTree.Benchmark/Exists.fs | 55 ++- QuadTree.Benchmark/Filters.fs | 50 ++- QuadTree.Benchmark/Forall.fs | 57 ++- QuadTree.Tests/Tests.Matrix.fs | 614 +++++++++++++++++++------------- QuadTree.Tests/Tests.Vector.fs | 632 +++++++++++++++++++-------------- QuadTree/Matrix.fs | 10 +- QuadTree/Vector.fs | 4 +- 7 files changed, 854 insertions(+), 568 deletions(-) diff --git a/QuadTree.Benchmark/Exists.fs b/QuadTree.Benchmark/Exists.fs index 2fc08a8..6278303 100644 --- a/QuadTree.Benchmark/Exists.fs +++ b/QuadTree.Benchmark/Exists.fs @@ -12,40 +12,59 @@ type Benchmark() = let mutable denseMat = Unchecked.defaultof> let mutable sparseMat = Unchecked.defaultof> - [] + [] member val N = 0 with get, set [] member this.Setup() = - let denseData = [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + let denseData = + [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + denseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, denseData)) - let sparseData = [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] - sparseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + let sparseData = + [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + + sparseVec <- + Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + + let denseMatData = + [ for r in 0UL .. uint64 this.N - 1UL do + for c in 0UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + + denseMat <- + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + uint64 this.N * 1UL, + uint64 this.N * 1UL, + denseMatData + ) + ) - let denseMatData = [ - for r in 0UL .. uint64 this.N - 1UL do - for c in 0UL .. uint64 this.N - 1UL do - (r * 1UL, c * 1UL, int (r + c) % 100) ] - denseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, denseMatData)) + let sparseMatData = + [ for r in 0UL .. 10UL .. uint64 this.N - 1UL do + for c in 0UL .. 10UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] - let sparseMatData = [ - for r in 0UL .. 10UL .. uint64 this.N - 1UL do - for c in 0UL .. 10UL .. uint64 this.N - 1UL do - (r * 1UL, c * 1UL, int (r + c) % 100) ] - sparseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, sparseMatData)) + sparseMat <- + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + uint64 this.N * 1UL, + uint64 this.N * 1UL, + sparseMatData + ) + ) [] - member this.VectorExistsDense() = - Vector.exists denseVec (fun x -> x < 0) + member this.VectorExistsDense() = Vector.exists denseVec (fun x -> x < 0) [] member this.VectorExistsSparse() = Vector.exists sparseVec (fun x -> x < 0) [] - member this.MatrixExistsDense() = - Matrix.exists denseMat (fun x -> x < 0) + member this.MatrixExistsDense() = Matrix.exists denseMat (fun x -> x < 0) [] member this.MatrixExistsSparse() = diff --git a/QuadTree.Benchmark/Filters.fs b/QuadTree.Benchmark/Filters.fs index 075e339..b733fa4 100644 --- a/QuadTree.Benchmark/Filters.fs +++ b/QuadTree.Benchmark/Filters.fs @@ -11,29 +11,49 @@ type Benchmark() = let mutable denseMat = Unchecked.defaultof> let mutable sparseMat = Unchecked.defaultof> - // [] - [] + [] member val N = 0 with get, set [] member this.Setup() = - let denseData = [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + let denseData = + [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + denseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, denseData)) - let sparseData = [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] - sparseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + let sparseData = + [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + + sparseVec <- + Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + + let denseMatData = + [ for r in 0UL .. uint64 this.N - 1UL do + for c in 0UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + + denseMat <- + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + uint64 this.N * 1UL, + uint64 this.N * 1UL, + denseMatData + ) + ) - let denseMatData = [ - for r in 0UL .. uint64 this.N - 1UL do - for c in 0UL .. uint64 this.N - 1UL do - (r * 1UL, c * 1UL, int (r + c) % 100) ] - denseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, denseMatData)) + let sparseMatData = + [ for r in 0UL .. 10UL .. uint64 this.N - 1UL do + for c in 0UL .. 10UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] - let sparseMatData = [ - for r in 0UL .. 10UL .. uint64 this.N - 1UL do - for c in 0UL .. 10UL .. uint64 this.N - 1UL do - (r * 1UL, c * 1UL, int (r + c) % 100) ] - sparseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, sparseMatData)) + sparseMat <- + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + uint64 this.N * 1UL, + uint64 this.N * 1UL, + sparseMatData + ) + ) [] member this.VectorFilterDense() = diff --git a/QuadTree.Benchmark/Forall.fs b/QuadTree.Benchmark/Forall.fs index 8d8ad46..af40d24 100644 --- a/QuadTree.Benchmark/Forall.fs +++ b/QuadTree.Benchmark/Forall.fs @@ -12,41 +12,62 @@ type Benchmark() = let mutable denseMat = Unchecked.defaultof> let mutable sparseMat = Unchecked.defaultof> - [] + [] member val N = 0 with get, set [] member this.Setup() = - let denseData = [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + let denseData = + [ for i in 0UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + denseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, denseData)) - let sparseData = [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] - sparseVec <- Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + let sparseData = + [ for i in 0UL .. 10UL .. uint64 this.N - 1UL -> (i * 1UL, int i % 100) ] + + sparseVec <- + Vector.fromCoordinateList (Vector.CoordinateList(uint64 this.N * 1UL, sparseData)) + + let denseMatData = + [ for r in 0UL .. uint64 this.N - 1UL do + for c in 0UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] + + denseMat <- + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + uint64 this.N * 1UL, + uint64 this.N * 1UL, + denseMatData + ) + ) - let denseMatData = [ - for r in 0UL .. uint64 this.N - 1UL do - for c in 0UL .. uint64 this.N - 1UL do - (r * 1UL, c * 1UL, int (r + c) % 100) ] - denseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, denseMatData)) + let sparseMatData = + [ for r in 0UL .. 10UL .. uint64 this.N - 1UL do + for c in 0UL .. 10UL .. uint64 this.N - 1UL do + (r * 1UL, c * 1UL, int (r + c) % 100) ] - let sparseMatData = [ - for r in 0UL .. 10UL .. uint64 this.N - 1UL do - for c in 0UL .. 10UL .. uint64 this.N - 1UL do - (r * 1UL, c * 1UL, int (r + c) % 100) ] - sparseMat <- Matrix.fromCoordinateList (Matrix.CoordinateList(uint64 this.N * 1UL, uint64 this.N * 1UL, sparseMatData)) + sparseMat <- + Matrix.fromCoordinateList ( + Matrix.CoordinateList( + uint64 this.N * 1UL, + uint64 this.N * 1UL, + sparseMatData + ) + ) [] member this.VectorForallDense() = - Vector.forall denseVec (fun x -> x > 0) + Vector.forall denseVec (fun x -> x >= 0) [] member this.VectorForallSparse() = - Vector.forall sparseVec (fun x -> x > 0) + Vector.forall sparseVec (fun x -> x >= 0) [] member this.MatrixForallDense() = - Matrix.forall denseMat (fun x -> x > 0) + Matrix.forall denseMat (fun x -> x >= 0) [] member this.MatrixForallSparse() = - Matrix.forall sparseMat (fun x -> x > 0) + Matrix.forall sparseMat (fun x -> x >= 0) diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index b65c53d..e0192a8 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -645,354 +645,492 @@ let ``Fold sum`` () = [] let ``Matrix.filter all pass, none changed`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + let actual = Matrix.filter m (fun x -> x > 0) Assert.Equal(m, actual) [] let ``Matrix.filter none pass, all reset to zero`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - let expected = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, [])) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + let expected = + Matrix.fromCoordinateList (CoordinateList(4UL, 4UL, [])) + let actual = Matrix.filter m (fun x -> x < 0) Assert.Equal(expected, actual) [] let ``Matrix.filter length is not a power of 2, all reset to zero`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) - (2UL, 0UL, 7) - (2UL, 1UL, 8) - (2UL, 2UL, 9) ])) - let expected = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, [])) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) + (2UL, 0UL, 7) + (2UL, 1UL, 8) + (2UL, 2UL, 9) ] + ) + ) + + let expected = + Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) + let actual = Matrix.filter m (fun x -> x < 0) Assert.Equal(expected, actual) [] let ``Matrix.filter some pass, odd set to zero`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (0UL, 3UL, 4) - (1UL, 0UL, 5) - (1UL, 1UL, 6) - (1UL, 2UL, 7) - (1UL, 3UL, 8) - (2UL, 0UL, 9) - (2UL, 1UL, 10) - (2UL, 2UL, 11) - (2UL, 3UL, 12) - (3UL, 0UL, 13) - (3UL, 1UL, 14) - (3UL, 2UL, 15) - (3UL, 3UL, 16) ])) - let expected = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 1UL, 2) - (0UL, 3UL, 4) - (1UL, 1UL, 6) - (1UL, 3UL, 8) - (2UL, 1UL, 10) - (2UL, 3UL, 12) - (3UL, 1UL, 14) - (3UL, 3UL, 16) ])) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (0UL, 3UL, 4) + (1UL, 0UL, 5) + (1UL, 1UL, 6) + (1UL, 2UL, 7) + (1UL, 3UL, 8) + (2UL, 0UL, 9) + (2UL, 1UL, 10) + (2UL, 2UL, 11) + (2UL, 3UL, 12) + (3UL, 0UL, 13) + (3UL, 1UL, 14) + (3UL, 2UL, 15) + (3UL, 3UL, 16) ] + ) + ) + + let expected = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 1UL, 2) + (0UL, 3UL, 4) + (1UL, 1UL, 6) + (1UL, 3UL, 8) + (2UL, 1UL, 10) + (2UL, 3UL, 12) + (3UL, 1UL, 14) + (3UL, 3UL, 16) ] + ) + ) + let actual = Matrix.filter m (fun x -> x % 2 = 0) Assert.Equal(expected, actual) [] let ``Matrix.filter length is not a power of 2, not all reset to zero`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) - (2UL, 0UL, 7) - (2UL, 1UL, 8) - (2UL, 2UL, 9) ])) - let expected = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 1UL, 2) - (1UL, 0UL, 4) - (1UL, 2UL, 6) - (2UL, 1UL, 8) ])) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) + (2UL, 0UL, 7) + (2UL, 1UL, 8) + (2UL, 2UL, 9) ] + ) + ) + + let expected = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 1UL, 2) + (1UL, 0UL, 4) + (1UL, 2UL, 6) + (2UL, 1UL, 8) ] + ) + ) + let actual = Matrix.filter m (fun x -> x % 2 = 0) Assert.Equal(expected, actual) [] let ``Matrix.filter none pass, length is not a power of 2, none changed`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, [])) + let m = Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) let actual = Matrix.filter m (fun x -> x > 0) Assert.Equal(m, actual) [] let ``Matrix.filter none pass, length is a power of 2, none changed`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, [])) + let m = Matrix.fromCoordinateList (CoordinateList(4UL, 4UL, [])) let actual = Matrix.filter m (fun x -> x > 0) Assert.Equal(m, actual) [] let ``Matrix.filter single element, passes`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, - [ (0UL, 0UL, 1) ])) - let expected = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, - [ (0UL, 0UL, 1) ])) + let m = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + + let expected = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + let actual = Matrix.filter m (fun x -> x > 0) Assert.Equal(expected, actual) [] let ``Matrix.filter single element, fails`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, - [ (0UL, 0UL, 1) ])) - let expected = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, [])) + let m = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + + let expected = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [])) + let actual = Matrix.filter m (fun x -> x < 0) Assert.Equal(expected, actual) [] let ``Matrix.exists the first element fits, length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.True (Matrix.exists m (fun x -> x = 1)) - Assert.False (Matrix.exists m (fun x -> x = 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.True(Matrix.exists m (fun x -> x = 1)) + Assert.False(Matrix.exists m (fun x -> x = 10)) [] let ``Matrix.exists the first element fits, length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.True (Matrix.exists m (fun x -> x = 1)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.True(Matrix.exists m (fun x -> x = 1)) [] let ``Matrix.exists no element fits, length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.False (Matrix.exists m (fun x -> x = 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.False(Matrix.exists m (fun x -> x = 10)) [] let ``Matrix.exists no element fits, length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.False (Matrix.exists m (fun x -> x = 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.False(Matrix.exists m (fun x -> x = 10)) [] let ``Matrix.exists empty matrix`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, [])) - Assert.False (Matrix.exists m (fun x -> x = 1)) + let m = Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) + Assert.False(Matrix.exists m (fun x -> x = 1)) [] let ``Matrix.exists single element, fits`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, - [ (0UL, 0UL, 1) ])) - Assert.True (Matrix.exists m (fun x -> x = 1)) + let m = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + + Assert.True(Matrix.exists m (fun x -> x = 1)) [] let ``Matrix.exists single element, does not fit`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, - [ (0UL, 0UL, 1) ])) - Assert.False (Matrix.exists m (fun x -> x = 10)) + let m = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + + Assert.False(Matrix.exists m (fun x -> x = 10)) [] let ``Matrix.exists all elements fit,length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.True (Matrix.exists m (fun x -> x > 0)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.True(Matrix.exists m (fun x -> x > 0)) [] let ``Matrix.exists all elements fit,length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.True (Matrix.exists m (fun x -> x > 0)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.True(Matrix.exists m (fun x -> x > 0)) + [] let ``Matrix.exists some elements fit, length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.True (Matrix.exists m (fun x -> x = 2 || x = 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.True(Matrix.exists m (fun x -> x = 2 || x = 10)) [] let ``Matrix.exists some elements fit, length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.True (Matrix.exists m (fun x -> x = 2 || x = 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.True(Matrix.exists m (fun x -> x = 2 || x = 10)) [] let ``Matrix.forall the first element fits, length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.True (Matrix.forall m (fun x -> x > 0)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.True(Matrix.forall m (fun x -> x > 0)) [] let ``Matrix.forall the first element fits, length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.True (Matrix.forall m (fun x -> x > 0)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.True(Matrix.forall m (fun x -> x > 0)) [] let ``Matrix.forall no element fits, length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.False (Matrix.forall m (fun x -> x > 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.False(Matrix.forall m (fun x -> x > 10)) [] let ``Matrix.forall no element fits, length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.False (Matrix.forall m (fun x -> x > 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.False(Matrix.forall m (fun x -> x > 10)) [] let ``Matrix.forall all elements fit,length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.True (Matrix.forall m (fun x -> x > 0)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.True(Matrix.forall m (fun x -> x > 0)) [] let ``Matrix.forall all elements fit,length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.True (Matrix.forall m (fun x -> x > 0)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.True(Matrix.forall m (fun x -> x > 0)) [] let ``Matrix.forall some elements fit, length is a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(4UL, 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ])) - Assert.False (Matrix.forall m (fun x -> x = 2 || x = 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + ) + ) + + Assert.False(Matrix.forall m (fun x -> x = 2 || x = 10)) [] let ``Matrix.forall some elements fit, length is not a power of 2`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ])) - Assert.False (Matrix.forall m (fun x -> x = 2 || x = 10)) + let m = + Matrix.fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (1UL, 0UL, 4) + (1UL, 1UL, 5) + (1UL, 2UL, 6) ] + ) + ) + + Assert.False(Matrix.forall m (fun x -> x = 2 || x = 10)) [] let ``Matrix.forall empty matrix`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(3UL, 3UL, [])) - Assert.True (Matrix.forall m (fun x -> x = 1)) + let m = Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) + Assert.True(Matrix.forall m (fun x -> x = 1)) [] let ``Matrix.forall single element, fits`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, - [ (0UL, 0UL, 1) ])) - Assert.True (Matrix.forall m (fun x -> x = 1)) + let m = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + + Assert.True(Matrix.forall m (fun x -> x = 1)) [] let ``Matrix.forall single element, does not fit`` () = - let m = Matrix.fromCoordinateList ( - CoordinateList(1UL, 1UL, - [ (0UL, 0UL, 1) ])) - Assert.False (Matrix.forall m (fun x -> x = 10)) \ No newline at end of file + let m = + Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + + Assert.False(Matrix.forall m (fun x -> x = 10)) diff --git a/QuadTree.Tests/Tests.Vector.fs b/QuadTree.Tests/Tests.Vector.fs index 6ef2cbd..9349656 100644 --- a/QuadTree.Tests/Tests.Vector.fs +++ b/QuadTree.Tests/Tests.Vector.fs @@ -907,382 +907,472 @@ let ``Init vector`` () = [] let ``Vector.filter all pass, none changed`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + let actual = Vector.filter v (fun x -> x > 0) Assert.Equal(v, actual) [] let ``Vector.filter none pass, all reset to zero`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - let expected = - Vector.empty 8UL + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + let expected = Vector.empty 8UL let actual = Vector.filter v (fun x -> x < 0) - + Assert.Equal(expected, actual) [] let ``Vector.filter length is not a power of 2, all reset to zero`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - let expected = - Vector.empty 6UL + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + let expected = Vector.empty 6UL let actual = Vector.filter v (fun x -> x < 0) Assert.Equal(expected, actual) [] let ``Vector.filter some pass, odd set to zero`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - let expected = + let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (1UL, 2) + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) (3UL, 4) + (4UL, 5) (5UL, 6) - (7UL, 8) ])) + (6UL, 7) + (7UL, 8) ] + ) + ) + + let expected = + Vector.fromCoordinateList ( + CoordinateList(8UL, [ (1UL, 2); (3UL, 4); (5UL, 6); (7UL, 8) ]) + ) + let actual = Vector.filter v (fun x -> ((x % 2) = 0)) - + Assert.Equal(expected, actual) [] let ``Vector.filter length is not a power of 2, not all reset to zero`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - let expected = + let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (1UL, 2) + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) (3UL, 4) - (5UL, 6) ])) + (4UL, 5) + (5UL, 6) ] + ) + ) + + let expected = + Vector.fromCoordinateList ( + CoordinateList(6UL, [ (1UL, 2); (3UL, 4); (5UL, 6) ]) + ) + let actual = Vector.filter v (fun x -> ((x % 2) = 0)) - + Assert.Equal(expected, actual) [] let ``Vector.filter none pass, length is not a power of 2, none changed`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [])) + let v = Vector.fromCoordinateList (CoordinateList(6UL, [])) let actual = Vector.filter v (fun x -> x > 0) Assert.Equal(v, actual) - + [] let ``Vector.filter none pass, length is a power of 2, none changed`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [])) + let v = Vector.fromCoordinateList (CoordinateList(8UL, [])) let actual = Vector.filter v (fun x -> x > 0) Assert.Equal(v, actual) - + [] let ``Vector.filter single element, passes`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(1UL, - [ (0UL, 1) ])) + let v = + Vector.fromCoordinateList (CoordinateList(1UL, [ (0UL, 1) ])) + let expected = - Vector.fromCoordinateList ( - CoordinateList(1UL, - [ (0UL, 1) ])) + Vector.fromCoordinateList (CoordinateList(1UL, [ (0UL, 1) ])) + let actual = Vector.filter v (fun x -> x > 0) - + Assert.Equal(expected, actual) [] let ``Vector.filter single element, fails`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(1UL, - [ (0UL, 1) ])) - let expected = - Vector.empty 1UL + let v = + Vector.fromCoordinateList (CoordinateList(1UL, [ (0UL, 1) ])) + + let expected = Vector.empty 1UL let actual = Vector.filter v (fun x -> x < 0) Assert.Equal(expected, actual) [] let ``Vector.exists the first element fits, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.True (Vector.exists v (fun x -> x > 0)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.True(Vector.exists v (fun x -> x > 0)) [] let ``Vector.exists the first element fits, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.True (Vector.exists v (fun x -> x > 0)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.True(Vector.exists v (fun x -> x > 0)) [] let ``Vector.exists the last item fits, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.True (Vector.exists v (fun x -> x > 7)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.True(Vector.exists v (fun x -> x > 7)) [] let ``Vector.exists the last item fits, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.True (Vector.exists v (fun x -> x > 5)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.True(Vector.exists v (fun x -> x > 5)) [] let ``Vector.exists empty list`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [])) - Assert.False (Vector.exists v (fun x -> x > 0)) + let v = Vector.fromCoordinateList (CoordinateList(8UL, [])) + Assert.False(Vector.exists v (fun x -> x > 0)) [] let ``Vector.exists no matching elements, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.False (Vector.exists v (fun x -> x > 8)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.False(Vector.exists v (fun x -> x > 8)) [] let ``Vector.exists no matching elements, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.False (Vector.exists v (fun x -> x > 6)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.False(Vector.exists v (fun x -> x > 6)) [] let ``Vector.exists single element matches`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(1UL, - [ (0UL, 1) ])) - Assert.True (Vector.exists v (fun x -> x = 1)) + let v = + Vector.fromCoordinateList (CoordinateList(1UL, [ (0UL, 1) ])) + + Assert.True(Vector.exists v (fun x -> x = 1)) [] let ``Vector.exists single element does not match`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(1UL, - [ (0UL, 1) ])) - Assert.False (Vector.exists v (fun x -> x = 2)) + let v = + Vector.fromCoordinateList (CoordinateList(1UL, [ (0UL, 1) ])) + + Assert.False(Vector.exists v (fun x -> x = 2)) [] let ``Vector.exists all elements match, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.True (Vector.exists v (fun x -> x > 0)) - -[] -let ``Vector.exists all elements match, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.True (Vector.exists v (fun x -> x > 0)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.True(Vector.exists v (fun x -> x > 0)) + +[] +let ``Vector.exists all elements match, length is not a power of 2`` () = + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.True(Vector.exists v (fun x -> x > 0)) [] let ``Vector.forall the first element not fits, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.False (Vector.forall v (fun x -> x > 1)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.False(Vector.forall v (fun x -> x > 1)) [] let ``Vector.forall the first element not fits, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.False (Vector.forall v (fun x -> x > 1)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.False(Vector.forall v (fun x -> x > 1)) [] let ``Vector.forall the last item not fits, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.False (Vector.forall v (fun x -> x < 8)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.False(Vector.forall v (fun x -> x < 8)) [] let ``Vector.forall the last item not fits, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.False (Vector.forall v (fun x -> x < 6)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.False(Vector.forall v (fun x -> x < 6)) [] let ``Vector.forall empty list`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [])) - Assert.True (Vector.forall v (fun x -> x > 0)) + let v = Vector.fromCoordinateList (CoordinateList(8UL, [])) + Assert.True(Vector.forall v (fun x -> x > 0)) [] let ``Vector.forall no matching elements, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.False (Vector.forall v (fun x -> x > 8)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.False(Vector.forall v (fun x -> x > 8)) [] let ``Vector.forall no matching elements, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.False (Vector.forall v (fun x -> x > 6)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.False(Vector.forall v (fun x -> x > 6)) [] let ``Vector.forall single element matches`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(1UL, - [ (0UL, 1) ])) - Assert.True (Vector.forall v (fun x -> x = 1)) + let v = + Vector.fromCoordinateList (CoordinateList(1UL, [ (0UL, 1) ])) + + Assert.True(Vector.forall v (fun x -> x = 1)) [] let ``Vector.forall single element does not match`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(1UL, - [ (0UL, 1) ])) - Assert.False (Vector.forall v (fun x -> x = 2)) + let v = + Vector.fromCoordinateList (CoordinateList(1UL, [ (0UL, 1) ])) + + Assert.False(Vector.forall v (fun x -> x = 2)) [] let ``Vector.forall all elements match, length is a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(8UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) - (6UL, 7) - (7UL, 8) ])) - Assert.True (Vector.forall v (fun x -> x > 0)) - -[] -let ``Vector.forall all elements match, length is not a power of 2`` () = - let v = Vector.fromCoordinateList ( - CoordinateList(6UL, - [ (0UL, 1) - (1UL, 2) - (2UL, 3) - (3UL, 4) - (4UL, 5) - (5UL, 6) ])) - Assert.True (Vector.forall v (fun x -> x > 0)) + let v = + Vector.fromCoordinateList ( + CoordinateList( + 8UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) + (6UL, 7) + (7UL, 8) ] + ) + ) + + Assert.True(Vector.forall v (fun x -> x > 0)) + +[] +let ``Vector.forall all elements match, length is not a power of 2`` () = + let v = + Vector.fromCoordinateList ( + CoordinateList( + 6UL, + [ (0UL, 1) + (1UL, 2) + (2UL, 3) + (3UL, 4) + (4UL, 5) + (5UL, 6) ] + ) + ) + + Assert.True(Vector.forall v (fun x -> x > 0)) diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index 47bade8..e78adf7 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -417,7 +417,7 @@ let filter (matrix: SparseMatrix<'a>) (predicate: 'a -> bool) : SparseMatrix<'a> Leaf(UserValue(Some v)), (uint64 size) * (uint64 size) * 1UL else Leaf(UserValue(None)), 0UL - + let storage, nvals = inner 0UL 0UL matrix.storage.size matrix.storage.data @@ -429,8 +429,7 @@ let exists (matrix: SparseMatrix<'a>) (predicate: 'a -> bool) : bool = | Leaf(Dummy) -> false | Leaf(UserValue(None)) -> false | Leaf(UserValue(Some(v))) -> predicate v - | Node(nw, ne, sw, se) -> - inner nw || inner ne || inner sw || inner se + | Node(nw, ne, sw, se) -> inner nw || inner ne || inner sw || inner se inner matrix.storage.data @@ -440,7 +439,6 @@ let forall (matrix: SparseMatrix<'a>) (predicate: 'a -> bool) : bool = | Leaf(Dummy) -> true | Leaf(UserValue(None)) -> true | Leaf(UserValue(Some(v))) -> predicate v - | Node(nw, ne, sw, se) -> - inner nw && inner ne && inner sw && inner se + | Node(nw, ne, sw, se) -> inner nw && inner ne && inner sw && inner se - inner matrix.storage.data \ No newline at end of file + inner matrix.storage.data diff --git a/QuadTree/Vector.fs b/QuadTree/Vector.fs index 6ea0ee4..00e7f2a 100644 --- a/QuadTree/Vector.fs +++ b/QuadTree/Vector.fs @@ -589,7 +589,7 @@ let exists (vector: SparseVector<'a>) (predicate: 'a -> bool) : bool = | Node(x1, x2) -> inner x1 || inner x2 inner vector.storage.data - + let forall (vector: SparseVector<'a>) (predicate: 'a -> bool) : bool = let rec inner vector = match vector with @@ -598,4 +598,4 @@ let forall (vector: SparseVector<'a>) (predicate: 'a -> bool) : bool = | Leaf(UserValue(Some(v))) -> predicate v | Node(x1, x2) -> inner x1 && inner x2 - inner vector.storage.data \ No newline at end of file + inner vector.storage.data From 52f9ae74bf731ab824d138559c31de092aafc14a Mon Sep 17 00:00:00 2001 From: Narysev Date: Thu, 17 Sep 2026 15:04:29 +0300 Subject: [PATCH 03/13] Fix COO map/get/mapi/map/map2 on dense data, add COO tests --- QuadTree.Tests/Tests.COO.fs | 643 ++++++++++++++++++++++++++++++++++++ QuadTree/COO.fs | 284 ++++++++++++++++ 2 files changed, 927 insertions(+) create mode 100644 QuadTree.Tests/Tests.COO.fs create mode 100644 QuadTree/COO.fs diff --git a/QuadTree.Tests/Tests.COO.fs b/QuadTree.Tests/Tests.COO.fs new file mode 100644 index 0000000..2075f94 --- /dev/null +++ b/QuadTree.Tests/Tests.COO.fs @@ -0,0 +1,643 @@ +module COO.Tests + +open System +open Xunit + +open Matrix +open COO +open Common + +let op_add x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | _ -> None + +let op_mult x y = + match (x, y) with + | Some(a), Some(b) -> Some(a * b) + | _ -> None + +// === cooGet tests === + +[] +let ``cooGet existing value`` () = + let coo = + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) ] + ) + + let actual = cooGet (coo, 0UL, 1UL) + + Assert.Equal(Ok(Some 2), actual) + +[] +let ``cooGet missing value`` () = + let coo = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let actual = cooGet (coo, 2UL, 2UL) + + Assert.Equal(Ok None, actual) + +[] +let ``cooGet out of bounds`` () = + let coo = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) + + let actual = cooGet (coo, 5UL, 5UL) + + Assert.Equal(Error Error.InvalidElementIndex, actual) + +// === cooUpdate tests === + +[] +let ``cooUpdate replaces existing`` () = + let coo = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let expected = + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 99); (1UL, 1UL, 2) ] + ) + + let actual = cooUpdate (coo, 0UL, 0UL, 99) + + Assert.Equal(Ok expected, actual) + +[] +let ``cooUpdate inserts new in middle`` () = + let coo = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (2UL, 2UL, 2) ]) + + let expected = + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1) + (1UL, 1UL, 10) + (2UL, 2UL, 2) ] + ) + + let actual = cooUpdate (coo, 1UL, 1UL, 10) + + Assert.Equal(Ok expected, actual) + +[] +let ``cooUpdate inserts at end`` () = + let coo = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) + + let expected = + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1); (3UL, 3UL, 20) ] + ) + + let actual = cooUpdate (coo, 3UL, 3UL, 20) + + Assert.Equal(Ok expected, actual) + +[] +let ``cooUpdate out of bounds`` () = + let coo = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) + + let actual = cooUpdate (coo, 5UL, 5UL, 99) + + Assert.Equal(Error Error.InvalidElementIndex, actual) + +// === cooMap tests === + +[] +let ``cooMap doubles values`` () = + let nrows = 4UL + let ncols = 4UL + + let data = + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + |> List.sort + + let coo = CoordinateList(nrows, ncols, data) + + let f v = v |> Option.map (fun v -> v * 2) + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 0UL, 2) + (0UL, 1UL, 4) + (1UL, 0UL, 6) + (1UL, 1UL, 8) ] + ) + + let actual = cooMap coo f + + Assert.Equal(expected, actual) + +[] +let ``cooMap filters None results`` () = + let nrows = 4UL + let ncols = 4UL + + let data = + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 0UL, 3) + (1UL, 1UL, 4) ] + + let coo = CoordinateList(nrows, ncols, data) + + let f v = + v |> Option.bind (fun v -> + match v with + | 1 -> None + | _ -> Some(v * 10)) + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 1UL, 20) + (1UL, 0UL, 30) + (1UL, 1UL, 40) ] + ) + + let actual = cooMap coo f + + Assert.Equal(expected, actual) + +[] +let ``cooMap fills missing cells (general form)`` () = + let nrows = 3UL + let ncols = 3UL + + let data = [ (0UL, 0UL, 1); (2UL, 2UL, 5) ] + + let coo = CoordinateList(nrows, ncols, data) + + let f v = Some(defaultArg v 0) + + let actual = cooMap coo f + + Assert.Equal(nrows, actual.nrows) + Assert.Equal(ncols, actual.ncols) + Assert.Equal(9, actual.list.Length) + Assert.Equal(List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Some(2UL, 2UL, 5)) + +[] +let ``cooMap zero-size matrix`` () = + let coo = CoordinateList(0UL, 0UL, []) + let f v = v |> Option.map (fun v -> v * 2) + let actual = cooMap coo f + let expected = CoordinateList(0UL, 0UL, []) + Assert.Equal(expected, actual) + +// === cooMap2 tests === + +[] +let ``cooMap2 addition`` () = + let nrows = 10UL + let ncols = 12UL + + let d1 = + [ (0UL, 3UL, 4) + (3UL, 11UL, 2) + (9UL, 2UL, 5) ] + |> List.sort + + let d2 = + [ (0UL, 3UL, 6) + (3UL, 3UL, 33) + (3UL, 11UL, -1) ] + |> List.sort + + let f x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None -> Some a + | None, Some b -> Some b + | _ -> None + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 3UL, 10) + (3UL, 3UL, 33) + (9UL, 2UL, 5) + (3UL, 11UL, 1) ] + |> List.sort + ) + + let c1 = CoordinateList(nrows, ncols, d1) + let c2 = CoordinateList(nrows, ncols, d2) + + let actual = cooMap2 c1 c2 f + + Assert.Equal(expected, actual) + +[] +let ``cooMap2 with mismatched positions`` () = + let nrows = 4UL + let ncols = 4UL + + let d1 = [ (0UL, 0UL, 1); (2UL, 2UL, 3) ] + + let d2 = [ (1UL, 1UL, 10); (3UL, 3UL, 30) ] + + let f x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None -> Some(a + 100) + | None, Some b -> Some(b + 200) + | _ -> None + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 0UL, 101) + (1UL, 1UL, 210) + (2UL, 2UL, 103) + (3UL, 3UL, 230) ] + ) + + let c1 = CoordinateList(nrows, ncols, d1) + let c2 = CoordinateList(nrows, ncols, d2) + + let actual = cooMap2 c1 c2 f + + Assert.Equal(expected, actual) + +[] +let ``cooMap2 dense filters None from existing entries`` () = + let nrows = 4UL + let ncols = 4UL + + let d1 = [ (0UL, 0UL, 1); (1UL, 1UL, 2) ] + let d2 = [ (0UL, 0UL, 10); (2UL, 2UL, 30) ] + + let f x y = + match x, y with + | Some a, Some b when a + b > 5 -> None + | Some a, Some b -> Some(a + b) + | Some a, None -> Some a + | None, Some b -> Some b + | None, None -> Some 0 + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 1UL, 0) + (0UL, 2UL, 0) + (0UL, 3UL, 0) + (1UL, 0UL, 0) + (1UL, 1UL, 2) + (1UL, 2UL, 0) + (1UL, 3UL, 0) + (2UL, 0UL, 0) + (2UL, 1UL, 0) + (2UL, 2UL, 30) + (2UL, 3UL, 0) + (3UL, 0UL, 0) + (3UL, 1UL, 0) + (3UL, 2UL, 0) + (3UL, 3UL, 0) ] + ) + + let c1 = CoordinateList(nrows, ncols, d1) + let c2 = CoordinateList(nrows, ncols, d2) + + let actual = cooMap2 c1 c2 f + + Assert.Equal(expected, actual) + +// === cooMapi tests === + +[] +let ``cooMapi position-dependent values`` () = + let nrows = 4UL + let ncols = 4UL + + let data = + [ (0UL, 0UL, 1) + (1UL, 1UL, 2) + (2UL, 3UL, 3) ] + |> List.sort + + let coo = CoordinateList(nrows, ncols, data) + + let f i j v = v |> Option.map (fun v -> v + (int (uint64 i))) + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 0UL, 1) + (1UL, 1UL, 3) + (2UL, 3UL, 5) ] + ) + + let actual = cooMapi coo f + + Assert.Equal(expected, actual) + +[] +let ``cooMapi filters None results`` () = + let nrows = 4UL + let ncols = 4UL + + let data = + [ (0UL, 0UL, 1) + (0UL, 1UL, 5) + (1UL, 0UL, 3) ] + + let coo = CoordinateList(nrows, ncols, data) + + let f _i _j v = v |> Option.bind (fun v -> if v > 2 then Some(v * 10) else None) + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 1UL, 50) + (1UL, 0UL, 30) ] + ) + + let actual = cooMapi coo f + + Assert.Equal(expected, actual) + +[] +let ``cooMapi empty input`` () = + let coo = CoordinateList(4UL, 4UL, []) + let f _i _j v = v |> Option.map (fun v -> v * 2) + let actual = cooMapi coo f + let expected = CoordinateList(4UL, 4UL, []) + Assert.Equal(expected, actual) + +[] +let ``cooMapi fills missing cells (general form)`` () = + let nrows = 3UL + let ncols = 3UL + + let data = [ (0UL, 0UL, 1); (2UL, 2UL, 5) ] + let coo = CoordinateList(nrows, ncols, data) + + let f _i _j v = Some(defaultArg v 0) + + let actual = cooMapi coo f + + Assert.Equal(nrows, actual.nrows) + Assert.Equal(ncols, actual.ncols) + Assert.Equal(9, actual.list.Length) + Assert.Equal(List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Some(2UL, 2UL, 5)) + +[] +let ``cooMapi position-dependent fill of missing cells`` () = + let nrows = 2UL + let ncols = 2UL + + let data = [ (0UL, 0UL, 7) ] + let coo = CoordinateList(nrows, ncols, data) + + let f i j v = + match v with + | Some x -> Some x + | None -> Some(int (uint64 i + uint64 j)) + + let actual = cooMapi coo f + + let expected = + [ (0UL, 0UL, 7) + (0UL, 1UL, 1) + (1UL, 0UL, 1) + (1UL, 1UL, 2) ] + + Assert.Equal * uint64 * int>>(expected, actual.list) + +[] +let ``cooMapi zero-size matrix`` () = + let coo = CoordinateList(0UL, 0UL, []) + let f _i _j v = v |> Option.map (fun v -> v * 2) + let actual = cooMapi coo f + let expected = CoordinateList(0UL, 0UL, []) + Assert.Equal(expected, actual) + +// === cooMap2i tests === + +[] +let ``cooMap2i position-dependent addition`` () = + let nrows = 4UL + let ncols = 4UL + + let d1 = [ (0UL, 0UL, 1); (2UL, 2UL, 3) ] + let d2 = [ (0UL, 0UL, 10); (2UL, 2UL, 30) ] + + let f i j x y = + match x, y with + | Some a, Some b -> Some(a + b + (int (uint64 i))) + | Some a, None -> Some a + | None, Some b -> Some b + | _ -> None + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 0UL, 11) + (2UL, 2UL, 35) ] + ) + + let c1 = CoordinateList(nrows, ncols, d1) + let c2 = CoordinateList(nrows, ncols, d2) + let actual = cooMap2i c1 c2 f + + Assert.Equal(expected, actual) + +[] +let ``cooMap2i mismatched positions with index`` () = + let nrows = 4UL + let ncols = 4UL + + let d1 = [ (0UL, 0UL, 1); (2UL, 2UL, 3) ] + let d2 = [ (1UL, 1UL, 10); (3UL, 3UL, 30) ] + + let f i j x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None -> Some(a + (int (uint64 j))) + | None, Some b -> Some(b + (int (uint64 i))) + | _ -> None + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 0UL, 1) + (1UL, 1UL, 11) + (2UL, 2UL, 5) + (3UL, 3UL, 33) ] + ) + + let c1 = CoordinateList(nrows, ncols, d1) + let c2 = CoordinateList(nrows, ncols, d2) + let actual = cooMap2i c1 c2 f + + Assert.Equal(expected, actual) + +[] +let ``cooMap2i filters None results`` () = + let nrows = 4UL + let ncols = 4UL + + let d1 = [ (0UL, 0UL, 1); (1UL, 1UL, 2) ] + let d2 = [ (0UL, 0UL, 2); (2UL, 2UL, 30) ] + + let f i j x y = + match x, y with + | Some a, Some b when a + b > 5 -> None + | Some a, Some b -> Some(a + b) + | _ -> None + + let expected = + CoordinateList( + nrows, + ncols, + [ (0UL, 0UL, 3) ] + ) + + let c1 = CoordinateList(nrows, ncols, d1) + let c2 = CoordinateList(nrows, ncols, d2) + let actual = cooMap2i c1 c2 f + + Assert.Equal(expected, actual) + +[] +let ``cooMap2i empty inputs`` () = + let c1 = CoordinateList(4UL, 4UL, []) + let c2 = CoordinateList(4UL, 4UL, []) + let f _i _j x y = None + let actual = cooMap2i c1 c2 f + let expected = CoordinateList(4UL, 4UL, []) + Assert.Equal(expected, actual) + +// === mxmcoo tests === + +[] +let ``Sparse mxmcoo`` () = + let m1 = + let d = + [ 0UL, 0UL, 1 + 1UL, 1UL, 2 + 2UL, 2UL, 3 ] + + CoordinateList(3UL, 3UL, d) + + let m2 = + let d = + [ 0UL, 0UL, 3 + 1UL, 1UL, 2 + 2UL, 2UL, 1 ] + + CoordinateList(3UL, 3UL, d) + + let expected = + let d = + [ 0UL, 0UL, 3 + 1UL, 1UL, 4 + 2UL, 2UL, 3 ] + + CoordinateList(3UL, 3UL, d) + + match COO.mxmcoo op_add op_mult m1 m2 with + | Ok actual -> + Assert.Equal(expected.nrows, actual.nrows) + Assert.Equal(expected.ncols, actual.ncols) + Assert.Equal>(expected.list, actual.list) + | Error e -> failwith (e.ToString()) + +[] +let ``Shrinking mxmcoo`` () = + let m1 = + let d = + [ 0UL, 0UL, 1 + 0UL, 2UL, 2 + 1UL, 1UL, 3 ] + + CoordinateList(2UL, 3UL, d) + + let m2 = + let d = + [ 0UL, 1UL, 4 + 1UL, 0UL, 5 + 2UL, 0UL, 6 ] + + CoordinateList(3UL, 2UL, d) + + let expected = + let d = + [ 0UL, 0UL, 12 + 0UL, 1UL, 4 + 1UL, 0UL, 15 ] + + CoordinateList(2UL, 2UL, d) + + match COO.mxmcoo op_add op_mult m1 m2 with + | Ok actual -> + Assert.Equal(expected.nrows, actual.nrows) + Assert.Equal(expected.ncols, actual.ncols) + Assert.Equal>(expected.list, actual.list) + | Error e -> failwith (e.ToString()) + + +[] +let ``mxmcoo with non-absorbing op_mult`` () = + let op_add x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b) + | Some a, _ | _, Some a -> Some a + | _ -> None + + let op_mult x y = + match (x, y) with + | Some(a), Some(b) -> Some(a * b) + | Some a, _ | _, Some a -> Some a + | _ -> None + + let m1 = + let d = + [ 0UL, 0UL, 1 + 0UL, 1UL, 2 ] + + CoordinateList(1UL, 2UL, d) + + let m2 = + let d = + [ 0UL, 0UL, 3 ] + + CoordinateList(2UL, 1UL, d) + + match COO.mxmcoo op_add op_mult m1 m2 with + | Ok actual -> + Assert.Equal(1UL, actual.nrows) + Assert.Equal(1UL, actual.ncols) + Assert.Equal(1, actual.list.Length) + Assert.Equal(Some 5, actual.list |> List.tryHead |> Option.map (fun (_, _, v) -> v)) + | Error e -> failwith (e.ToString()) diff --git a/QuadTree/COO.fs b/QuadTree/COO.fs new file mode 100644 index 0000000..26f792c --- /dev/null +++ b/QuadTree/COO.fs @@ -0,0 +1,284 @@ +module COO + +open Common +open Matrix + +let private range (count: uint64) = + if count = 0UL then [] else [ 0UL .. count - 1UL ] + +let cooGet + (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64) + : Result, Error> = + if uint64 rowindex >= uint64 coo.nrows || uint64 colindex >= uint64 coo.ncols then + Error Error.InvalidElementIndex + else + match coo.list |> List.tryFind (fun (i, j, _) -> i = rowindex && j = colindex) with + | Some(_, _, value) -> Ok(Some value) + | None -> Ok None + +let cooUpdate + (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64, value: 'a) + : Result, Error> = + if uint64 rowindex >= uint64 coo.nrows || uint64 colindex >= uint64 coo.ncols then + Error Error.InvalidElementIndex + else + let mutable acc = [] + let mutable rest = coo.list + let mutable inserted = false + + while rest <> [] && not inserted do + let (i, j, v) = rest.Head + + if i = rowindex && j = colindex then + acc <- (rowindex, colindex, value) :: acc + rest <- rest.Tail + inserted <- true + elif rowindex < i || (rowindex = i && colindex < j) then + acc <- (rowindex, colindex, value) :: acc + inserted <- true + else + acc <- (i, j, v) :: acc + rest <- rest.Tail + + if not inserted then + acc <- (rowindex, colindex, value) :: acc + + while rest <> [] do + let entry = rest.Head + acc <- entry :: acc + rest <- rest.Tail + + Ok(CoordinateList(coo.nrows, coo.ncols, List.rev acc)) + + +let cooMap (coo: CoordinateList<'a>) f = + let updatedList = coo.list |> List.map (fun (i, j, v) -> (i, j, f (Some v))) + + let result = + match f None with + | None -> + updatedList + |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) + | Some fnone -> + let lookup = + updatedList + |> List.map (fun (i, j, v) -> ((i, j), v)) + |> Map.ofList + + [ for i in range (uint64 coo.nrows) do + let ri = i * 1UL + + for j in range (uint64 coo.ncols) do + let cj = j * 1UL + + match Map.tryFind (ri, cj) lookup with + | Some(Some value) -> yield (ri, cj, value) + | Some None -> () + | None -> yield (ri, cj, fnone) ] + + CoordinateList(coo.nrows, coo.ncols, result) + +let cooMapi (coo: CoordinateList<'a>) f = + let lookup = + coo.list + |> List.map (fun (i, j, v) -> ((i, j), v)) + |> Map.ofList + + let result = + [ for i in range (uint64 coo.nrows) do + let ri = i * 1UL + + for j in range (uint64 coo.ncols) do + let cj = j * 1UL + + let res = f ri cj (Map.tryFind (ri, cj) lookup) + + match res with + | Some value -> yield (ri, cj, value) + | None -> () ] + + CoordinateList(coo.nrows, coo.ncols, result) + +let cooMap2 (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + let mutable acc = [] + let mutable l1 = coo1.list + let mutable l2 = coo2.list + + while l1 <> [] || l2 <> [] do + match l1, l2 with + | [], [] -> () + | (i1, j1, v1) :: t1, [] -> + let r = f (Some v1) None + acc <- (i1, j1, r) :: acc + l1 <- t1 + | [], (i2, j2, v2) :: t2 -> + let r = f None (Some v2) + acc <- (i2, j2, r) :: acc + l2 <- t2 + | (i1, j1, v1) :: t1, (i2, j2, v2) :: t2 -> + if i1 = i2 && j1 = j2 then + let r = f (Some v1) (Some v2) + acc <- (i1, j1, r) :: acc + l1 <- t1 + l2 <- t2 + elif (i1, j1) < (i2, j2) then + let r = f (Some v1) None + acc <- (i1, j1, r) :: acc + l1 <- t1 + else + let r = f None (Some v2) + acc <- (i2, j2, r) :: acc + l2 <- t2 + + let updatedList = List.rev acc + + let result = + match f None None with + | None -> + updatedList + |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) + | Some fnone -> + let lookup = + updatedList + |> List.map (fun (i, j, v) -> ((i, j), v)) + |> Map.ofList + + [ for i in range (uint64 coo1.nrows) do + let ri = i * 1UL + + for j in range (uint64 coo1.ncols) do + let cj = j * 1UL + + match Map.tryFind (ri, cj) lookup with + | Some(Some value) -> yield (ri, cj, value) + | Some None -> () + | None -> yield (ri, cj, fnone) ] + + CoordinateList(coo1.nrows, coo1.ncols, result) + +let cooMap2i (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + let mutable acc = [] + let mutable l1 = coo1.list + let mutable l2 = coo2.list + + while l1 <> [] || l2 <> [] do + match l1, l2 with + | [], [] -> () + | (i1, j1, v1) :: t1, [] -> + let r = f i1 j1 (Some v1) None + acc <- (i1, j1, r) :: acc + l1 <- t1 + | [], (i2, j2, v2) :: t2 -> + let r = f i2 j2 None (Some v2) + acc <- (i2, j2, r) :: acc + l2 <- t2 + | (i1, j1, v1) :: t1, (i2, j2, v2) :: t2 -> + if i1 = i2 && j1 = j2 then + let r = f i1 j1 (Some v1) (Some v2) + acc <- (i1, j1, r) :: acc + l1 <- t1 + l2 <- t2 + elif (i1, j1) < (i2, j2) then + let r = f i1 j1 (Some v1) None + acc <- (i1, j1, r) :: acc + l1 <- t1 + else + let r = f i2 j2 None (Some v2) + acc <- (i2, j2, r) :: acc + l2 <- t2 + + let result = + List.rev acc + |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) + + CoordinateList(coo1.nrows, coo1.ncols, result) + +let mxmcoo + (op_add: 'c option -> 'c option -> 'c option) + (op_mult: 'a option -> 'b option -> 'c option) + (m1: CoordinateList<'a>) + (m2: CoordinateList<'b>) + = + if uint64 m1.ncols <> uint64 m2.nrows then + Error Error.InconsistentSizeOfArguments + else + let firstA = m1.list |> List.tryHead |> Option.map (fun (_, _, v) -> v) + let firstB = m2.list |> List.tryHead |> Option.map (fun (_, _, v) -> v) + + let canOptimize = + let noneNone = op_mult None None = None + + let multSomeNone = + match firstA with + | Some v -> op_mult (Some v) None = None + | None -> noneNone + + let multNoneSome = + match firstB with + | Some v -> op_mult None (Some v) = None + | None -> noneNone + + let addNoneSome = + match firstA with + | Some v -> op_add (Some v) None = Some v + | None -> noneNone + + let addSomeNone = + match firstB with + | Some v -> op_add None (Some v) = Some v + | None -> noneNone + + noneNone && multSomeNone && multNoneSome && addNoneSome && addSomeNone + + if canOptimize then + let m1ByRow = m1.list |> List.groupBy (fun (i, _, _) -> i) |> Map.ofList + let m2ByRow = m2.list |> List.groupBy (fun (k, _, _) -> k) |> Map.ofList + + let result = + [ for KeyValue(i, m1Entries) in m1ByRow do + for (_, k, v1) in m1Entries do + let kAsRow = uint64 k * 1UL + + match m2ByRow |> Map.tryFind kAsRow with + | Some m2Entries -> + for (_, j, v2) in m2Entries do + match op_mult (Some v1) (Some v2) with + | Some product -> yield (i, j, product) + | None -> () + | None -> () ] + + let grouped = + result + |> List.groupBy (fun (i, j, _) -> (i, j)) + |> List.map (fun ((i, j), entries) -> + let sum = entries |> List.map (fun (_, _, v) -> Some v) |> List.reduce op_add + (i, j, sum)) + |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) + |> List.sortBy (fun (i, j, _) -> (i, j)) + + CoordinateList(m1.nrows, m2.ncols, grouped) |> Ok + else + let m1Map = m1.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let m2Map = m2.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let kCount = uint64 m1.ncols + + let result = + [ for i in range (uint64 m1.nrows) do + let ri = i * 1UL + + for j in range (uint64 m2.ncols) do + let cj = j * 1UL + + let products = + [ for k in range kCount do + let a = m1Map |> Map.tryFind (ri, k * 1UL) + let b = m2Map |> Map.tryFind (k * 1UL, cj) + yield op_mult a b ] + + let sum = products |> List.fold (fun acc p -> op_add acc p) None + + match sum with + | Some value -> yield (ri, cj, value) + | None -> () ] + + CoordinateList(m1.nrows, m2.ncols, result) |> Ok From 41194a49b0bc1aa1bac1f7794f23346f2f8c9a0e Mon Sep 17 00:00:00 2001 From: Narysev Date: Thu, 17 Sep 2026 15:32:51 +0300 Subject: [PATCH 04/13] Add public Matrix get/set/map, get/set/map tests; drop Matrix.filter/exists/forall tests --- QuadTree.Benchmark/Main.fs | 5 +- QuadTree.Benchmark/QuadTree.Benchmark.fsproj | 2 + QuadTree.Benchmark/Utils.fs | 14 +- QuadTree.Tests/QuadTree.Tests.fsproj | 1 + QuadTree.Tests/Tests.LinearAlgebra.fs | 1 + QuadTree.Tests/Tests.Matrix.fs | 502 +++---------------- QuadTree/Matrix.fs | 128 ++++- QuadTree/QuadTree.fsproj | 1 + 8 files changed, 198 insertions(+), 456 deletions(-) diff --git a/QuadTree.Benchmark/Main.fs b/QuadTree.Benchmark/Main.fs index 3fb2bf4..bcb51dc 100644 --- a/QuadTree.Benchmark/Main.fs +++ b/QuadTree.Benchmark/Main.fs @@ -9,7 +9,10 @@ let main argv = typeof typeof typeof - typeof |] + typeof + typeof + typeof + typeof |] benchmarks.Run argv |> ignore 0 diff --git a/QuadTree.Benchmark/QuadTree.Benchmark.fsproj b/QuadTree.Benchmark/QuadTree.Benchmark.fsproj index ba98b9d..b65f472 100644 --- a/QuadTree.Benchmark/QuadTree.Benchmark.fsproj +++ b/QuadTree.Benchmark/QuadTree.Benchmark.fsproj @@ -14,6 +14,8 @@ + + diff --git a/QuadTree.Benchmark/Utils.fs b/QuadTree.Benchmark/Utils.fs index 5ec8793..b71d03d 100644 --- a/QuadTree.Benchmark/Utils.fs +++ b/QuadTree.Benchmark/Utils.fs @@ -8,7 +8,7 @@ type MyConfig() = let DIR_WITH_MATRICES = "../../../../../../../data/" -let readMtx path directed = +let readMtxRaw path directed = let getCooList (linewords: seq) = linewords |> Seq.map (fun x -> @@ -23,7 +23,7 @@ let readMtx path directed = let lines = File.ReadLines(path) let removedComments = lines |> Seq.skipWhile (fun s -> s.[0] = '%') - let linewords = removedComments |> Seq.map (fun s -> s.Split " ") + let linewords = removedComments |> Seq.map (fun s -> s.Split [|' '|]) let first = Seq.head linewords let nrows, ncols, nnz = uint64 first.[0], uint64 first.[1], int first.[2] @@ -33,7 +33,11 @@ let readMtx path directed = let lst = getCooList tl if (directed && nnz <> lst.Length) || ((not directed) && nnz * 2 <> lst.Length) then - failwithf "Incorrect matrix reading. Path: %A expected nnz: %A actual nnz: %A" path (nnz * 2) lst.Length + failwithf "Incorrect matrix reading. Path: %A expected nnz: %A actual nnz: %A" path (if directed then nnz else nnz * 2) lst.Length + + let coo = Matrix.CoordinateList(nrows * 1UL, ncols * 1UL, lst) + let qt = Matrix.fromCoordinateList coo + (coo, qt) - Matrix.CoordinateList(nrows * 1UL, nrows * 1UL, lst) - |> Matrix.fromCoordinateList +let readMtx path directed = + readMtxRaw path directed |> snd diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index 4de3d64..dd6e038 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -8,6 +8,7 @@ + diff --git a/QuadTree.Tests/Tests.LinearAlgebra.fs b/QuadTree.Tests/Tests.LinearAlgebra.fs index 3bde7b3..23540a8 100644 --- a/QuadTree.Tests/Tests.LinearAlgebra.fs +++ b/QuadTree.Tests/Tests.LinearAlgebra.fs @@ -4,6 +4,7 @@ open System open Xunit open Matrix +open COO open Vector open Common diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index e0192a8..53210b3 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -1,9 +1,10 @@ -module Matrix.Tests +module Matrix.Tests open System open Xunit open Matrix +open COO open Common let printMatrix (matrix: SparseMatrix<_>) = @@ -644,493 +645,108 @@ let ``Fold sum`` () = Assert.Equal(expected, actual) [] -let ``Matrix.filter all pass, none changed`` () = +let ``matrix get existing value`` () = let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7); (1UL, 2UL, 9) ])) - let actual = Matrix.filter m (fun x -> x > 0) - Assert.Equal(m, actual) + Assert.Equal(Ok(Some 7), get m 0UL 0UL) + Assert.Equal(Ok(Some 9), get m 1UL 2UL) [] -let ``Matrix.filter none pass, all reset to zero`` () = +let ``matrix get missing value`` () = let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) - - let expected = - Matrix.fromCoordinateList (CoordinateList(4UL, 4UL, [])) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) - let actual = Matrix.filter m (fun x -> x < 0) - - Assert.Equal(expected, actual) + Assert.Equal(Ok None, get m 1UL 1UL) [] -let ``Matrix.filter length is not a power of 2, all reset to zero`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) - (2UL, 0UL, 7) - (2UL, 1UL, 8) - (2UL, 2UL, 9) ] - ) - ) - - let expected = - Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) - - let actual = Matrix.filter m (fun x -> x < 0) - - Assert.Equal(expected, actual) +let ``matrix get out of bounds`` () = + let m = fromCoordinateList(CoordinateList(4UL, 4UL, [])) + Assert.Equal(Error Error.InvalidElementIndex, get m 5UL 5UL) [] -let ``Matrix.filter some pass, odd set to zero`` () = +let ``matrix set replaces existing`` () = let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (0UL, 3UL, 4) - (1UL, 0UL, 5) - (1UL, 1UL, 6) - (1UL, 2UL, 7) - (1UL, 3UL, 8) - (2UL, 0UL, 9) - (2UL, 1UL, 10) - (2UL, 2UL, 11) - (2UL, 3UL, 12) - (3UL, 0UL, 13) - (3UL, 1UL, 14) - (3UL, 2UL, 15) - (3UL, 3UL, 16) ] - ) - ) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) - let expected = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 1UL, 2) - (0UL, 3UL, 4) - (1UL, 1UL, 6) - (1UL, 3UL, 8) - (2UL, 1UL, 10) - (2UL, 3UL, 12) - (3UL, 1UL, 14) - (3UL, 3UL, 16) ] - ) - ) + let actual = set m 0UL 0UL 99 |> Result.defaultValue m - let actual = Matrix.filter m (fun x -> x % 2 = 0) - - Assert.Equal(expected, actual) + Assert.Equal(Ok(Some 99), get actual 0UL 0UL) + Assert.Equal(Ok(Some 7), get m 0UL 0UL) [] -let ``Matrix.filter length is not a power of 2, not all reset to zero`` () = +let ``matrix set inserts new`` () = let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) - (2UL, 0UL, 7) - (2UL, 1UL, 8) - (2UL, 2UL, 9) ] - ) - ) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) - let expected = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 1UL, 2) - (1UL, 0UL, 4) - (1UL, 2UL, 6) - (2UL, 1UL, 8) ] - ) - ) + let actual = set m 2UL 2UL 42 |> Result.defaultValue m - let actual = Matrix.filter m (fun x -> x % 2 = 0) - - Assert.Equal(expected, actual) + Assert.Equal(Ok(Some 42), get actual 2UL 2UL) [] -let ``Matrix.filter none pass, length is not a power of 2, none changed`` () = - let m = Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) - let actual = Matrix.filter m (fun x -> x > 0) - Assert.Equal(m, actual) +let ``matrix set out of bounds`` () = + let m = fromCoordinateList(CoordinateList(4UL, 4UL, [])) + Assert.Equal(Error Error.InvalidElementIndex, set m 5UL 5UL 99) [] -let ``Matrix.filter none pass, length is a power of 2, none changed`` () = - let m = Matrix.fromCoordinateList (CoordinateList(4UL, 4UL, [])) - let actual = Matrix.filter m (fun x -> x > 0) - Assert.Equal(m, actual) - -[] -let ``Matrix.filter single element, passes`` () = - let m = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) - - let expected = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) - - let actual = Matrix.filter m (fun x -> x > 0) +let ``matrix set then get roundtrip`` () = + let m0 = empty 4UL 4UL + let m1 = set m0 0UL 0UL 1 |> Result.defaultValue m0 + let m2 = set m1 1UL 2UL 2 |> Result.defaultValue m1 + let m3 = set m2 3UL 3UL 3 |> Result.defaultValue m2 - Assert.Equal(expected, actual) + Assert.Equal(Ok(Some 1), get m3 0UL 0UL) + Assert.Equal(Ok(Some 2), get m3 1UL 2UL) + Assert.Equal(Ok(Some 3), get m3 3UL 3UL) + Assert.Equal(Ok(None), get m3 2UL 1UL) [] -let ``Matrix.filter single element, fails`` () = +let ``matrix map doubles values`` () = let m = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) - - let expected = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [])) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3); (1UL, 2UL, 5) ])) - let actual = Matrix.filter m (fun x -> x < 0) + let result = map m (Option.map (fun v -> v * 2)) - Assert.Equal(expected, actual) + Assert.Equal(Ok(Some 6), get result 0UL 0UL) + Assert.Equal(Ok(Some 10), get result 1UL 2UL) + Assert.Equal(Ok(None), get result 0UL 1UL) [] -let ``Matrix.exists the first element fits, length is a power of 2`` () = +let ``matrix map filters Some to None`` () = let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3); (1UL, 2UL, 5) ])) - Assert.True(Matrix.exists m (fun x -> x = 1)) - Assert.False(Matrix.exists m (fun x -> x = 10)) + let result = map m (fun v -> match v with Some x when x > 4 -> Some x | _ -> None) -[] -let ``Matrix.exists the first element fits, length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.True(Matrix.exists m (fun x -> x = 1)) + Assert.Equal(Ok(None), get result 0UL 0UL) + Assert.Equal(Ok(Some 5), get result 1UL 2UL) [] -let ``Matrix.exists no element fits, length is a power of 2`` () = +let ``matrix map fills None with values`` () = let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3) ])) - Assert.False(Matrix.exists m (fun x -> x = 10)) + let result = map m (fun v -> Some(match v with Some x -> x | None -> 0)) -[] -let ``Matrix.exists no element fits, length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.False(Matrix.exists m (fun x -> x = 10)) + Assert.Equal(Ok(Some 3), get result 0UL 0UL) + Assert.Equal(Ok(Some 0), get result 1UL 1UL) + Assert.Equal(Ok(Some 0), get result 3UL 3UL) [] -let ``Matrix.exists empty matrix`` () = - let m = Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) - Assert.False(Matrix.exists m (fun x -> x = 1)) +let ``matrix map on empty matrix`` () = + let m = empty 4UL 4UL -[] -let ``Matrix.exists single element, fits`` () = - let m = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) - - Assert.True(Matrix.exists m (fun x -> x = 1)) - -[] -let ``Matrix.exists single element, does not fit`` () = - let m = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + let result = map m (Option.map (fun v -> v + 1)) - Assert.False(Matrix.exists m (fun x -> x = 10)) + Assert.Equal(Ok(None), get result 0UL 0UL) [] -let ``Matrix.exists all elements fit,length is a power of 2`` () = +let ``matrix map nvals updated`` () = let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) + fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3); (1UL, 2UL, 5) ])) - Assert.True(Matrix.exists m (fun x -> x > 0)) + Assert.Equal(2UL, uint64 m.nvals) -[] -let ``Matrix.exists all elements fit,length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.True(Matrix.exists m (fun x -> x > 0)) - -[] -let ``Matrix.exists some elements fit, length is a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) - - Assert.True(Matrix.exists m (fun x -> x = 2 || x = 10)) - -[] -let ``Matrix.exists some elements fit, length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.True(Matrix.exists m (fun x -> x = 2 || x = 10)) - -[] -let ``Matrix.forall the first element fits, length is a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) - - Assert.True(Matrix.forall m (fun x -> x > 0)) - -[] -let ``Matrix.forall the first element fits, length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.True(Matrix.forall m (fun x -> x > 0)) - -[] -let ``Matrix.forall no element fits, length is a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) - - Assert.False(Matrix.forall m (fun x -> x > 10)) - -[] -let ``Matrix.forall no element fits, length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.False(Matrix.forall m (fun x -> x > 10)) - -[] -let ``Matrix.forall all elements fit,length is a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) - - Assert.True(Matrix.forall m (fun x -> x > 0)) - -[] -let ``Matrix.forall all elements fit,length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.True(Matrix.forall m (fun x -> x > 0)) - -[] -let ``Matrix.forall some elements fit, length is a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (1UL, 0UL, 3) - (1UL, 1UL, 4) ] - ) - ) - - Assert.False(Matrix.forall m (fun x -> x = 2 || x = 10)) - -[] -let ``Matrix.forall some elements fit, length is not a power of 2`` () = - let m = - Matrix.fromCoordinateList ( - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 1) - (0UL, 1UL, 2) - (0UL, 2UL, 3) - (1UL, 0UL, 4) - (1UL, 1UL, 5) - (1UL, 2UL, 6) ] - ) - ) - - Assert.False(Matrix.forall m (fun x -> x = 2 || x = 10)) - -[] -let ``Matrix.forall empty matrix`` () = - let m = Matrix.fromCoordinateList (CoordinateList(3UL, 3UL, [])) - Assert.True(Matrix.forall m (fun x -> x = 1)) - -[] -let ``Matrix.forall single element, fits`` () = - let m = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) - - Assert.True(Matrix.forall m (fun x -> x = 1)) - -[] -let ``Matrix.forall single element, does not fit`` () = - let m = - Matrix.fromCoordinateList (CoordinateList(1UL, 1UL, [ (0UL, 0UL, 1) ])) + let result = map m (fun _ -> None) - Assert.False(Matrix.forall m (fun x -> x = 10)) + Assert.Equal(0UL, uint64 result.nvals) diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index e78adf7..a75df31 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -41,6 +41,7 @@ type SparseMatrix<'value> = type Error = | InconsistentStructureOfStorages | InconsistentSizeOfArguments + | InvalidElementIndex let mkNode x1 x2 x3 x4 = @@ -54,6 +55,12 @@ type rowindex [] type colindex +let getQuadrantCoords (pr, pc) halfSize = + (pr, pc), // NORTH WEST + (pr, pc + halfSize * 1UL), // NORTH EAST + (pr + halfSize * 1UL, pc), // SOUTH WEST + (pr + halfSize * 1UL, pc + halfSize * 1UL) // SOUTH EAST + type COOEntry<'value> = uint64 * uint64 * 'value [] @@ -67,18 +74,11 @@ type CoordinateList<'value> = ncols = _ncols list = _list } -let private getQuadrantCoords (pr, pc) halfSize = - (pr, pc), // NORTH WEST - (pr, pc + halfSize * 1UL), // NORTH EAST - (pr + halfSize * 1UL, pc), // SOUTH WEST - (pr + halfSize * 1UL, pc + halfSize * 1UL) // SOUTH EAST - let fromCoordinateList (coo: CoordinateList<'a>) = let nvals = (uint64 <| List.length coo.list) * 1UL let nrows = coo.nrows let ncols = coo.ncols - // the resulting matrix is always square let storageSize = getNearestUpperPowerOfTwo (max (uint64 nrows) (uint64 ncols)) let isEntryInQuadrant (pr, pc) size (entry: COOEntry<'a>) = @@ -140,6 +140,120 @@ let toCoordinateList (matrix: SparseMatrix<'a>) = let empty nrows ncols = fromCoordinateList (CoordinateList(nrows, ncols, [])) +let get (matrix: SparseMatrix<'a>) (row: uint64) (col: uint64) : Result, Error> = + if uint64 row >= uint64 matrix.nrows || uint64 col >= uint64 matrix.ncols then + Error Error.InvalidElementIndex + else + let rec inner tree (pr: uint64) (pc: uint64) (size: uint64) = + match tree with + | Leaf Dummy -> None + | Leaf(UserValue v) -> v + | Node(nw, ne, sw, se) -> + let halfSize = size / 2UL + let midR = pr + halfSize * 1UL + let midC = pc + halfSize * 1UL + + if uint64 row < uint64 midR then + if uint64 col < uint64 midC then + inner nw pr pc halfSize + else + inner ne pr midC halfSize + else if uint64 col < uint64 midC then + inner sw midR pc halfSize + else + inner se midR midC halfSize + + Ok(inner matrix.storage.data (0UL) (0UL) (uint64 matrix.storage.size)) + +let set + (matrix: SparseMatrix<'a>) + (row: uint64) + (col: uint64) + (value: 'a) + : Result, Error> = + if uint64 row >= uint64 matrix.nrows || uint64 col >= uint64 matrix.ncols then + Error Error.InvalidElementIndex + else + let rec inner tree (pr: uint64) (pc: uint64) (size: uint64) = + let halfSize = size / 2UL + + if size = 1UL then + match tree with + | Leaf(UserValue oldVal) -> + let newVal = Some value + + let delta = + match newVal, oldVal with + | Some _, None -> 1L + | None, Some _ -> -1L + | _ -> 0L + + Leaf(UserValue newVal), delta + | Leaf Dummy -> Leaf(UserValue(Some value)), 1L + | _ -> failwith "Unreachable" + else + let midR = pr + halfSize * 1UL + let midC = pc + halfSize * 1UL + + let (nw, ne, sw, se) = + match tree with + | Node(nw, ne, sw, se) -> nw, ne, sw, se + | Leaf v -> Leaf v, Leaf v, Leaf v, Leaf v + + let newChild, delta = + if uint64 row < uint64 midR then + if uint64 col < uint64 midC then + inner nw pr pc halfSize + else + inner ne pr midC halfSize + else if uint64 col < uint64 midC then + inner sw midR pc halfSize + else + inner se midR midC halfSize + + if uint64 row < uint64 midR then + if uint64 col < uint64 midC then + mkNode newChild ne sw se, delta + else + mkNode nw newChild sw se, delta + else if uint64 col < uint64 midC then + mkNode nw ne newChild se, delta + else + mkNode nw ne sw newChild, delta + + let storage, deltaNNZ = + inner matrix.storage.data (0UL) (0UL) (uint64 matrix.storage.size) + + let nvals = uint64 (int64 matrix.nvals + deltaNNZ) * 1UL + Ok(SparseMatrix(matrix.nrows, matrix.ncols, nvals, Storage(matrix.storage.size, storage))) + +let map (matrix: SparseMatrix<_>) f = + let rec inner (size: uint64) matrix = + match matrix with + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v)) -> + let res = f v + + let nnz = + match res with + | None -> 0UL + | _ -> (uint64 size) * (uint64 size) * 1UL + + Leaf(UserValue(res)), nnz + | Node(x1, x2, x3, x4) -> + let new_size = size / 2UL + + let t1, nvals1 = inner new_size x1 + let t2, nvals2 = inner new_size x2 + let t3, nvals3 = inner new_size x3 + let t4, nvals4 = inner new_size x4 + + mkNode t1 t2 t3 t4, nvals1 + nvals2 + nvals3 + nvals4 + + let storage, nvals = inner matrix.storage.size matrix.storage.data + + SparseMatrix(matrix.nrows, matrix.ncols, nvals, Storage(matrix.storage.size, storage)) + let map2 (matrix1: SparseMatrix<_>) (matrix2: SparseMatrix<_>) f = let rec inner (size: uint64) matrix1 matrix2 = let _do x1 x2 x3 x4 y1 y2 y3 y4 = diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 438678c..618aded 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -9,6 +9,7 @@ + From 9e197d64cea274c7fef89bb5c76ed7c6e163afb6 Mon Sep 17 00:00:00 2001 From: Narysev Date: Sat, 19 Sep 2026 09:53:30 +0300 Subject: [PATCH 05/13] Implement COO operations, optimize sparse mxm path, add comprehensive test suite (188 tests) --- QuadTree.Tests/Tests.COO.fs | 310 ++++++++++++++++++++++---- QuadTree.Tests/Tests.Matrix.fs | 304 +++++++++++++++++++++++++- QuadTree/COO.fs | 308 ++++++++++++++++---------- QuadTree/Matrix.fs | 388 ++++++++++++++++++++------------- 4 files changed, 997 insertions(+), 313 deletions(-) diff --git a/QuadTree.Tests/Tests.COO.fs b/QuadTree.Tests/Tests.COO.fs index 2075f94..21a9b1a 100644 --- a/QuadTree.Tests/Tests.COO.fs +++ b/QuadTree.Tests/Tests.COO.fs @@ -161,7 +161,8 @@ let ``cooMap filters None results`` () = let coo = CoordinateList(nrows, ncols, data) let f v = - v |> Option.bind (fun v -> + v + |> Option.bind (fun v -> match v with | 1 -> None | _ -> Some(v * 10)) @@ -195,8 +196,11 @@ let ``cooMap fills missing cells (general form)`` () = Assert.Equal(nrows, actual.nrows) Assert.Equal(ncols, actual.ncols) Assert.Equal(9, actual.list.Length) - Assert.Equal(List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, - Some(2UL, 2UL, 5)) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Some(2UL, 2UL, 5) + ) [] let ``cooMap zero-size matrix`` () = @@ -248,7 +252,7 @@ let ``cooMap2 addition`` () = let actual = cooMap2 c1 c2 f - Assert.Equal(expected, actual) + Assert.Equal(Ok expected, actual) [] let ``cooMap2 with mismatched positions`` () = @@ -281,7 +285,7 @@ let ``cooMap2 with mismatched positions`` () = let actual = cooMap2 c1 c2 f - Assert.Equal(expected, actual) + Assert.Equal(Ok expected, actual) [] let ``cooMap2 dense filters None from existing entries`` () = @@ -325,7 +329,7 @@ let ``cooMap2 dense filters None from existing entries`` () = let actual = cooMap2 c1 c2 f - Assert.Equal(expected, actual) + Assert.Equal(Ok expected, actual) // === cooMapi tests === @@ -342,7 +346,8 @@ let ``cooMapi position-dependent values`` () = let coo = CoordinateList(nrows, ncols, data) - let f i j v = v |> Option.map (fun v -> v + (int (uint64 i))) + let f i j v = + v |> Option.map (fun v -> v + (int (uint64 i))) let expected = CoordinateList( @@ -369,15 +374,11 @@ let ``cooMapi filters None results`` () = let coo = CoordinateList(nrows, ncols, data) - let f _i _j v = v |> Option.bind (fun v -> if v > 2 then Some(v * 10) else None) + let f _i _j v = + v |> Option.bind (fun v -> if v > 2 then Some(v * 10) else None) let expected = - CoordinateList( - nrows, - ncols, - [ (0UL, 1UL, 50) - (1UL, 0UL, 30) ] - ) + CoordinateList(nrows, ncols, [ (0UL, 1UL, 50); (1UL, 0UL, 30) ]) let actual = cooMapi coo f @@ -406,8 +407,11 @@ let ``cooMapi fills missing cells (general form)`` () = Assert.Equal(nrows, actual.nrows) Assert.Equal(ncols, actual.ncols) Assert.Equal(9, actual.list.Length) - Assert.Equal(List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, - Some(2UL, 2UL, 5)) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Some(2UL, 2UL, 5) + ) [] let ``cooMapi position-dependent fill of missing cells`` () = @@ -458,18 +462,13 @@ let ``cooMap2i position-dependent addition`` () = | _ -> None let expected = - CoordinateList( - nrows, - ncols, - [ (0UL, 0UL, 11) - (2UL, 2UL, 35) ] - ) + CoordinateList(nrows, ncols, [ (0UL, 0UL, 11); (2UL, 2UL, 35) ]) let c1 = CoordinateList(nrows, ncols, d1) let c2 = CoordinateList(nrows, ncols, d2) let actual = cooMap2i c1 c2 f - Assert.Equal(expected, actual) + Assert.Equal(Ok expected, actual) [] let ``cooMap2i mismatched positions with index`` () = @@ -500,7 +499,7 @@ let ``cooMap2i mismatched positions with index`` () = let c2 = CoordinateList(nrows, ncols, d2) let actual = cooMap2i c1 c2 f - Assert.Equal(expected, actual) + Assert.Equal(Ok expected, actual) [] let ``cooMap2i filters None results`` () = @@ -516,18 +515,13 @@ let ``cooMap2i filters None results`` () = | Some a, Some b -> Some(a + b) | _ -> None - let expected = - CoordinateList( - nrows, - ncols, - [ (0UL, 0UL, 3) ] - ) + let expected = CoordinateList(nrows, ncols, [ (0UL, 0UL, 3) ]) let c1 = CoordinateList(nrows, ncols, d1) let c2 = CoordinateList(nrows, ncols, d2) let actual = cooMap2i c1 c2 f - Assert.Equal(expected, actual) + Assert.Equal(Ok expected, actual) [] let ``cooMap2i empty inputs`` () = @@ -536,7 +530,7 @@ let ``cooMap2i empty inputs`` () = let f _i _j x y = None let actual = cooMap2i c1 c2 f let expected = CoordinateList(4UL, 4UL, []) - Assert.Equal(expected, actual) + Assert.Equal(Ok expected, actual) // === mxmcoo tests === @@ -612,25 +606,24 @@ let ``mxmcoo with non-absorbing op_mult`` () = let op_add x y = match (x, y) with | Some(a), Some(b) -> Some(a + b) - | Some a, _ | _, Some a -> Some a + | Some a, _ + | _, Some a -> Some a | _ -> None let op_mult x y = match (x, y) with | Some(a), Some(b) -> Some(a * b) - | Some a, _ | _, Some a -> Some a + | Some a, _ + | _, Some a -> Some a | _ -> None let m1 = - let d = - [ 0UL, 0UL, 1 - 0UL, 1UL, 2 ] + let d = [ 0UL, 0UL, 1; 0UL, 1UL, 2 ] CoordinateList(1UL, 2UL, d) let m2 = - let d = - [ 0UL, 0UL, 3 ] + let d = [ 0UL, 0UL, 3 ] CoordinateList(2UL, 1UL, d) @@ -641,3 +634,242 @@ let ``mxmcoo with non-absorbing op_mult`` () = Assert.Equal(1, actual.list.Length) Assert.Equal(Some 5, actual.list |> List.tryHead |> Option.map (fun (_, _, v) -> v)) | Error e -> failwith (e.ToString()) + +// === cooMapValues / cooMapiValues tests === + +[] +let ``cooMapValues applies only to stored values`` () = + let coo = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let actual = cooMapValues coo (fun v -> Some(v * 10)) + + Assert.Equal(2, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Some(0UL, 0UL, 10) + ) + +[] +let ``cooMapiValues applies indexed only to stored values`` () = + let coo = + CoordinateList(4UL, 4UL, [ (1UL, 2UL, 5) ]) + + let actual = + cooMapiValues coo (fun i j v -> Some(v + int (uint64 i) + int (uint64 j))) + + Assert.Equal(1, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 1UL && j = 2UL) actual.list, + Some(1UL, 2UL, 8) + ) + +// === cooMap2 variants tests === + +[] +let ``cooMap2Values applies only where both present`` () = + let c1 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let c2 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + + match cooMap2Values c1 c2 (fun a b -> Some(a + b)) with + | Ok actual -> + Assert.Equal(1, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Some(0UL, 0UL, 11) + ) + | Error e -> failwithf "unexpected error %A" e + +[] +let ``cooMap2AllCells equals cooMap2`` () = + let c1 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let c2 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + + let f a b = + match a, b with + | Some x, Some y -> Some(x + y) + | _ -> None + + Assert.Equal(cooMap2 c1 c2 f, cooMap2AllCells c1 c2 f) + +[] +let ``cooMap2AtLeastOne distinguishes both left right`` () = + let c1 = + CoordinateList(3UL, 3UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let c2 = + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 10); (2UL, 2UL, 30) ] + ) + + let f = + function + | AtLeastOne.Both(a, b) -> Some(a + b) + | AtLeastOne.Left a -> Some(a * 100) + | AtLeastOne.Right b -> Some(b * -1) + + match cooMap2AtLeastOne c1 c2 f with + | Ok actual -> + Assert.Equal(3, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Some(0UL, 0UL, 11) + ) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Some(1UL, 1UL, 200) + ) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Some(2UL, 2UL, -30) + ) + | Error e -> failwithf "unexpected error %A" e + +[] +let ``cooMap2LeftValues applies where left present`` () = + let c1 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let c2 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + + match cooMap2LeftValues c1 c2 (fun a b -> Some(a + (defaultArg b 0))) with + | Ok actual -> + Assert.Equal(2, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Some(0UL, 0UL, 11) + ) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Some(1UL, 1UL, 2) + ) + | Error e -> failwithf "unexpected error %A" e + +[] +let ``cooMap2 sizes mismatch`` () = + let c1 = CoordinateList(4UL, 4UL, []) + let c2 = CoordinateList(2UL, 2UL, []) + let f a b = None + + Assert.Equal(Error Error.InconsistentSizeOfArguments, cooMap2 c1 c2 f) + +// === cooMap2i variants tests === + +[] +let ``cooMap2iValues applies indexed where both present`` () = + let c1 = + CoordinateList(4UL, 4UL, [ (1UL, 1UL, 2) ]) + + let c2 = + CoordinateList( + 4UL, + 4UL, + [ (1UL, 1UL, 10); (2UL, 2UL, 20) ] + ) + + let f i j a b = + Some(a + b + int (uint64 i) + int (uint64 j)) + + match cooMap2iValues c1 c2 f with + | Ok actual -> + Assert.Equal(1, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Some(1UL, 1UL, 14) + ) + | Error e -> failwithf "unexpected error %A" e + +[] +let ``cooMap2iAllCells equals cooMap2i`` () = + let c1 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + + let c2 = + CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + + let f i j a b = + match a, b with + | Some x, Some y -> Some(x + y + int (uint64 i)) + | _ -> None + + Assert.Equal(cooMap2i c1 c2 f, cooMap2iAllCells c1 c2 f) + +[] +let ``cooMap2iAtLeastOne passes indices and side`` () = + let c1 = + CoordinateList(2UL, 2UL, [ (0UL, 0UL, 1) ]) + + let c2 = + CoordinateList( + 2UL, + 2UL, + [ (0UL, 0UL, 10); (1UL, 1UL, 20) ] + ) + + let f i j = + function + | AtLeastOne.Both(a, b) -> Some(a + b + int (uint64 i) + int (uint64 j)) + | AtLeastOne.Left a -> Some(a) + | AtLeastOne.Right b -> Some(b + int (uint64 i) * 100 + int (uint64 j)) + + match cooMap2iAtLeastOne c1 c2 f with + | Ok actual -> + Assert.Equal(2, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Some(0UL, 0UL, 11) + ) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Some(1UL, 1UL, 121) + ) + | Error e -> failwithf "unexpected error %A" e + +[] +let ``cooMap2iLeftValues applies indexed where left present`` () = + let c1 = + CoordinateList(2UL, 2UL, [ (1UL, 1UL, 2) ]) + + let c2 = + CoordinateList(2UL, 2UL, [ (1UL, 1UL, 10) ]) + + let f i j a b = + Some(a + (defaultArg b 0) + int (uint64 i) * 10 + int (uint64 j)) + + match cooMap2iLeftValues c1 c2 f with + | Ok actual -> + Assert.Equal(1, actual.list.Length) + + Assert.Equal( + List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Some(1UL, 1UL, 23) + ) + | Error e -> failwithf "unexpected error %A" e + +[] +let ``cooMap2i sizes mismatch`` () = + let c1 = CoordinateList(4UL, 4UL, []) + let c2 = CoordinateList(2UL, 2UL, []) + let f _i _j a b = None + + Assert.Equal(Error Error.InconsistentSizeOfArguments, cooMap2i c1 c2 f) diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index 53210b3..9cef022 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -647,7 +647,13 @@ let ``Fold sum`` () = [] let ``matrix get existing value`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7); (1UL, 2UL, 9) ])) + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 7); (1UL, 2UL, 9) ] + ) + ) Assert.Equal(Ok(Some 7), get m 0UL 0UL) Assert.Equal(Ok(Some 9), get m 1UL 2UL) @@ -655,19 +661,19 @@ let ``matrix get existing value`` () = [] let ``matrix get missing value`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) Assert.Equal(Ok None, get m 1UL 1UL) [] let ``matrix get out of bounds`` () = - let m = fromCoordinateList(CoordinateList(4UL, 4UL, [])) + let m = fromCoordinateList (CoordinateList(4UL, 4UL, [])) Assert.Equal(Error Error.InvalidElementIndex, get m 5UL 5UL) [] let ``matrix set replaces existing`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) let actual = set m 0UL 0UL 99 |> Result.defaultValue m @@ -677,7 +683,7 @@ let ``matrix set replaces existing`` () = [] let ``matrix set inserts new`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 7) ])) let actual = set m 2UL 2UL 42 |> Result.defaultValue m @@ -685,7 +691,7 @@ let ``matrix set inserts new`` () = [] let ``matrix set out of bounds`` () = - let m = fromCoordinateList(CoordinateList(4UL, 4UL, [])) + let m = fromCoordinateList (CoordinateList(4UL, 4UL, [])) Assert.Equal(Error Error.InvalidElementIndex, set m 5UL 5UL 99) [] @@ -703,7 +709,13 @@ let ``matrix set then get roundtrip`` () = [] let ``matrix map doubles values`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3); (1UL, 2UL, 5) ])) + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 3); (1UL, 2UL, 5) ] + ) + ) let result = map m (Option.map (fun v -> v * 2)) @@ -714,9 +726,19 @@ let ``matrix map doubles values`` () = [] let ``matrix map filters Some to None`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3); (1UL, 2UL, 5) ])) + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 3); (1UL, 2UL, 5) ] + ) + ) - let result = map m (fun v -> match v with Some x when x > 4 -> Some x | _ -> None) + let result = + map m (fun v -> + match v with + | Some x when x > 4 -> Some x + | _ -> None) Assert.Equal(Ok(None), get result 0UL 0UL) Assert.Equal(Ok(Some 5), get result 1UL 2UL) @@ -724,9 +746,15 @@ let ``matrix map filters Some to None`` () = [] let ``matrix map fills None with values`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3) ])) + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3) ])) - let result = map m (fun v -> Some(match v with Some x -> x | None -> 0)) + let result = + map m (fun v -> + Some( + match v with + | Some x -> x + | None -> 0 + )) Assert.Equal(Ok(Some 3), get result 0UL 0UL) Assert.Equal(Ok(Some 0), get result 1UL 1UL) @@ -743,10 +771,262 @@ let ``matrix map on empty matrix`` () = [] let ``matrix map nvals updated`` () = let m = - fromCoordinateList(CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3); (1UL, 2UL, 5) ])) + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 3); (1UL, 2UL, 5) ] + ) + ) Assert.Equal(2UL, uint64 m.nvals) let result = map m (fun _ -> None) Assert.Equal(0UL, uint64 result.nvals) + +[] +let ``matrix mapValues applies only to stored values`` () = + let m = + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3) ])) + + let result = mapValues m (fun v -> Some(v * 2)) + + Assert.Equal(Ok(Some 6), get result 0UL 0UL) + Assert.Equal(Ok(None), get result 2UL 2UL) + Assert.Equal(Ok(None), get result 0UL 1UL) + Assert.Equal(1UL, uint64 result.nvals) + +[] +let ``matrix mapValues can drop stored values`` () = + let m = + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 3) ])) + + let result = mapValues m (fun _ -> None) + + Assert.Equal(0UL, uint64 result.nvals) + +[] +let ``matrix mapiValues applies only to stored values with indices`` () = + let m = + fromCoordinateList (CoordinateList(4UL, 4UL, [ (1UL, 2UL, 5) ])) + + let result = mapiValues m (fun i j v -> Some(v + int (uint64 i) + int (uint64 j))) + + Assert.Equal(Ok(Some 8), get result 1UL 2UL) + Assert.Equal(Ok(None), get result 0UL 0UL) + Assert.Equal(1UL, uint64 result.nvals) + +[] +let ``matrix mapi expands uniform leaf`` () = + let m = + SparseMatrix( + 4UL, + 4UL, + 4UL, + Storage(4UL, Matrix.qtree.Node(leaf_v 5, leaf_n (), leaf_n (), leaf_n ())) + ) + + let result = + mapi m (fun i j v -> v |> Option.map (fun x -> x + int (uint64 i) + int (uint64 j))) + + Assert.Equal(4UL, uint64 result.nvals) + Assert.Equal(Ok(Some 5), get result 0UL 0UL) + Assert.Equal(Ok(Some 6), get result 0UL 1UL) + Assert.Equal(Ok(Some 6), get result 1UL 0UL) + Assert.Equal(Ok(Some 7), get result 1UL 1UL) + +[] +let ``matrix map2Values applies only where both values present`` () = + let m1 = + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1); (1UL, 1UL, 2) ] + ) + ) + + let m2 = + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ])) + + match map2Values m1 m2 (fun a b -> Some(a + b + 100)) with + | Error e -> failwithf "unexpected error %A" e + | Ok result -> + Assert.Equal(Ok(Some 111), get result 0UL 0UL) + Assert.Equal(Ok(None), get result 1UL 1UL) + Assert.Equal(1UL, uint64 result.nvals) + +[] +let ``matrix map2AllCells equals map2`` () = + let m1 = + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1); (1UL, 1UL, 2) ] + ) + ) + + let m2 = + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ])) + + let f a b = + match a, b with + | Some x, Some y -> Some(x + y) + | _ -> None + + Assert.Equal(map2 m1 m2 f, map2AllCells m1 m2 f) + +[] +let ``matrix map2AtLeastOne distinguishes both left right`` () = + let m1 = + fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1); (1UL, 1UL, 2) ] + ) + ) + + let m2 = + fromCoordinateList ( + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 10); (2UL, 2UL, 30) ] + ) + ) + + let f = + function + | AtLeastOne.Both(a, b) -> Some(a + b) + | AtLeastOne.Left a -> Some(a * 100) + | AtLeastOne.Right b -> Some(b * -1) + + match map2AtLeastOne m1 m2 f with + | Error e -> failwithf "unexpected error %A" e + | Ok result -> + Assert.Equal(Ok(Some 11), get result 0UL 0UL) + Assert.Equal(Ok(Some 200), get result 1UL 1UL) + Assert.Equal(Ok(Some -30), get result 2UL 2UL) + +[] +let ``matrix map2LeftValues applies where left value present`` () = + let m1 = + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (0UL, 0UL, 1); (1UL, 1UL, 2) ] + ) + ) + + let m2 = + fromCoordinateList (CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ])) + + match map2LeftValues m1 m2 (fun a b -> Some(a + (defaultArg b 0))) with + | Error e -> failwithf "unexpected error %A" e + | Ok result -> + Assert.Equal(Ok(Some 11), get result 0UL 0UL) + Assert.Equal(Ok(Some 2), get result 1UL 1UL) + Assert.Equal(2UL, uint64 result.nvals) + +[] +let ``matrix map2i expands uniform leaves on both sides`` () = + let m1 = + SparseMatrix( + 4UL, + 4UL, + 4UL, + Storage(4UL, Matrix.qtree.Node(leaf_v 5, leaf_n (), leaf_n (), leaf_n ())) + ) + + let m2 = + SparseMatrix( + 4UL, + 4UL, + 4UL, + Storage(4UL, Matrix.qtree.Node(leaf_v 10, leaf_n (), leaf_n (), leaf_n ())) + ) + + let f i j a b = + match a, b with + | Some x, Some y -> Some(x + y + int (uint64 i) * 10 + int (uint64 j)) + | _ -> None + + match map2i m1 m2 f with + | Error e -> failwithf "unexpected error %A" e + | Ok result -> + Assert.Equal(4UL, uint64 result.nvals) + Assert.Equal(Ok(Some 15), get result 0UL 0UL) + Assert.Equal(Ok(Some 16), get result 0UL 1UL) + Assert.Equal(Ok(Some 25), get result 1UL 0UL) + Assert.Equal(Ok(Some 26), get result 1UL 1UL) + +[] +let ``matrix map2iValues applies indexed where both values present`` () = + let m1 = + fromCoordinateList (CoordinateList(4UL, 4UL, [ (1UL, 1UL, 2) ])) + + let m2 = + fromCoordinateList ( + CoordinateList( + 4UL, + 4UL, + [ (1UL, 1UL, 10); (2UL, 2UL, 20) ] + ) + ) + + let f i j a b = + Some(a + b + int (uint64 i) + int (uint64 j)) + + match map2iValues m1 m2 f with + | Error e -> failwithf "unexpected error %A" e + | Ok result -> + Assert.Equal(Ok(Some 14), get result 1UL 1UL) + Assert.Equal(Ok(None), get result 2UL 2UL) + Assert.Equal(1UL, uint64 result.nvals) + +[] +let ``matrix map2iAtLeastOne passes indices and side`` () = + let m1 = + fromCoordinateList (CoordinateList(2UL, 2UL, [ (0UL, 0UL, 1) ])) + + let m2 = + fromCoordinateList ( + CoordinateList( + 2UL, + 2UL, + [ (0UL, 0UL, 10); (1UL, 1UL, 20) ] + ) + ) + + let f i j = + function + | AtLeastOne.Both(a, b) -> Some(a + b + int (uint64 i) + int (uint64 j)) + | AtLeastOne.Left a -> Some(a) + | AtLeastOne.Right b -> Some(b + int (uint64 i) * 100 + int (uint64 j)) + + match map2iAtLeastOne m1 m2 f with + | Error e -> failwithf "unexpected error %A" e + | Ok result -> + Assert.Equal(Ok(Some 11), get result 0UL 0UL) + Assert.Equal(Ok(Some 121), get result 1UL 1UL) + +[] +let ``matrix map2iLeftValues applies indexed where left present`` () = + let m1 = + fromCoordinateList (CoordinateList(2UL, 2UL, [ (1UL, 1UL, 2) ])) + + let m2 = + fromCoordinateList (CoordinateList(2UL, 2UL, [ (1UL, 1UL, 10) ])) + + let f i j a b = + Some(a + (defaultArg b 0) + int (uint64 i) * 10 + int (uint64 j)) + + match map2iLeftValues m1 m2 f with + | Error e -> failwithf "unexpected error %A" e + | Ok result -> + Assert.Equal(Ok(Some 23), get result 1UL 1UL) + Assert.Equal(1UL, uint64 result.nvals) diff --git a/QuadTree/COO.fs b/QuadTree/COO.fs index 26f792c..046086f 100644 --- a/QuadTree/COO.fs +++ b/QuadTree/COO.fs @@ -51,19 +51,78 @@ let cooUpdate Ok(CoordinateList(coo.nrows, coo.ncols, List.rev acc)) -let cooMap (coo: CoordinateList<'a>) f = - let updatedList = coo.list |> List.map (fun (i, j, v) -> (i, j, f (Some v))) - +let private applyBinary + (op: BinaryOp<'a, 'b, 'c>) + (i: uint64) + (j: uint64) + (v1: Option<'a>) + (v2: Option<'b>) + : Option<'c> = + match op with + | BinaryOp.ValuesOnly f -> + match v1, v2 with + | Some a, Some b -> f a b + | _ -> None + | BinaryOp.ValuesOnlyIndexed f -> + match v1, v2 with + | Some a, Some b -> f i j a b + | _ -> None + | BinaryOp.AllCells f -> f v1 v2 + | BinaryOp.AllCellsIndexed f -> f i j v1 v2 + | BinaryOp.AtLeastOneValue f -> + match v1, v2 with + | Some a, Some b -> f (AtLeastOne.Both(a, b)) + | Some a, None -> f (AtLeastOne.Left a) + | None, Some b -> f (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.AtLeastOneValueIndexed f -> + match v1, v2 with + | Some a, Some b -> f i j (AtLeastOne.Both(a, b)) + | Some a, None -> f i j (AtLeastOne.Left a) + | None, Some b -> f i j (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.LeftValuesOnly f -> + match v1 with + | Some a -> f a v2 + | None -> None + | BinaryOp.LeftValuesOnlyIndexed f -> + match v1 with + | Some a -> f i j a v2 + | None -> None + +let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : CoordinateList<'b> = let result = - match f None with - | None -> - updatedList - |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) - | Some fnone -> - let lookup = - updatedList - |> List.map (fun (i, j, v) -> ((i, j), v)) - |> Map.ofList + match op with + | UnaryOp.ValuesOnly f -> + coo.list + |> List.choose (fun (i, j, v) -> f v |> Option.map (fun r -> (i, j, r))) + | UnaryOp.ValuesOnlyIndexed f -> + coo.list + |> List.choose (fun (i, j, v) -> f i j v |> Option.map (fun r -> (i, j, r))) + | UnaryOp.AllCells f -> + match f None with + | None -> + coo.list + |> List.choose (fun (i, j, v) -> f (Some v) |> Option.map (fun r -> (i, j, r))) + | Some fnone -> + let lookup = coo.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + + [ for i in range (uint64 coo.nrows) do + let ri = i * 1UL + + for j in range (uint64 coo.ncols) do + let cj = j * 1UL + + let res = + match Map.tryFind (ri, cj) lookup with + | Some value -> f (Some value) + | None -> Some fnone + + match res with + | Some value -> yield (ri, cj, value) + | None -> () ] + | UnaryOp.AllCellsIndexed f -> + let mutable rest = coo.list [ for i in range (uint64 coo.nrows) do let ri = i * 1UL @@ -71,127 +130,152 @@ let cooMap (coo: CoordinateList<'a>) f = for j in range (uint64 coo.ncols) do let cj = j * 1UL - match Map.tryFind (ri, cj) lookup with - | Some(Some value) -> yield (ri, cj, value) - | Some None -> () - | None -> yield (ri, cj, fnone) ] - - CoordinateList(coo.nrows, coo.ncols, result) - -let cooMapi (coo: CoordinateList<'a>) f = - let lookup = - coo.list - |> List.map (fun (i, j, v) -> ((i, j), v)) - |> Map.ofList - - let result = - [ for i in range (uint64 coo.nrows) do - let ri = i * 1UL - - for j in range (uint64 coo.ncols) do - let cj = j * 1UL + let value = + match rest with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest <- tail + Some ev + | _ -> None - let res = f ri cj (Map.tryFind (ri, cj) lookup) - - match res with - | Some value -> yield (ri, cj, value) - | None -> () ] + match f ri cj value with + | Some value -> yield (ri, cj, value) + | None -> () ] CoordinateList(coo.nrows, coo.ncols, result) -let cooMap2 (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let private mergeBinary (l1: COOEntry<'a> list) (l2: COOEntry<'b> list) (op: BinaryOp<'a, 'b, 'c>) : COOEntry<'c> list = let mutable acc = [] - let mutable l1 = coo1.list - let mutable l2 = coo2.list + let mutable rest1 = l1 + let mutable rest2 = l2 - while l1 <> [] || l2 <> [] do - match l1, l2 with + let emit i j v1 v2 = + match applyBinary op i j v1 v2 with + | Some r -> acc <- (i, j, r) :: acc + | None -> () + + while rest1 <> [] || rest2 <> [] do + match rest1, rest2 with | [], [] -> () - | (i1, j1, v1) :: t1, [] -> - let r = f (Some v1) None - acc <- (i1, j1, r) :: acc - l1 <- t1 - | [], (i2, j2, v2) :: t2 -> - let r = f None (Some v2) - acc <- (i2, j2, r) :: acc - l2 <- t2 + | (i, j, v1) :: t1, [] -> + emit i j (Some v1) None + rest1 <- t1 + | [], (i, j, v2) :: t2 -> + emit i j None (Some v2) + rest2 <- t2 | (i1, j1, v1) :: t1, (i2, j2, v2) :: t2 -> if i1 = i2 && j1 = j2 then - let r = f (Some v1) (Some v2) - acc <- (i1, j1, r) :: acc - l1 <- t1 - l2 <- t2 + emit i1 j1 (Some v1) (Some v2) + rest1 <- t1 + rest2 <- t2 elif (i1, j1) < (i2, j2) then - let r = f (Some v1) None - acc <- (i1, j1, r) :: acc - l1 <- t1 + emit i1 j1 (Some v1) None + rest1 <- t1 else - let r = f None (Some v2) - acc <- (i2, j2, r) :: acc - l2 <- t2 + emit i2 j2 None (Some v2) + rest2 <- t2 - let updatedList = List.rev acc + List.rev acc - let result = - match f None None with - | None -> - updatedList - |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) - | Some fnone -> - let lookup = - updatedList - |> List.map (fun (i, j, v) -> ((i, j), v)) - |> Map.ofList - - [ for i in range (uint64 coo1.nrows) do - let ri = i * 1UL +let private cooMap2Inner + (coo1: CoordinateList<'a>) + (coo2: CoordinateList<'b>) + (op: BinaryOp<'a, 'b, 'c>) + : Result, Error> = + if uint64 coo1.nrows <> uint64 coo2.nrows || uint64 coo1.ncols <> uint64 coo2.ncols then + Error Error.InconsistentSizeOfArguments + else + let nrows = coo1.nrows + let ncols = coo1.ncols - for j in range (uint64 coo1.ncols) do - let cj = j * 1UL + let result = + match op with + | BinaryOp.AllCells f -> + match f None None with + | None -> mergeBinary coo1.list coo2.list op + | Some _ -> + let lookup1 = coo1.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + + let lookup2 = coo2.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + + [ for i in range (uint64 nrows) do + let ri = i * 1UL + + for j in range (uint64 ncols) do + let cj = j * 1UL - match Map.tryFind (ri, cj) lookup with - | Some(Some value) -> yield (ri, cj, value) - | Some None -> () - | None -> yield (ri, cj, fnone) ] + match f (Map.tryFind (ri, cj) lookup1) (Map.tryFind (ri, cj) lookup2) with + | Some value -> yield (ri, cj, value) + | None -> () ] + | BinaryOp.AllCellsIndexed f -> + let mutable rest1 = coo1.list + let mutable rest2 = coo2.list - CoordinateList(coo1.nrows, coo1.ncols, result) + [ for i in range (uint64 nrows) do + let ri = i * 1UL + + for j in range (uint64 ncols) do + let cj = j * 1UL + + let v1 = + match rest1 with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest1 <- tail + Some ev + | _ -> None + + let v2 = + match rest2 with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest2 <- tail + Some ev + | _ -> None + + match f ri cj v1 v2 with + | Some value -> yield (ri, cj, value) + | None -> () ] + | _ -> mergeBinary coo1.list coo2.list op + + CoordinateList(nrows, ncols, result) |> Ok + +let cooMap (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.AllCells f) + +let cooMapValues (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.ValuesOnly f) + +let cooMapi (coo: CoordinateList<'a>) f = + cooMapInner coo (UnaryOp.AllCellsIndexed f) + +let cooMapiValues (coo: CoordinateList<'a>) f = + cooMapInner coo (UnaryOp.ValuesOnlyIndexed f) + +let cooMap2 (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) + +let cooMap2Values (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnly f) + +let cooMap2AllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) + +let cooMap2AtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValue f) + +let cooMap2LeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnly f) let cooMap2i (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - let mutable acc = [] - let mutable l1 = coo1.list - let mutable l2 = coo2.list + cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) - while l1 <> [] || l2 <> [] do - match l1, l2 with - | [], [] -> () - | (i1, j1, v1) :: t1, [] -> - let r = f i1 j1 (Some v1) None - acc <- (i1, j1, r) :: acc - l1 <- t1 - | [], (i2, j2, v2) :: t2 -> - let r = f i2 j2 None (Some v2) - acc <- (i2, j2, r) :: acc - l2 <- t2 - | (i1, j1, v1) :: t1, (i2, j2, v2) :: t2 -> - if i1 = i2 && j1 = j2 then - let r = f i1 j1 (Some v1) (Some v2) - acc <- (i1, j1, r) :: acc - l1 <- t1 - l2 <- t2 - elif (i1, j1) < (i2, j2) then - let r = f i1 j1 (Some v1) None - acc <- (i1, j1, r) :: acc - l1 <- t1 - else - let r = f i2 j2 None (Some v2) - acc <- (i2, j2, r) :: acc - l2 <- t2 +let cooMap2iValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnlyIndexed f) - let result = - List.rev acc - |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) +let cooMap2iAllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) + +let cooMap2iAtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValueIndexed f) - CoordinateList(coo1.nrows, coo1.ncols, result) +let cooMap2iLeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnlyIndexed f) let mxmcoo (op_add: 'c option -> 'c option -> 'c option) diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index a75df31..74d6f6f 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -227,187 +227,275 @@ let set let nvals = uint64 (int64 matrix.nvals + deltaNNZ) * 1UL Ok(SparseMatrix(matrix.nrows, matrix.ncols, nvals, Storage(matrix.storage.size, storage))) -let map (matrix: SparseMatrix<_>) f = - let rec inner (size: uint64) matrix = - match matrix with - | Leaf(Dummy) -> Leaf(Dummy), 0UL - | Leaf(UserValue(v)) -> - let res = f v - - let nnz = - match res with - | None -> 0UL - | _ -> (uint64 size) * (uint64 size) * 1UL +type UnaryOp<'a, 'b> = + | ValuesOnly of ('a -> Option<'b>) + | ValuesOnlyIndexed of (uint64 -> uint64 -> 'a -> Option<'b>) + | AllCells of (Option<'a> -> Option<'b>) + | AllCellsIndexed of (uint64 -> uint64 -> Option<'a> -> Option<'b>) + +let private mapInner (matrix: SparseMatrix<'a>) (op: UnaryOp<'a, 'b>) : SparseMatrix<'b> = + let rec inner + (prow: uint64) + (pcol: uint64) + (size: uint64) + (tree: qtree>) + : qtree> * uint64 = + match tree with + | Node(nw, ne, sw, se) -> + let halfSize = size / 2UL - Leaf(UserValue(res)), nnz - | Node(x1, x2, x3, x4) -> - let new_size = size / 2UL + let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = + getQuadrantCoords (prow, pcol) (uint64 halfSize) - let t1, nvals1 = inner new_size x1 - let t2, nvals2 = inner new_size x2 - let t3, nvals3 = inner new_size x3 - let t4, nvals4 = inner new_size x4 + let t1, nvals1 = inner nwR nwC halfSize nw + let t2, nvals2 = inner neR neC halfSize ne + let t3, nvals3 = inner swR swC halfSize sw + let t4, nvals4 = inner seR seC halfSize se mkNode t1 t2 t3 t4, nvals1 + nvals2 + nvals3 + nvals4 + | Leaf(Dummy) -> Leaf(Dummy), 0UL + | Leaf(UserValue(v)) -> + match op with + | UnaryOp.ValuesOnly f -> + match v with + | None -> Leaf(UserValue(None)), 0UL + | Some v' -> + let res = f v' + + let nvals = + if res.IsSome then + (uint64 size) * (uint64 size) * 1UL + else + 0UL + + Leaf(UserValue(res)), nvals + | UnaryOp.ValuesOnlyIndexed f -> + match v with + | None -> Leaf(UserValue(None)), 0UL + | Some v' -> + if size = 1UL then + let res = f prow pcol v' + let nvals = if res.IsSome then 1UL else 0UL + Leaf(UserValue(res)), nvals + 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 + | UnaryOp.AllCells f -> + let res = f v + + let nvals = + if res.IsSome then + (uint64 size) * (uint64 size) * 1UL + else + 0UL + + Leaf(UserValue(res)), nvals + | UnaryOp.AllCellsIndexed f -> + if size = 1UL then + let res = f prow pcol v + let nvals = if res.IsSome then 1UL else 0UL + Leaf(UserValue(res)), nvals + 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 matrix.storage.size matrix.storage.data + let storage, nvals = + inner 0UL 0UL matrix.storage.size matrix.storage.data SparseMatrix(matrix.nrows, matrix.ncols, nvals, Storage(matrix.storage.size, storage)) -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 +let map (matrix: SparseMatrix<_>) f = mapInner matrix (UnaryOp.AllCells f) + +let mapValues (matrix: SparseMatrix<'a>) f = mapInner matrix (UnaryOp.ValuesOnly f) + +type AtLeastOne<'a, 'b> = + | Both of 'a * 'b + | Left of 'a + | Right of 'b + +type BinaryOp<'a, 'b, 'c> = + | ValuesOnly of ('a -> 'b -> Option<'c>) + | ValuesOnlyIndexed of (uint64 -> uint64 -> 'a -> 'b -> Option<'c>) + | AllCells of (Option<'a> -> Option<'b> -> Option<'c>) + | AllCellsIndexed of (uint64 -> uint64 -> Option<'a> -> Option<'b> -> Option<'c>) + | AtLeastOneValue of (AtLeastOne<'a, 'b> -> Option<'c>) + | AtLeastOneValueIndexed of (uint64 -> uint64 -> AtLeastOne<'a, 'b> -> Option<'c>) + | LeftValuesOnly of ('a -> Option<'b> -> Option<'c>) + | LeftValuesOnlyIndexed of (uint64 -> uint64 -> 'a -> Option<'b> -> Option<'c>) + +let private applyBinary + (op: BinaryOp<'a, 'b, 'c>) + (prow: uint64) + (pcol: uint64) + (v1: Option<'a>) + (v2: Option<'b>) + : Option<'c> = + match op with + | BinaryOp.ValuesOnly f -> + match v1, v2 with + | Some a, Some b -> f a b + | _ -> None + | BinaryOp.ValuesOnlyIndexed f -> + match v1, v2 with + | Some a, Some b -> f prow pcol a b + | _ -> None + | BinaryOp.AllCells f -> f v1 v2 + | BinaryOp.AllCellsIndexed f -> f prow pcol v1 v2 + | BinaryOp.AtLeastOneValue f -> + match v1, v2 with + | Some a, Some b -> f (AtLeastOne.Both(a, b)) + | Some a, None -> f (AtLeastOne.Left a) + | None, Some b -> f (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.AtLeastOneValueIndexed f -> + match v1, v2 with + | Some a, Some b -> f prow pcol (AtLeastOne.Both(a, b)) + | Some a, None -> f prow pcol (AtLeastOne.Left a) + | None, Some b -> f prow pcol (AtLeastOne.Right b) + | None, None -> None + | BinaryOp.LeftValuesOnly f -> + match v1 with + | Some a -> f a v2 + | None -> None + | BinaryOp.LeftValuesOnlyIndexed f -> + match v1 with + | Some a -> f prow pcol a v2 + | None -> None + +let private isIndexedBinary (op: BinaryOp<'a, 'b, 'c>) = + match op with + | BinaryOp.ValuesOnlyIndexed _ + | BinaryOp.AllCellsIndexed _ + | BinaryOp.AtLeastOneValueIndexed _ + | BinaryOp.LeftValuesOnlyIndexed _ -> true + | _ -> false + +let private map2Inner + (matrix1: SparseMatrix<'a>) + (matrix2: SparseMatrix<'b>) + (op: BinaryOp<'a, 'b, 'c>) + : Result, Error> = + let rec inner + (prow: uint64) + (pcol: uint64) + (size: uint64) + (tree1: qtree>) + (tree2: qtree>) + : Result> * uint64, Error> = + let split + (x1: qtree>) + (x2: qtree>) + (x3: qtree>) + (x4: qtree>) + (y1: qtree>) + (y2: qtree>) + (y3: qtree>) + (y4: qtree>) + = + let halfSize = size / 2UL - match (inner new_size x1 y1), (inner new_size x2 y2), (inner new_size x3 y3), (inner new_size x4 y4) with - | 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) + let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = + getQuadrantCoords (prow, pcol) (uint64 halfSize) - match (matrix1, matrix2) with + match + (inner nwR nwC halfSize x1 y1), + (inner neR neC halfSize x2 y2), + (inner swR swC halfSize x3 y3), + (inner seR seC halfSize x4 y4) + with + | Ok(t1, nvals1), Ok(t2, nvals2), Ok(t3, nvals3), Ok(t4, nvals4) -> + Ok(mkNode t1 t2 t3 t4, nvals1 + nvals2 + nvals3 + nvals4) + | Error e, _, _, _ + | _, Error e, _, _ + | _, _, Error e, _ + | _, _, _, Error e -> Error e + + match tree1, tree2 with + | Node(x1, x2, x3, x4), Node(y1, y2, y3, y4) -> split x1 x2 x3 x4 y1 y2 y3 y4 + | Node(x1, x2, x3, x4), Leaf(v2) -> split x1 x2 x3 x4 (Leaf(v2)) (Leaf(v2)) (Leaf(v2)) (Leaf(v2)) + | Leaf(v1), Node(y1, y2, y3, y4) -> split (Leaf(v1)) (Leaf(v1)) (Leaf(v1)) (Leaf(v1)) y1 y2 y3 y4 | Leaf(Dummy), Leaf(Dummy) -> Ok(Leaf(Dummy), 0UL) | Leaf(UserValue(v1)), Leaf(UserValue(v2)) -> - let res = f v1 v2 - - let nnz = - match res with - | None -> 0UL - | _ -> (uint64 size) * (uint64 size) * 1UL + if size > 1UL && isIndexedBinary op then + split + (Leaf(UserValue(v1))) + (Leaf(UserValue(v1))) + (Leaf(UserValue(v1))) + (Leaf(UserValue(v1))) + (Leaf(UserValue(v2))) + (Leaf(UserValue(v2))) + (Leaf(UserValue(v2))) + (Leaf(UserValue(v2))) + else + let res = applyBinary op prow pcol v1 v2 - (Leaf(UserValue(res)), nnz) |> Ok + let nnz = + if res.IsSome then + (uint64 size) * (uint64 size) * 1UL + else + 0UL - | 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) -> Error Error.InconsistentStructureOfStorages + Ok(Leaf(UserValue(res)), nnz) + | _ -> 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 - | Error x -> Error x - | Ok(storage, nvals) -> - (SparseMatrix(matrix1.nrows, matrix1.ncols, nvals, (Storage(matrix1.storage.size, storage)))) - |> Ok + inner 0UL 0UL matrix1.storage.size matrix1.storage.data matrix2.storage.data + |> Result.map (fun (storage, nvals) -> + SparseMatrix(matrix1.nrows, matrix1.ncols, nvals, Storage(matrix1.storage.size, storage))) else 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 map2 (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.AllCells f) - let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = - getQuadrantCoords (prow, pcol) (uint64 halfSize) +let map2Values (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.ValuesOnly f) - 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 map2AllCells (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.AllCells f) - let (nwR, nwC), (neR, neC), (swR, swC), (seR, seC) = - getQuadrantCoords (prow, pcol) (uint64 halfSize) +let map2AtLeastOne (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.AtLeastOneValue f) - 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 map2LeftValues (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.LeftValuesOnly f) - 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 +let map2i (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.AllCellsIndexed f) - Leaf(UserValue(res)), nnz - | Leaf(UserValue(v)), Leaf(Dummy) -> - let res = f prow pcol v None +let map2iValues (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.ValuesOnlyIndexed f) - let nnz = - match res with - | Some _ -> 1UL - | None -> 0UL +let map2iAllCells (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.AllCellsIndexed f) - Leaf(UserValue(res)), nnz - | Leaf(Dummy), Leaf(UserValue(v)) -> - let res = f prow pcol None v +let map2iAtLeastOne (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.AtLeastOneValueIndexed f) - 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 map2iLeftValues (matrix1: SparseMatrix<'a>) (matrix2: SparseMatrix<'b>) f = + map2Inner matrix1 matrix2 (BinaryOp.LeftValuesOnlyIndexed f) 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 + mapInner matrix (UnaryOp.AllCellsIndexed f) - 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 mapiValues (matrix: SparseMatrix<'a>) f = + mapInner matrix (UnaryOp.ValuesOnlyIndexed f) let foldAssociative (folder: 'T option -> 'T option -> 'T option) (state: 'T option) (matrix: SparseMatrix<'T>) = let rec traverse tree (size: uint64) (state: 'T option) = From d00d900a1c61e6dfdec0d7407ef830cdbedc7559 Mon Sep 17 00:00:00 2001 From: Narysev Date: Tue, 22 Sep 2026 13:22:24 +0300 Subject: [PATCH 06/13] Fix review feedback: throw ArgumentOutOfRangeException on out-of-bounds access, deduplicate applyBinary --- QuadTree.Tests/Tests.COO.fs | 10 +++---- QuadTree.Tests/Tests.Matrix.fs | 6 ++-- QuadTree/COO.fs | 52 ++++++---------------------------- QuadTree/Matrix.fs | 15 ++++++---- 4 files changed, 25 insertions(+), 58 deletions(-) diff --git a/QuadTree.Tests/Tests.COO.fs b/QuadTree.Tests/Tests.COO.fs index 21a9b1a..aa39cf1 100644 --- a/QuadTree.Tests/Tests.COO.fs +++ b/QuadTree.Tests/Tests.COO.fs @@ -50,9 +50,8 @@ let ``cooGet out of bounds`` () = let coo = CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) - let actual = cooGet (coo, 5UL, 5UL) - - Assert.Equal(Error Error.InvalidElementIndex, actual) + Assert.Throws(fun () -> + cooGet (coo, 5UL, 5UL) |> ignore) // === cooUpdate tests === @@ -111,9 +110,8 @@ let ``cooUpdate out of bounds`` () = let coo = CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) - let actual = cooUpdate (coo, 5UL, 5UL, 99) - - Assert.Equal(Error Error.InvalidElementIndex, actual) + Assert.Throws(fun () -> + cooUpdate (coo, 5UL, 5UL, 99) |> ignore) // === cooMap tests === diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index 9cef022..c8126b6 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -668,7 +668,8 @@ let ``matrix get missing value`` () = [] let ``matrix get out of bounds`` () = let m = fromCoordinateList (CoordinateList(4UL, 4UL, [])) - Assert.Equal(Error Error.InvalidElementIndex, get m 5UL 5UL) + Assert.Throws(fun () -> + get m 5UL 5UL |> ignore) [] let ``matrix set replaces existing`` () = @@ -692,7 +693,8 @@ let ``matrix set inserts new`` () = [] let ``matrix set out of bounds`` () = let m = fromCoordinateList (CoordinateList(4UL, 4UL, [])) - Assert.Equal(Error Error.InvalidElementIndex, set m 5UL 5UL 99) + Assert.Throws(fun () -> + set m 5UL 5UL 99 |> ignore) [] let ``matrix set then get roundtrip`` () = diff --git a/QuadTree/COO.fs b/QuadTree/COO.fs index 046086f..6d7de54 100644 --- a/QuadTree/COO.fs +++ b/QuadTree/COO.fs @@ -9,8 +9,10 @@ let private range (count: uint64) = let cooGet (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64) : Result, Error> = - if uint64 rowindex >= uint64 coo.nrows || uint64 colindex >= uint64 coo.ncols then - Error Error.InvalidElementIndex + if uint64 rowindex >= uint64 coo.nrows then + raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) + elif uint64 colindex >= uint64 coo.ncols then + raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) else match coo.list |> List.tryFind (fun (i, j, _) -> i = rowindex && j = colindex) with | Some(_, _, value) -> Ok(Some value) @@ -19,8 +21,10 @@ let cooGet let cooUpdate (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64, value: 'a) : Result, Error> = - if uint64 rowindex >= uint64 coo.nrows || uint64 colindex >= uint64 coo.ncols then - Error Error.InvalidElementIndex + if uint64 rowindex >= uint64 coo.nrows then + raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) + elif uint64 colindex >= uint64 coo.ncols then + raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) else let mutable acc = [] let mutable rest = coo.list @@ -50,46 +54,6 @@ let cooUpdate Ok(CoordinateList(coo.nrows, coo.ncols, List.rev acc)) - -let private applyBinary - (op: BinaryOp<'a, 'b, 'c>) - (i: uint64) - (j: uint64) - (v1: Option<'a>) - (v2: Option<'b>) - : Option<'c> = - match op with - | BinaryOp.ValuesOnly f -> - match v1, v2 with - | Some a, Some b -> f a b - | _ -> None - | BinaryOp.ValuesOnlyIndexed f -> - match v1, v2 with - | Some a, Some b -> f i j a b - | _ -> None - | BinaryOp.AllCells f -> f v1 v2 - | BinaryOp.AllCellsIndexed f -> f i j v1 v2 - | BinaryOp.AtLeastOneValue f -> - match v1, v2 with - | Some a, Some b -> f (AtLeastOne.Both(a, b)) - | Some a, None -> f (AtLeastOne.Left a) - | None, Some b -> f (AtLeastOne.Right b) - | None, None -> None - | BinaryOp.AtLeastOneValueIndexed f -> - match v1, v2 with - | Some a, Some b -> f i j (AtLeastOne.Both(a, b)) - | Some a, None -> f i j (AtLeastOne.Left a) - | None, Some b -> f i j (AtLeastOne.Right b) - | None, None -> None - | BinaryOp.LeftValuesOnly f -> - match v1 with - | Some a -> f a v2 - | None -> None - | BinaryOp.LeftValuesOnlyIndexed f -> - match v1 with - | Some a -> f i j a v2 - | None -> None - let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : CoordinateList<'b> = let result = match op with diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index 74d6f6f..9196922 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -41,7 +41,6 @@ type SparseMatrix<'value> = type Error = | InconsistentStructureOfStorages | InconsistentSizeOfArguments - | InvalidElementIndex let mkNode x1 x2 x3 x4 = @@ -141,8 +140,10 @@ let empty nrows ncols = fromCoordinateList (CoordinateList(nrows, ncols, [])) let get (matrix: SparseMatrix<'a>) (row: uint64) (col: uint64) : Result, Error> = - if uint64 row >= uint64 matrix.nrows || uint64 col >= uint64 matrix.ncols then - Error Error.InvalidElementIndex + if uint64 row >= uint64 matrix.nrows then + raise (System.ArgumentOutOfRangeException("row", "Row index is outside the matrix bounds.")) + elif uint64 col >= uint64 matrix.ncols then + raise (System.ArgumentOutOfRangeException("col", "Column index is outside the matrix bounds.")) else let rec inner tree (pr: uint64) (pc: uint64) (size: uint64) = match tree with @@ -171,8 +172,10 @@ let set (col: uint64) (value: 'a) : Result, Error> = - if uint64 row >= uint64 matrix.nrows || uint64 col >= uint64 matrix.ncols then - Error Error.InvalidElementIndex + if uint64 row >= uint64 matrix.nrows then + raise (System.ArgumentOutOfRangeException("row", "Row index is outside the matrix bounds.")) + elif uint64 col >= uint64 matrix.ncols then + raise (System.ArgumentOutOfRangeException("col", "Column index is outside the matrix bounds.")) else let rec inner tree (pr: uint64) (pc: uint64) (size: uint64) = let halfSize = size / 2UL @@ -339,7 +342,7 @@ type BinaryOp<'a, 'b, 'c> = | LeftValuesOnly of ('a -> Option<'b> -> Option<'c>) | LeftValuesOnlyIndexed of (uint64 -> uint64 -> 'a -> Option<'b> -> Option<'c>) -let private applyBinary +let applyBinary (op: BinaryOp<'a, 'b, 'c>) (prow: uint64) (pcol: uint64) From 7a2996e9552f230a95a6f262fd747165176c7a3c Mon Sep 17 00:00:00 2001 From: Narysev Date: Tue, 22 Sep 2026 13:22:35 +0300 Subject: [PATCH 07/13] Add FsCheck property-based tests (6 properties, 194 tests total) --- QuadTree.Tests/PropertyTests.fs | 154 +++++++++++++++++++++++++++ QuadTree.Tests/QuadTree.Tests.fsproj | 2 + 2 files changed, 156 insertions(+) create mode 100644 QuadTree.Tests/PropertyTests.fs diff --git a/QuadTree.Tests/PropertyTests.fs b/QuadTree.Tests/PropertyTests.fs new file mode 100644 index 0000000..34bfb12 --- /dev/null +++ b/QuadTree.Tests/PropertyTests.fs @@ -0,0 +1,154 @@ +module QuadTree.Tests.PropertyTests + +open System +open Xunit +open FsCheck +open FsCheck.FSharp +open FsCheck.Xunit +open Matrix +open COO + +type Input = + { Rows: int + Cols: int + Cells: (int * int * int) list } + +let private toCoo (inp: Input) : CoordinateList = + let nrows = max 1 inp.Rows + let ncols = max 1 inp.Cols + + let entries = + inp.Cells + |> List.map (fun (r, c, v) -> (abs r, abs c, v)) + |> List.filter (fun (r, c, _) -> r < nrows && c < ncols) + |> List.distinctBy (fun (r, c, _) -> (r, c)) + |> List.map (fun (r, c, v) -> (uint64 r * 1UL, uint64 c * 1UL, v)) + |> List.sortBy (fun (r, c, _) -> (r, c)) + + CoordinateList(uint64 nrows * 1UL, uint64 ncols * 1UL, entries) + +let private arbInput : Arbitrary = + let gen = + gen { + let! rows = Gen.choose (1, 16) + let! cols = Gen.choose (1, 16) + + let! cells = + Gen.listOf (gen { + let! r = Gen.choose (-5, 20) + let! c = Gen.choose (-5, 20) + let! v = Gen.choose (-100, 100) + return (r, c, v) + }) + + return { Rows = rows; Cols = cols; Cells = cells } + } + + Arb.fromGen gen + +type InputArbs = + static member Input() = arbInput + +[ |])>] +let ``get at every cell agrees between QuadTree and COO`` (inp: Input) = + let coo = toCoo inp + let qt = fromCoordinateList coo + let nrows = int (uint64 coo.nrows) + let ncols = int (uint64 coo.ncols) + + List.allPairs [ 0 .. nrows - 1 ] [ 0 .. ncols - 1 ] + |> List.forall (fun (r, c) -> + let ri = uint64 r * 1UL + let ci = uint64 c * 1UL + + Matrix.get qt ri ci = cooGet (coo, ri, ci)) + +[ |])>] +let ``toCoordinateList (fromCoordinateList coo) preserves every value`` (inp: Input) = + let coo = toCoo inp + let back = toCoordinateList (fromCoordinateList coo) + + back.nrows = coo.nrows + && back.ncols = coo.ncols + && List.length back.list = List.length coo.list + && coo.list + |> List.forall (fun (r, c, v) -> cooGet (back, r, c) = Ok(Some v)) + +[ |])>] +let ``cooUpdate writes a value and adjusts the length`` (inp: Input) = + let coo = toCoo inp + let nrows = int (uint64 coo.nrows) + let ncols = int (uint64 coo.ncols) + let r = abs inp.Rows % nrows + let c = abs inp.Cols % ncols + let ri = uint64 r * 1UL + let ci = uint64 c * 1UL + let wasPresent = coo.list |> List.exists (fun (i, j, _) -> i = ri && j = ci) + + match cooUpdate (coo, ri, ci, 777) with + | Ok updated -> + cooGet (updated, ri, ci) = Ok(Some 777) + && List.length updated.list = List.length coo.list + (if wasPresent then 0 else 1) + | Error _ -> false + +[ |])>] +let ``set and cooUpdate agree on the written cell`` (inp: Input) = + let coo = toCoo inp + let qt = fromCoordinateList coo + let nrows = int (uint64 coo.nrows) + let ncols = int (uint64 coo.ncols) + let r = abs inp.Rows % nrows + let c = abs inp.Cols % ncols + let ri = uint64 r * 1UL + let ci = uint64 c * 1UL + + match cooUpdate (coo, ri, ci, 42), Matrix.set qt ri ci 42 with + | Ok updatedCoo, Ok updatedQt -> + cooGet (updatedCoo, ri, ci) = Matrix.get updatedQt ri ci + | _ -> false + +[ |])>] +let ``cooMapValues maps every stored value once`` (inp: Input) = + let coo = toCoo inp + let mapped = cooMapValues coo (fun v -> Some(v + 1)) + + List.length mapped.list = List.length coo.list + && coo.list + |> List.forall (fun (r, c, v) -> cooGet (mapped, r, c) = Ok(Some(v + 1))) + +[ |])>] +let ``out-of-bounds access raises ArgumentOutOfRangeException`` (inp: Input) = + let coo = toCoo inp + let qt = fromCoordinateList coo + let nrows = uint64 coo.nrows * 1UL + let ncols = uint64 coo.ncols * 1UL + + let cooGetThrows = + try + cooGet (coo, nrows, 0UL) |> ignore + false + with :? ArgumentOutOfRangeException -> + true + + let cooUpdateThrows = + try + cooUpdate (coo, nrows, 0UL, 1) |> ignore + false + with :? ArgumentOutOfRangeException -> + true + + let matrixGetThrows = + try + Matrix.get qt nrows 0UL |> ignore + false + with :? ArgumentOutOfRangeException -> + true + + let matrixSetThrows = + try + Matrix.set qt nrows 0UL 1 |> ignore + false + with :? ArgumentOutOfRangeException -> + true + + cooGetThrows && cooUpdateThrows && matrixGetThrows && matrixSetThrows \ No newline at end of file diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index dd6e038..4464305 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -10,6 +10,7 @@ + @@ -19,6 +20,7 @@ + From 0c5421b214911956505d8cff6f0a3a5f1352cfc1 Mon Sep 17 00:00:00 2001 From: Narysev Date: Wed, 23 Sep 2026 10:23:57 +0300 Subject: [PATCH 08/13] Use array storage with binary search in COO get/update --- QuadTree.Tests/PropertyTests.fs | 12 ++-- QuadTree.Tests/Tests.COO.fs | 36 +++++------ QuadTree/COO.fs | 107 ++++++++++++++++++-------------- QuadTree/Matrix.fs | 44 ++++++++++--- 4 files changed, 120 insertions(+), 79 deletions(-) diff --git a/QuadTree.Tests/PropertyTests.fs b/QuadTree.Tests/PropertyTests.fs index 34bfb12..6d61e6c 100644 --- a/QuadTree.Tests/PropertyTests.fs +++ b/QuadTree.Tests/PropertyTests.fs @@ -70,9 +70,9 @@ let ``toCoordinateList (fromCoordinateList coo) preserves every value`` (inp: In back.nrows = coo.nrows && back.ncols = coo.ncols - && List.length back.list = List.length coo.list + && Array.length back.list = Array.length coo.list && coo.list - |> List.forall (fun (r, c, v) -> cooGet (back, r, c) = Ok(Some v)) + |> Array.forall (fun (r, c, v) -> cooGet (back, r, c) = Ok(Some v)) [ |])>] let ``cooUpdate writes a value and adjusts the length`` (inp: Input) = @@ -83,12 +83,12 @@ let ``cooUpdate writes a value and adjusts the length`` (inp: Input) = let c = abs inp.Cols % ncols let ri = uint64 r * 1UL let ci = uint64 c * 1UL - let wasPresent = coo.list |> List.exists (fun (i, j, _) -> i = ri && j = ci) + let wasPresent = coo.list |> Array.exists (fun (i, j, _) -> i = ri && j = ci) match cooUpdate (coo, ri, ci, 777) with | Ok updated -> cooGet (updated, ri, ci) = Ok(Some 777) - && List.length updated.list = List.length coo.list + (if wasPresent then 0 else 1) + && Array.length updated.list = Array.length coo.list + (if wasPresent then 0 else 1) | Error _ -> false [ |])>] @@ -112,9 +112,9 @@ let ``cooMapValues maps every stored value once`` (inp: Input) = let coo = toCoo inp let mapped = cooMapValues coo (fun v -> Some(v + 1)) - List.length mapped.list = List.length coo.list + Array.length mapped.list = Array.length coo.list && coo.list - |> List.forall (fun (r, c, v) -> cooGet (mapped, r, c) = Ok(Some(v + 1))) + |> Array.forall (fun (r, c, v) -> cooGet (mapped, r, c) = Ok(Some(v + 1))) [ |])>] let ``out-of-bounds access raises ArgumentOutOfRangeException`` (inp: Input) = diff --git a/QuadTree.Tests/Tests.COO.fs b/QuadTree.Tests/Tests.COO.fs index aa39cf1..ed00a1c 100644 --- a/QuadTree.Tests/Tests.COO.fs +++ b/QuadTree.Tests/Tests.COO.fs @@ -196,7 +196,7 @@ let ``cooMap fills missing cells (general form)`` () = Assert.Equal(9, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, Some(2UL, 2UL, 5) ) @@ -407,7 +407,7 @@ let ``cooMapi fills missing cells (general form)`` () = Assert.Equal(9, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, Some(2UL, 2UL, 5) ) @@ -432,7 +432,7 @@ let ``cooMapi position-dependent fill of missing cells`` () = (1UL, 0UL, 1) (1UL, 1UL, 2) ] - Assert.Equal * uint64 * int>>(expected, actual.list) + Assert.Equal[]>(Array.ofList expected, actual.list) [] let ``cooMapi zero-size matrix`` () = @@ -562,7 +562,7 @@ let ``Sparse mxmcoo`` () = | Ok actual -> Assert.Equal(expected.nrows, actual.nrows) Assert.Equal(expected.ncols, actual.ncols) - Assert.Equal>(expected.list, actual.list) + Assert.Equal[]>(expected.list, actual.list) | Error e -> failwith (e.ToString()) [] @@ -595,7 +595,7 @@ let ``Shrinking mxmcoo`` () = | Ok actual -> Assert.Equal(expected.nrows, actual.nrows) Assert.Equal(expected.ncols, actual.ncols) - Assert.Equal>(expected.list, actual.list) + Assert.Equal[]>(expected.list, actual.list) | Error e -> failwith (e.ToString()) @@ -630,7 +630,7 @@ let ``mxmcoo with non-absorbing op_mult`` () = Assert.Equal(1UL, actual.nrows) Assert.Equal(1UL, actual.ncols) Assert.Equal(1, actual.list.Length) - Assert.Equal(Some 5, actual.list |> List.tryHead |> Option.map (fun (_, _, v) -> v)) + Assert.Equal(Some 5, actual.list |> Array.tryHead |> Option.map (fun (_, _, v) -> v)) | Error e -> failwith (e.ToString()) // === cooMapValues / cooMapiValues tests === @@ -645,7 +645,7 @@ let ``cooMapValues applies only to stored values`` () = Assert.Equal(2, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, Some(0UL, 0UL, 10) ) @@ -660,7 +660,7 @@ let ``cooMapiValues applies indexed only to stored values`` () = Assert.Equal(1, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 1UL && j = 2UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 1UL && j = 2UL) actual.list, Some(1UL, 2UL, 8) ) @@ -679,7 +679,7 @@ let ``cooMap2Values applies only where both present`` () = Assert.Equal(1, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, Some(0UL, 0UL, 11) ) | Error e -> failwithf "unexpected error %A" e @@ -722,17 +722,17 @@ let ``cooMap2AtLeastOne distinguishes both left right`` () = Assert.Equal(3, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, Some(0UL, 0UL, 11) ) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, Some(1UL, 1UL, 200) ) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 2UL && j = 2UL) actual.list, Some(2UL, 2UL, -30) ) | Error e -> failwithf "unexpected error %A" e @@ -750,12 +750,12 @@ let ``cooMap2LeftValues applies where left present`` () = Assert.Equal(2, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, Some(0UL, 0UL, 11) ) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, Some(1UL, 1UL, 2) ) | Error e -> failwithf "unexpected error %A" e @@ -790,7 +790,7 @@ let ``cooMap2iValues applies indexed where both present`` () = Assert.Equal(1, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, Some(1UL, 1UL, 14) ) | Error e -> failwithf "unexpected error %A" e @@ -833,12 +833,12 @@ let ``cooMap2iAtLeastOne passes indices and side`` () = Assert.Equal(2, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 0UL && j = 0UL) actual.list, Some(0UL, 0UL, 11) ) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, Some(1UL, 1UL, 121) ) | Error e -> failwithf "unexpected error %A" e @@ -859,7 +859,7 @@ let ``cooMap2iLeftValues applies indexed where left present`` () = Assert.Equal(1, actual.list.Length) Assert.Equal( - List.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, + Array.tryFind (fun (i, j, _) -> i = 1UL && j = 1UL) actual.list, Some(1UL, 1UL, 23) ) | Error e -> failwithf "unexpected error %A" e diff --git a/QuadTree/COO.fs b/QuadTree/COO.fs index 6d7de54..b192b1f 100644 --- a/QuadTree/COO.fs +++ b/QuadTree/COO.fs @@ -6,6 +6,16 @@ open Matrix let private range (count: uint64) = if count = 0UL then [] else [ 0UL .. count - 1UL ] +let private compareEntriesByRowCol (e1: COOEntry<'v>) (e2: COOEntry<'v>) = + let (i1, j1, _) = e1 + let (i2, j2, _) = e2 + let c = compare i1 i2 + if c <> 0 then c else compare j1 j2 + +let private entryComparer<'v> = + { new System.Collections.Generic.IComparer> with + member _.Compare(e1, e2) = compareEntriesByRowCol e1 e2 } + let cooGet (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64) : Result, Error> = @@ -14,9 +24,14 @@ let cooGet elif uint64 colindex >= uint64 coo.ncols then raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) else - match coo.list |> List.tryFind (fun (i, j, _) -> i = rowindex && j = colindex) with - | Some(_, _, value) -> Ok(Some value) - | None -> Ok None + let idx = + System.Array.BinarySearch(coo.list, (rowindex, colindex, Unchecked.defaultof<'a>), entryComparer<'a>) + + if idx >= 0 then + let (_, _, value) = coo.list.[idx] + Ok(Some value) + else + Ok None let cooUpdate (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64, value: 'a) @@ -26,50 +41,41 @@ let cooUpdate elif uint64 colindex >= uint64 coo.ncols then raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) else - let mutable acc = [] - let mutable rest = coo.list - let mutable inserted = false - - while rest <> [] && not inserted do - let (i, j, v) = rest.Head - - if i = rowindex && j = colindex then - acc <- (rowindex, colindex, value) :: acc - rest <- rest.Tail - inserted <- true - elif rowindex < i || (rowindex = i && colindex < j) then - acc <- (rowindex, colindex, value) :: acc - inserted <- true - else - acc <- (i, j, v) :: acc - rest <- rest.Tail + let idx = + System.Array.BinarySearch(coo.list, (rowindex, colindex, value), entryComparer<'a>) - if not inserted then - acc <- (rowindex, colindex, value) :: acc + if idx >= 0 then + let arr = Array.copy coo.list + arr.[idx] <- (rowindex, colindex, value) + Ok(Matrix.createCOO coo.nrows coo.ncols arr) + else + let insertAt = ~~~idx + let arr = Array.zeroCreate (coo.list.Length + 1) - while rest <> [] do - let entry = rest.Head - acc <- entry :: acc - rest <- rest.Tail + Array.blit coo.list 0 arr 0 insertAt + arr.[insertAt] <- (rowindex, colindex, value) + Array.blit coo.list insertAt arr (insertAt + 1) (coo.list.Length - insertAt) - Ok(CoordinateList(coo.nrows, coo.ncols, List.rev acc)) + Ok(Matrix.createCOO coo.nrows coo.ncols arr) let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : CoordinateList<'b> = + let entries = Array.toList coo.list + let result = match op with | UnaryOp.ValuesOnly f -> - coo.list + entries |> List.choose (fun (i, j, v) -> f v |> Option.map (fun r -> (i, j, r))) | UnaryOp.ValuesOnlyIndexed f -> - coo.list + entries |> List.choose (fun (i, j, v) -> f i j v |> Option.map (fun r -> (i, j, r))) | UnaryOp.AllCells f -> match f None with | None -> - coo.list + entries |> List.choose (fun (i, j, v) -> f (Some v) |> Option.map (fun r -> (i, j, r))) | Some fnone -> - let lookup = coo.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let lookup = entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList [ for i in range (uint64 coo.nrows) do let ri = i * 1UL @@ -86,7 +92,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi | Some value -> yield (ri, cj, value) | None -> () ] | UnaryOp.AllCellsIndexed f -> - let mutable rest = coo.list + let mutable rest = entries [ for i in range (uint64 coo.nrows) do let ri = i * 1UL @@ -105,7 +111,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi | Some value -> yield (ri, cj, value) | None -> () ] - CoordinateList(coo.nrows, coo.ncols, result) + Matrix.createCOO coo.nrows coo.ncols (Array.ofList result) let private mergeBinary (l1: COOEntry<'a> list) (l2: COOEntry<'b> list) (op: BinaryOp<'a, 'b, 'c>) : COOEntry<'c> list = let mutable acc = [] @@ -150,16 +156,18 @@ let private cooMap2Inner else let nrows = coo1.nrows let ncols = coo1.ncols + let entries1 = Array.toList coo1.list + let entries2 = Array.toList coo2.list let result = match op with | BinaryOp.AllCells f -> match f None None with - | None -> mergeBinary coo1.list coo2.list op + | None -> mergeBinary entries1 entries2 op | Some _ -> - let lookup1 = coo1.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let lookup1 = entries1 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - let lookup2 = coo2.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let lookup2 = entries2 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList [ for i in range (uint64 nrows) do let ri = i * 1UL @@ -171,8 +179,8 @@ let private cooMap2Inner | Some value -> yield (ri, cj, value) | None -> () ] | BinaryOp.AllCellsIndexed f -> - let mutable rest1 = coo1.list - let mutable rest2 = coo2.list + let mutable rest1 = entries1 + let mutable rest2 = entries2 [ for i in range (uint64 nrows) do let ri = i * 1UL @@ -197,9 +205,9 @@ let private cooMap2Inner match f ri cj v1 v2 with | Some value -> yield (ri, cj, value) | None -> () ] - | _ -> mergeBinary coo1.list coo2.list op + | _ -> mergeBinary entries1 entries2 op - CoordinateList(nrows, ncols, result) |> Ok + Matrix.createCOO nrows ncols (Array.ofList result) |> Ok let cooMap (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.AllCells f) @@ -250,8 +258,11 @@ let mxmcoo if uint64 m1.ncols <> uint64 m2.nrows then Error Error.InconsistentSizeOfArguments else - let firstA = m1.list |> List.tryHead |> Option.map (fun (_, _, v) -> v) - let firstB = m2.list |> List.tryHead |> Option.map (fun (_, _, v) -> v) + let entries1 = Array.toList m1.list + let entries2 = Array.toList m2.list + + let firstA = entries1 |> List.tryHead |> Option.map (fun (_, _, v) -> v) + let firstB = entries2 |> List.tryHead |> Option.map (fun (_, _, v) -> v) let canOptimize = let noneNone = op_mult None None = None @@ -279,8 +290,8 @@ let mxmcoo noneNone && multSomeNone && multNoneSome && addNoneSome && addSomeNone if canOptimize then - let m1ByRow = m1.list |> List.groupBy (fun (i, _, _) -> i) |> Map.ofList - let m2ByRow = m2.list |> List.groupBy (fun (k, _, _) -> k) |> Map.ofList + let m1ByRow = entries1 |> List.groupBy (fun (i, _, _) -> i) |> Map.ofList + let m2ByRow = entries2 |> List.groupBy (fun (k, _, _) -> k) |> Map.ofList let result = [ for KeyValue(i, m1Entries) in m1ByRow do @@ -304,10 +315,10 @@ let mxmcoo |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) |> List.sortBy (fun (i, j, _) -> (i, j)) - CoordinateList(m1.nrows, m2.ncols, grouped) |> Ok + Matrix.createCOO m1.nrows m2.ncols (Array.ofList grouped) |> Ok else - let m1Map = m1.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - let m2Map = m2.list |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let m1Map = entries1 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let m2Map = entries2 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList let kCount = uint64 m1.ncols let result = @@ -329,4 +340,4 @@ let mxmcoo | Some value -> yield (ri, cj, value) | None -> () ] - CoordinateList(m1.nrows, m2.ncols, result) |> Ok + Matrix.createCOO m1.nrows m2.ncols (Array.ofList result) |> Ok diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index 9196922..c5135b6 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -66,15 +66,45 @@ type COOEntry<'value> = uint64 * uint64 * 'value type CoordinateList<'value> = val nrows: uint64 val ncols: uint64 - val list: COOEntry<'value> list + val list: COOEntry<'value>[] + + new(_nrows, _ncols, _list: COOEntry<'value> seq) = + let sorted = + _list + |> Seq.toArray + |> Array.sortWith (fun (i1, j1, _) (i2, j2, _) -> + let c = compare i1 i2 + if c <> 0 then c else compare j1 j2) + + { nrows = _nrows + ncols = _ncols + list = sorted } + + new(_nrows, _ncols, _list: COOEntry<'value>[], _presorted: bool) = + let sorted = + if _presorted then + _list + else + _list + |> Array.sortWith (fun (i1, j1, _) (i2, j2, _) -> + let c = compare i1 i2 + if c <> 0 then c else compare j1 j2) - new(_nrows, _ncols, _list) = { nrows = _nrows ncols = _ncols - list = _list } + list = sorted } + + // Fast factory: does NOT re-sort, expects an already sorted array. + // Used by COO operations whose results are built in (row, col) order and + // by cooUpdate, which maintains the sorted invariant itself. + static member Create(nrows: uint64, ncols: uint64, entries: COOEntry<'value>[]) : CoordinateList<'value> = + CoordinateList<'value>(nrows, ncols, entries, true) + +let internal createCOO (nrows: uint64) (ncols: uint64) (entries: COOEntry<'value>[]) : CoordinateList<'value> = + CoordinateList<'value>.Create(nrows, ncols, entries) let fromCoordinateList (coo: CoordinateList<'a>) = - let nvals = (uint64 <| List.length coo.list) * 1UL + let nvals = (uint64 <| Array.length coo.list) * 1UL let nrows = coo.nrows let ncols = coo.ncols @@ -107,7 +137,7 @@ let fromCoordinateList (coo: CoordinateList<'a>) = (traverse swCoo swp halfSize) (traverse seCoo sep halfSize) - let tree = traverse coo.list (0UL, 0UL) storageSize + let tree = traverse (Array.toList coo.list) (0UL, 0UL) storageSize SparseMatrix(nrows, ncols, nvals, Storage(storageSize * 1UL, tree)) @@ -134,10 +164,10 @@ let toCoordinateList (matrix: SparseMatrix<'a>) = let coo = traverse matrix.storage.data (0UL, 0UL) (uint64 matrix.storage.size) - CoordinateList(nrows, ncols, coo) + CoordinateList(nrows, ncols, Array.ofList coo) let empty nrows ncols = - fromCoordinateList (CoordinateList(nrows, ncols, [])) + fromCoordinateList (CoordinateList(nrows, ncols, Array.empty)) let get (matrix: SparseMatrix<'a>) (row: uint64) (col: uint64) : Result, Error> = if uint64 row >= uint64 matrix.nrows then From 054e69e630f1f8317cff121c4a010efab4b6a775 Mon Sep 17 00:00:00 2001 From: Narysev Date: Thu, 24 Sep 2026 10:22:15 +0300 Subject: [PATCH 09/13] Format files with Fantomas 7 (fix CI format-check) --- QuadTree.Benchmark/RealMatrixBenchmark.fs | 193 ++++++++++++++++++++++ QuadTree.Benchmark/Utils.fs | 15 +- QuadTree.Tests/PropertyTests.fs | 31 ++-- QuadTree.Tests/Tests.COO.fs | 3 +- QuadTree.Tests/Tests.Matrix.fs | 6 +- QuadTree/COO.fs | 4 +- QuadTree/Matrix.fs | 13 +- 7 files changed, 234 insertions(+), 31 deletions(-) create mode 100644 QuadTree.Benchmark/RealMatrixBenchmark.fs diff --git a/QuadTree.Benchmark/RealMatrixBenchmark.fs b/QuadTree.Benchmark/RealMatrixBenchmark.fs new file mode 100644 index 0000000..d8bab67 --- /dev/null +++ b/QuadTree.Benchmark/RealMatrixBenchmark.fs @@ -0,0 +1,193 @@ +namespace QuadTree.Benchmarks.RealMatrices + +open System +open System.IO +open BenchmarkDotNet.Attributes +open Matrix +open COO + +[)>] +[] +type RealMatrixBenchmark() = + + let mutable cooMatrix = Unchecked.defaultof> + let mutable qtMatrix = Unchecked.defaultof> + + let mutable resultCoo = Unchecked.defaultof> + let mutable resultQt = Unchecked.defaultof> + let mutable resultCooVal = 0.0 + let mutable resultQtVal = 0.0 + + let mutable lookupCoords: (uint64 * uint64) array = [||] + let mutable lookupValues: double array = [||] + + let mutable matrixName = "" + let mutable doMxm = false + let mutable skip = false + + [] + member val MatrixName = "" with get, set + + [] + member this.Setup() = + matrixName <- this.MatrixName + skip <- false + let dataDir = Path.GetFullPath(QuadTree.Benchmarks.Utils.DIR_WITH_MATRICES) + let mtxPath = Path.Combine(dataDir, matrixName + ".mtx") + + if not (File.Exists mtxPath) then + skip <- true + else + let isSymmetric = + File.ReadLines(mtxPath) + |> Seq.exists (fun s -> s.StartsWith "%%MatrixMarket" && s.Contains "symmetric") + + let (coo, qt) = QuadTree.Benchmarks.Utils.readMtxRaw mtxPath (not isSymmetric) + + cooMatrix <- coo + qtMatrix <- qt + + let nnz = coo.list.Length + let dim = max (uint64 coo.nrows) (uint64 coo.ncols) + doMxm <- nnz < 100000 && dim <= 12119UL + + let rng = Random(42) + let sampleSize = min nnz 1000 + let coords = coo.list + let indices = Array.init sampleSize (fun _ -> rng.Next(nnz)) + + lookupCoords <- + indices + |> Array.map (fun k -> + let (i, j, _) = coords.[k] + (i, j)) + + lookupValues <- + indices + |> Array.map (fun k -> + let (_, _, v) = coords.[k] + v) + + [] + member this.CooMap() = + if not skip then + resultCoo <- cooMap cooMatrix (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.QtMap() = + if not skip then + resultQt <- map qtMatrix (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.CooMapi() = + if not skip then + resultCoo <- + cooMapi cooMatrix (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.QtMapi() = + if not skip then + resultQt <- mapi qtMatrix (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.CooGet() = + if not skip then + let mutable acc = 0.0 + + for k = 0 to lookupCoords.Length - 1 do + let (i, j) = lookupCoords.[k] + + match cooGet (cooMatrix, i, j) with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultCooVal <- acc + + [] + member this.QtGet() = + if not skip then + let mutable acc = 0.0 + + for k = 0 to lookupCoords.Length - 1 do + let (i, j) = lookupCoords.[k] + + match get qtMatrix i j with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultQtVal <- acc + + [] + member this.CooSet() = + if not skip then + let mutable m = cooMatrix + + for k = 0 to lookupCoords.Length - 1 do + let (i, j) = lookupCoords.[k] + + match cooUpdate (m, i, j, lookupValues.[k] * 2.0) with + | Ok updated -> m <- updated + | _ -> () + + resultCoo <- m + + [] + member this.QtSet() = + if not skip then + let mutable m = qtMatrix + + for k = 0 to lookupCoords.Length - 1 do + let (i, j) = lookupCoords.[k] + + match set m i j (lookupValues.[k] * 2.0) with + | Ok updated -> m <- updated + | _ -> () + + resultQt <- m + + [] + member this.CooMxm() = + if not skip && doMxm then + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match mxmcoo op_add op_mult cooMatrix cooMatrix with + | Ok result -> resultCoo <- result + | Error _ -> failwith "mxmcoo failed" + + [] + member this.QtMxm() = + if not skip && doMxm then + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match LinearAlgebra.mxm op_add op_mult qtMatrix qtMatrix with + | Ok result -> resultQt <- result + | Error _ -> failwith "mxm failed" diff --git a/QuadTree.Benchmark/Utils.fs b/QuadTree.Benchmark/Utils.fs index b71d03d..fbb98be 100644 --- a/QuadTree.Benchmark/Utils.fs +++ b/QuadTree.Benchmark/Utils.fs @@ -23,7 +23,7 @@ let readMtxRaw path directed = let lines = File.ReadLines(path) let removedComments = lines |> Seq.skipWhile (fun s -> s.[0] = '%') - let linewords = removedComments |> Seq.map (fun s -> s.Split [|' '|]) + let linewords = removedComments |> Seq.map (fun s -> s.Split [| ' ' |]) let first = Seq.head linewords let nrows, ncols, nnz = uint64 first.[0], uint64 first.[1], int first.[2] @@ -33,11 +33,16 @@ let readMtxRaw path directed = let lst = getCooList tl if (directed && nnz <> lst.Length) || ((not directed) && nnz * 2 <> lst.Length) then - failwithf "Incorrect matrix reading. Path: %A expected nnz: %A actual nnz: %A" path (if directed then nnz else nnz * 2) lst.Length + failwithf + "Incorrect matrix reading. Path: %A expected nnz: %A actual nnz: %A" + path + (if directed then nnz else nnz * 2) + lst.Length + + let coo = + Matrix.CoordinateList(nrows * 1UL, ncols * 1UL, lst) - let coo = Matrix.CoordinateList(nrows * 1UL, ncols * 1UL, lst) let qt = Matrix.fromCoordinateList coo (coo, qt) -let readMtx path directed = - readMtxRaw path directed |> snd +let readMtx path directed = readMtxRaw path directed |> snd diff --git a/QuadTree.Tests/PropertyTests.fs b/QuadTree.Tests/PropertyTests.fs index 6d61e6c..01b2e94 100644 --- a/QuadTree.Tests/PropertyTests.fs +++ b/QuadTree.Tests/PropertyTests.fs @@ -27,21 +27,26 @@ let private toCoo (inp: Input) : CoordinateList = CoordinateList(uint64 nrows * 1UL, uint64 ncols * 1UL, entries) -let private arbInput : Arbitrary = +let private arbInput: Arbitrary = let gen = gen { let! rows = Gen.choose (1, 16) let! cols = Gen.choose (1, 16) let! cells = - Gen.listOf (gen { - let! r = Gen.choose (-5, 20) - let! c = Gen.choose (-5, 20) - let! v = Gen.choose (-100, 100) - return (r, c, v) - }) - - return { Rows = rows; Cols = cols; Cells = cells } + Gen.listOf ( + gen { + let! r = Gen.choose (-5, 20) + let! c = Gen.choose (-5, 20) + let! v = Gen.choose (-100, 100) + return (r, c, v) + } + ) + + return + { Rows = rows + Cols = cols + Cells = cells } } Arb.fromGen gen @@ -71,8 +76,7 @@ let ``toCoordinateList (fromCoordinateList coo) preserves every value`` (inp: In back.nrows = coo.nrows && back.ncols = coo.ncols && Array.length back.list = Array.length coo.list - && coo.list - |> Array.forall (fun (r, c, v) -> cooGet (back, r, c) = Ok(Some v)) + && coo.list |> Array.forall (fun (r, c, v) -> cooGet (back, r, c) = Ok(Some v)) [ |])>] let ``cooUpdate writes a value and adjusts the length`` (inp: Input) = @@ -103,8 +107,7 @@ let ``set and cooUpdate agree on the written cell`` (inp: Input) = let ci = uint64 c * 1UL match cooUpdate (coo, ri, ci, 42), Matrix.set qt ri ci 42 with - | Ok updatedCoo, Ok updatedQt -> - cooGet (updatedCoo, ri, ci) = Matrix.get updatedQt ri ci + | Ok updatedCoo, Ok updatedQt -> cooGet (updatedCoo, ri, ci) = Matrix.get updatedQt ri ci | _ -> false [ |])>] @@ -151,4 +154,4 @@ let ``out-of-bounds access raises ArgumentOutOfRangeException`` (inp: Input) = with :? ArgumentOutOfRangeException -> true - cooGetThrows && cooUpdateThrows && matrixGetThrows && matrixSetThrows \ No newline at end of file + cooGetThrows && cooUpdateThrows && matrixGetThrows && matrixSetThrows diff --git a/QuadTree.Tests/Tests.COO.fs b/QuadTree.Tests/Tests.COO.fs index ed00a1c..3eb7570 100644 --- a/QuadTree.Tests/Tests.COO.fs +++ b/QuadTree.Tests/Tests.COO.fs @@ -50,8 +50,7 @@ let ``cooGet out of bounds`` () = let coo = CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) - Assert.Throws(fun () -> - cooGet (coo, 5UL, 5UL) |> ignore) + Assert.Throws(fun () -> cooGet (coo, 5UL, 5UL) |> ignore) // === cooUpdate tests === diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index c8126b6..7a353b7 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -668,8 +668,7 @@ let ``matrix get missing value`` () = [] let ``matrix get out of bounds`` () = let m = fromCoordinateList (CoordinateList(4UL, 4UL, [])) - Assert.Throws(fun () -> - get m 5UL 5UL |> ignore) + Assert.Throws(fun () -> get m 5UL 5UL |> ignore) [] let ``matrix set replaces existing`` () = @@ -693,8 +692,7 @@ let ``matrix set inserts new`` () = [] let ``matrix set out of bounds`` () = let m = fromCoordinateList (CoordinateList(4UL, 4UL, [])) - Assert.Throws(fun () -> - set m 5UL 5UL 99 |> ignore) + Assert.Throws(fun () -> set m 5UL 5UL 99 |> ignore) [] let ``matrix set then get roundtrip`` () = diff --git a/QuadTree/COO.fs b/QuadTree/COO.fs index b192b1f..8cf7484 100644 --- a/QuadTree/COO.fs +++ b/QuadTree/COO.fs @@ -63,9 +63,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi let result = match op with - | UnaryOp.ValuesOnly f -> - entries - |> List.choose (fun (i, j, v) -> f v |> Option.map (fun r -> (i, j, r))) + | UnaryOp.ValuesOnly f -> entries |> List.choose (fun (i, j, v) -> f v |> Option.map (fun r -> (i, j, r))) | UnaryOp.ValuesOnlyIndexed f -> entries |> List.choose (fun (i, j, v) -> f i j v |> Option.map (fun r -> (i, j, r))) diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index c5135b6..01b5c3d 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -97,10 +97,16 @@ type CoordinateList<'value> = // Fast factory: does NOT re-sort, expects an already sorted array. // Used by COO operations whose results are built in (row, col) order and // by cooUpdate, which maintains the sorted invariant itself. - static member Create(nrows: uint64, ncols: uint64, entries: COOEntry<'value>[]) : CoordinateList<'value> = + static member Create + (nrows: uint64, ncols: uint64, entries: COOEntry<'value>[]) + : CoordinateList<'value> = CoordinateList<'value>(nrows, ncols, entries, true) -let internal createCOO (nrows: uint64) (ncols: uint64) (entries: COOEntry<'value>[]) : CoordinateList<'value> = +let internal createCOO + (nrows: uint64) + (ncols: uint64) + (entries: COOEntry<'value>[]) + : CoordinateList<'value> = CoordinateList<'value>.Create(nrows, ncols, entries) let fromCoordinateList (coo: CoordinateList<'a>) = @@ -137,7 +143,8 @@ let fromCoordinateList (coo: CoordinateList<'a>) = (traverse swCoo swp halfSize) (traverse seCoo sep halfSize) - let tree = traverse (Array.toList coo.list) (0UL, 0UL) storageSize + let tree = + traverse (Array.toList coo.list) (0UL, 0UL) storageSize SparseMatrix(nrows, ncols, nvals, Storage(storageSize * 1UL, tree)) From 64868bfec413ebb111a8dd876d3d0fa519deb073 Mon Sep 17 00:00:00 2001 From: Narysev Date: Thu, 24 Sep 2026 11:05:48 +0300 Subject: [PATCH 10/13] Add list-based COO representation (COOList) --- QuadTree/COOList.fs | 350 +++++++++++++++++++++++++++++++++++++++ QuadTree/QuadTree.fsproj | 1 + 2 files changed, 351 insertions(+) create mode 100644 QuadTree/COOList.fs diff --git a/QuadTree/COOList.fs b/QuadTree/COOList.fs new file mode 100644 index 0000000..001c8e0 --- /dev/null +++ b/QuadTree/COOList.fs @@ -0,0 +1,350 @@ +module COOList + +open Common +open Matrix + +let private range (count: uint64) = + if count = 0UL then [] else [ 0UL .. count - 1UL ] + +[] +type ListCOO<'value> = + val nrows: uint64 + val ncols: uint64 + val entries: COOEntry<'value> list + + new(_nrows, _ncols, _entries: COOEntry<'value> list) = + { nrows = _nrows + ncols = _ncols + entries = _entries } + +let fromArray (coo: CoordinateList<'a>) : ListCOO<'a> = + ListCOO<'a>(coo.nrows, coo.ncols, Array.toList coo.list) + +let toArray (coo: ListCOO<'a>) : CoordinateList<'a> = + Matrix.createCOO coo.nrows coo.ncols (Array.ofList coo.entries) + +let cooGet (coo: ListCOO<'a>, rowindex: uint64, colindex: uint64) : Result, Error> = + if uint64 rowindex >= uint64 coo.nrows then + raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) + elif uint64 colindex >= uint64 coo.ncols then + raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) + else + match coo.entries |> List.tryFind (fun (i, j, _) -> i = rowindex && j = colindex) with + | Some(_, _, value) -> Ok(Some value) + | None -> Ok None + +let cooUpdate + (coo: ListCOO<'a>, rowindex: uint64, colindex: uint64, value: 'a) + : Result, Error> = + if uint64 rowindex >= uint64 coo.nrows then + raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) + elif uint64 colindex >= uint64 coo.ncols then + raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) + else + let mutable acc = [] + let mutable rest = coo.entries + let mutable inserted = false + + while rest <> [] && not inserted do + let (i, j, v) = rest.Head + + if i = rowindex && j = colindex then + acc <- (rowindex, colindex, value) :: acc + rest <- rest.Tail + inserted <- true + elif rowindex < i || (rowindex = i && colindex < j) then + acc <- (rowindex, colindex, value) :: acc + inserted <- true + else + acc <- (i, j, v) :: acc + rest <- rest.Tail + + if not inserted then + acc <- (rowindex, colindex, value) :: acc + + while rest <> [] do + let entry = rest.Head + acc <- entry :: acc + rest <- rest.Tail + + Ok(ListCOO<'a>(coo.nrows, coo.ncols, List.rev acc)) + +let private cooMapInner (coo: ListCOO<'a>) (op: UnaryOp<'a, 'b>) : ListCOO<'b> = + let result = + match op with + | UnaryOp.ValuesOnly f -> + coo.entries + |> List.choose (fun (i, j, v) -> f v |> Option.map (fun r -> (i, j, r))) + | UnaryOp.ValuesOnlyIndexed f -> + coo.entries + |> List.choose (fun (i, j, v) -> f i j v |> Option.map (fun r -> (i, j, r))) + | UnaryOp.AllCells f -> + match f None with + | None -> + coo.entries + |> List.choose (fun (i, j, v) -> f (Some v) |> Option.map (fun r -> (i, j, r))) + | Some fnone -> + let lookup = coo.entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + + [ for i in range (uint64 coo.nrows) do + let ri = i * 1UL + + for j in range (uint64 coo.ncols) do + let cj = j * 1UL + + let res = + match Map.tryFind (ri, cj) lookup with + | Some value -> f (Some value) + | None -> Some fnone + + match res with + | Some value -> yield (ri, cj, value) + | None -> () ] + | UnaryOp.AllCellsIndexed f -> + let mutable rest = coo.entries + + [ for i in range (uint64 coo.nrows) do + let ri = i * 1UL + + for j in range (uint64 coo.ncols) do + let cj = j * 1UL + + let value = + match rest with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest <- tail + Some ev + | _ -> None + + match f ri cj value with + | Some value -> yield (ri, cj, value) + | None -> () ] + + ListCOO<'b>(coo.nrows, coo.ncols, result) + +let private mergeBinary (l1: COOEntry<'a> list) (l2: COOEntry<'b> list) (op: BinaryOp<'a, 'b, 'c>) : COOEntry<'c> list = + let mutable acc = [] + let mutable rest1 = l1 + let mutable rest2 = l2 + + let emit i j v1 v2 = + match applyBinary op i j v1 v2 with + | Some r -> acc <- (i, j, r) :: acc + | None -> () + + while rest1 <> [] || rest2 <> [] do + match rest1, rest2 with + | [], [] -> () + | (i, j, v1) :: t1, [] -> + emit i j (Some v1) None + rest1 <- t1 + | [], (i, j, v2) :: t2 -> + emit i j None (Some v2) + rest2 <- t2 + | (i1, j1, v1) :: t1, (i2, j2, v2) :: t2 -> + if i1 = i2 && j1 = j2 then + emit i1 j1 (Some v1) (Some v2) + rest1 <- t1 + rest2 <- t2 + elif (i1, j1) < (i2, j2) then + emit i1 j1 (Some v1) None + rest1 <- t1 + else + emit i2 j2 None (Some v2) + rest2 <- t2 + + List.rev acc + +let private cooMap2Inner + (coo1: ListCOO<'a>) + (coo2: ListCOO<'b>) + (op: BinaryOp<'a, 'b, 'c>) + : Result, Error> = + if uint64 coo1.nrows <> uint64 coo2.nrows || uint64 coo1.ncols <> uint64 coo2.ncols then + Error Error.InconsistentSizeOfArguments + else + let nrows = coo1.nrows + let ncols = coo1.ncols + + let result = + match op with + | BinaryOp.AllCells f -> + match f None None with + | None -> mergeBinary coo1.entries coo2.entries op + | Some _ -> + let lookup1 = coo1.entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + + let lookup2 = coo2.entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + + [ for i in range (uint64 nrows) do + let ri = i * 1UL + + for j in range (uint64 ncols) do + let cj = j * 1UL + + match f (Map.tryFind (ri, cj) lookup1) (Map.tryFind (ri, cj) lookup2) with + | Some value -> yield (ri, cj, value) + | None -> () ] + | BinaryOp.AllCellsIndexed f -> + let mutable rest1 = coo1.entries + let mutable rest2 = coo2.entries + + [ for i in range (uint64 nrows) do + let ri = i * 1UL + + for j in range (uint64 ncols) do + let cj = j * 1UL + + let v1 = + match rest1 with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest1 <- tail + Some ev + | _ -> None + + let v2 = + match rest2 with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest2 <- tail + Some ev + | _ -> None + + match f ri cj v1 v2 with + | Some value -> yield (ri, cj, value) + | None -> () ] + | _ -> mergeBinary coo1.entries coo2.entries op + + ListCOO<'c>(nrows, ncols, result) |> Ok + +let cooMap (coo: ListCOO<'a>) f = cooMapInner coo (UnaryOp.AllCells f) + +let cooMapValues (coo: ListCOO<'a>) f = cooMapInner coo (UnaryOp.ValuesOnly f) + +let cooMapi (coo: ListCOO<'a>) f = + cooMapInner coo (UnaryOp.AllCellsIndexed f) + +let cooMapiValues (coo: ListCOO<'a>) f = + cooMapInner coo (UnaryOp.ValuesOnlyIndexed f) + +let cooMap2 (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) + +let cooMap2Values (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnly f) + +let cooMap2AllCells (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) + +let cooMap2AtLeastOne (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValue f) + +let cooMap2LeftValues (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnly f) + +let cooMap2i (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) + +let cooMap2iValues (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnlyIndexed f) + +let cooMap2iAllCells (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) + +let cooMap2iAtLeastOne (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValueIndexed f) + +let cooMap2iLeftValues (coo1: ListCOO<'a>) (coo2: ListCOO<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnlyIndexed f) + +let mxmcoo + (op_add: 'c option -> 'c option -> 'c option) + (op_mult: 'a option -> 'b option -> 'c option) + (m1: ListCOO<'a>) + (m2: ListCOO<'b>) + = + if uint64 m1.ncols <> uint64 m2.nrows then + Error Error.InconsistentSizeOfArguments + else + let entries1 = m1.entries + let entries2 = m2.entries + + let firstA = entries1 |> List.tryHead |> Option.map (fun (_, _, v) -> v) + let firstB = entries2 |> List.tryHead |> Option.map (fun (_, _, v) -> v) + + let canOptimize = + let noneNone = op_mult None None = None + + let multSomeNone = + match firstA with + | Some v -> op_mult (Some v) None = None + | None -> noneNone + + let multNoneSome = + match firstB with + | Some v -> op_mult None (Some v) = None + | None -> noneNone + + let addNoneSome = + match firstA with + | Some v -> op_add (Some v) None = Some v + | None -> noneNone + + let addSomeNone = + match firstB with + | Some v -> op_add None (Some v) = Some v + | None -> noneNone + + noneNone && multSomeNone && multNoneSome && addNoneSome && addSomeNone + + if canOptimize then + let m1ByRow = entries1 |> List.groupBy (fun (i, _, _) -> i) |> Map.ofList + let m2ByRow = entries2 |> List.groupBy (fun (k, _, _) -> k) |> Map.ofList + + let result = + [ for KeyValue(i, m1Entries) in m1ByRow do + for (_, k, v1) in m1Entries do + let kAsRow = uint64 k * 1UL + + match m2ByRow |> Map.tryFind kAsRow with + | Some m2Entries -> + for (_, j, v2) in m2Entries do + match op_mult (Some v1) (Some v2) with + | Some product -> yield (i, j, product) + | None -> () + | None -> () ] + + let grouped = + result + |> List.groupBy (fun (i, j, _) -> (i, j)) + |> List.map (fun ((i, j), entries) -> + let sum = entries |> List.map (fun (_, _, v) -> Some v) |> List.reduce op_add + (i, j, sum)) + |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) + |> List.sortBy (fun (i, j, _) -> (i, j)) + + ListCOO<'c>(m1.nrows, m2.ncols, grouped) |> Ok + else + let m1Map = entries1 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let m2Map = entries2 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let kCount = uint64 m1.ncols + + let result = + [ for i in range (uint64 m1.nrows) do + let ri = i * 1UL + + for j in range (uint64 m2.ncols) do + let cj = j * 1UL + + let products = + [ for k in range kCount do + let a = m1Map |> Map.tryFind (ri, k * 1UL) + let b = m2Map |> Map.tryFind (k * 1UL, cj) + yield op_mult a b ] + + let sum = products |> List.fold (fun acc p -> op_add acc p) None + + match sum with + | Some value -> yield (ri, cj, value) + | None -> () ] + + ListCOO<'c>(m1.nrows, m2.ncols, result) |> Ok diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 618aded..8648347 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -10,6 +10,7 @@ + From 58ebcba2759ae82751e47d634adba7aa27d70547 Mon Sep 17 00:00:00 2001 From: Narysev Date: Fri, 25 Sep 2026 11:39:32 +0300 Subject: [PATCH 11/13] Add missing FormatBenchmarks.fs referenced by benchmark project --- QuadTree.Benchmark/FormatBenchmarks.fs | 351 +++++++++++++++++++++++++ 1 file changed, 351 insertions(+) create mode 100644 QuadTree.Benchmark/FormatBenchmarks.fs diff --git a/QuadTree.Benchmark/FormatBenchmarks.fs b/QuadTree.Benchmark/FormatBenchmarks.fs new file mode 100644 index 0000000..2e0a62a --- /dev/null +++ b/QuadTree.Benchmark/FormatBenchmarks.fs @@ -0,0 +1,351 @@ +namespace QuadTree.Benchmarks.Formats + +open System +open BenchmarkDotNet.Attributes +open Matrix +open COO + +[)>] +type FormatBenchmark() = + + let mutable cooMatrix1 = Unchecked.defaultof> + let mutable cooMatrix2 = Unchecked.defaultof> + let mutable qtMatrix1 = Unchecked.defaultof> + let mutable qtMatrix2 = Unchecked.defaultof> + + let mutable lookupCoords: (uint64 * uint64) array = [||] + let mutable lookupValues: double array = [||] + + let mutable resultCoo = Unchecked.defaultof> + let mutable resultQt = Unchecked.defaultof> + let mutable resultCooVal = 0.0 + let mutable resultQtVal = 0.0 + + [] + member val Size = 0 with get, set + + [] + member val FillRate = 0.0 with get, set + + [] + member this.Setup() = + let rng = Random(42) + let size = uint64 this.Size + let totalCells = float (size * size) + let targetNnz = max 10 (int (totalCells * this.FillRate)) + + let generateEntries count = + let entries = System.Collections.Generic.HashSet() + + [ 1..count ] + |> List.map (fun _ -> + let mutable i = 0UL + let mutable j = 0UL + + while entries.Contains((i, j)) || i >= size || j >= size do + i <- uint64 (rng.Next(int size)) + j <- uint64 (rng.Next(int size)) + + entries.Add((i, j)) |> ignore + (i * 1UL, j * 1UL, rng.NextDouble() * 100.0)) + |> List.sort + + let entries1 = generateEntries targetNnz + let entries2 = generateEntries targetNnz + + cooMatrix1 <- CoordinateList(size * 1UL, size * 1UL, entries1) + cooMatrix2 <- CoordinateList(size * 1UL, size * 1UL, entries2) + qtMatrix1 <- fromCoordinateList cooMatrix1 + qtMatrix2 <- fromCoordinateList cooMatrix2 + + lookupCoords <- entries1 |> List.map (fun (i, j, _) -> (i, j)) |> Array.ofList + lookupValues <- entries1 |> List.map (fun (_, _, v) -> v) |> Array.ofList + + [] + member this.CooMap() = + resultCoo <- cooMap cooMatrix1 (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.QtMap() = + resultQt <- map qtMatrix1 (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.CooMapi() = + resultCoo <- + cooMapi cooMatrix1 (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.QtMapi() = + resultQt <- mapi qtMatrix1 (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.CooMap2() = + match + cooMap2 cooMatrix1 cooMatrix2 (fun a b -> + match a, b with + | Some x, Some y -> Some(x + y) + | Some x, None -> Some x + | None, Some y -> Some y + | None, None -> None) + with + | Ok r -> resultCoo <- r + | Error _ -> () + + [] + member this.QtMap2() = + match + map2 qtMatrix1 qtMatrix2 (fun a b -> + match a, b with + | Some x, Some y -> Some(x + y) + | Some x, None -> Some x + | None, Some y -> Some y + | None, None -> None) + with + | Ok r -> resultQt <- r + | Error _ -> () + + [] + member this.CooMap2i() = + match + cooMap2i cooMatrix1 cooMatrix2 (fun i j a b -> + match a, b with + | Some x, Some y -> Some(x + y + float (uint64 i)) + | Some x, None -> Some x + | None, Some y -> Some y + | None, None -> None) + with + | Ok r -> resultCoo <- r + | Error _ -> () + + [] + member this.QtMap2i() = + match + map2i qtMatrix1 qtMatrix2 (fun i j a b -> + match a, b with + | Some x, Some y -> Some(x + y + float (uint64 i)) + | Some x, None -> Some x + | None, Some y -> Some y + | None, None -> None) + with + | Ok r -> resultQt <- r + | Error _ -> () + + [] + member this.CooGet() = + let n = min lookupCoords.Length 1000 + let mutable acc = 0.0 + + for k = 0 to n - 1 do + let (i, j) = lookupCoords.[k] + + match cooGet (cooMatrix1, i, j) with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultCooVal <- acc + + [] + member this.QtGet() = + let n = min lookupCoords.Length 1000 + let mutable acc = 0.0 + + for k = 0 to n - 1 do + let (i, j) = lookupCoords.[k] + + match get qtMatrix1 i j with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultQtVal <- acc + + [] + member this.CooSet() = + let n = min lookupCoords.Length 1000 + let mutable m = cooMatrix1 + + for k = 0 to n - 1 do + let (i, j) = lookupCoords.[k] + + match cooUpdate (m, i, j, lookupValues.[k] * 2.0) with + | Ok updated -> m <- updated + | _ -> () + + resultCoo <- m + + [] + member this.QtSet() = + let n = min lookupCoords.Length 1000 + let mutable m = qtMatrix1 + + for k = 0 to n - 1 do + let (i, j) = lookupCoords.[k] + + match set m i j (lookupValues.[k] * 2.0) with + | Ok updated -> m <- updated + | _ -> () + + resultQt <- m + + [] + member this.CooMxm() = + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match mxmcoo op_add op_mult cooMatrix1 cooMatrix1 with + | Ok result -> resultCoo <- result + | Error _ -> failwith "mxmcoo failed" + + [] + member this.QtMxm() = + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match LinearAlgebra.mxm op_add op_mult qtMatrix1 qtMatrix1 with + | Ok result -> resultQt <- result + | Error _ -> failwith "mxm failed" + + +[)>] +type DenseFormatBenchmark() = + + let mutable cooMatrix = Unchecked.defaultof> + let mutable qtMatrix = Unchecked.defaultof> + + let mutable resultCoo = Unchecked.defaultof> + let mutable resultQt = Unchecked.defaultof> + + [] + member val Size = 0 with get, set + + [] + member this.Setup() = + let rng = Random(42) + let size = uint64 this.Size + + let entries = + [ for i in 0UL .. size - 1UL do + for j in 0UL .. size - 1UL do + (i * 1UL, j * 1UL, rng.NextDouble() * 100.0) ] + + cooMatrix <- CoordinateList(size * 1UL, size * 1UL, entries) + qtMatrix <- fromCoordinateList cooMatrix + + [] + member this.DenseCooMap() = + resultCoo <- cooMap cooMatrix (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.DenseQtMap() = + resultQt <- map qtMatrix (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.DenseCooMapi() = + resultCoo <- cooMapi cooMatrix (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.DenseQtMapi() = + resultQt <- mapi qtMatrix (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.DenseCooGet() = + let mutable acc = 0.0 + + for i in 0UL .. uint64 this.Size - 1UL do + for j in 0UL .. uint64 this.Size - 1UL do + match cooGet (cooMatrix, i * 1UL, j * 1UL) with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultCoo <- cooMatrix + + [] + member this.DenseQtGet() = + let mutable acc = 0.0 + + for i in 0UL .. uint64 this.Size - 1UL do + for j in 0UL .. uint64 this.Size - 1UL do + match get qtMatrix (i * 1UL) (j * 1UL) with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultQt <- qtMatrix + + [] + member this.DenseCooSet() = + let mutable m = cooMatrix + let size = uint64 this.Size + + for i in 0UL .. size - 1UL do + for j in 0UL .. size - 1UL do + match cooUpdate (m, i * 1UL, j * 1UL, 42.0) with + | Ok updated -> m <- updated + | _ -> () + + resultCoo <- m + + [] + member this.DenseQtSet() = + let mutable m = qtMatrix + let size = uint64 this.Size + + for i in 0UL .. size - 1UL do + for j in 0UL .. size - 1UL do + match set m (i * 1UL) (j * 1UL) 42.0 with + | Ok updated -> m <- updated + | _ -> () + + resultQt <- m + + [] + member this.DenseCooMxm() = + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match mxmcoo op_add op_mult cooMatrix cooMatrix with + | Ok result -> resultCoo <- result + | Error _ -> failwith "mxmcoo failed" + + [] + member this.DenseQtMxm() = + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match LinearAlgebra.mxm op_add op_mult qtMatrix qtMatrix with + | Ok result -> resultQt <- result + | Error _ -> failwith "mxm failed" From 6aa8c6306fb6d1fc200a0b82f701e0b5fcaf6741 Mon Sep 17 00:00:00 2001 From: Narysev Date: Sun, 27 Sep 2026 02:34:35 +0300 Subject: [PATCH 12/13] Optimize mxmcoo and full-cell traversal; add list benchmarks; rename COO to COOArray - COOArray: walk the sorted array with a cursor in full-cell cooMap/cooMapi paths and buffer results in ResizeArray instead of building a lookup Map; rewrite mergeBinary as a two-pointer merge over sorted arrays - COOArray/COOList: strengthen mxmcoo optimization detection by probing all distinct values rather than only the first entry - COOList: replace Map-based lookup in full-cell cooMap/cooMap2 with a pointer walk over the sorted list - Tests: add FsCheck property tests for mxmcoo against a naive reference and cross-checks between the array and list implementations - Benchmark: add list-backed get/set cases (COOLIST_get/set, resultListVal) to Format, DenseFormat and RealMatrix benchmarks - Rename module COO to COOArray for consistency with COOList: file rename, fsproj entries, open statements, test module, and Fantomas formatting --- QuadTree.Benchmark/FormatBenchmarks.fs | 148 +++++- QuadTree.Benchmark/RealMatrixBenchmark.fs | 65 ++- QuadTree.Tests/PropertyTests.fs | 89 +++- QuadTree.Tests/QuadTree.Tests.fsproj | 2 +- .../{Tests.COO.fs => Tests.COOArray.fs} | 176 ++++++- QuadTree.Tests/Tests.LinearAlgebra.fs | 2 +- QuadTree.Tests/Tests.Matrix.fs | 2 +- QuadTree/COO.fs | 341 ------------ QuadTree/COOArray.fs | 486 ++++++++++++++++++ QuadTree/COOList.fs | 128 +++-- QuadTree/Matrix.fs | 2 +- QuadTree/QuadTree.fsproj | 2 +- 12 files changed, 1033 insertions(+), 410 deletions(-) rename QuadTree.Tests/{Tests.COO.fs => Tests.COOArray.fs} (82%) delete mode 100644 QuadTree/COO.fs create mode 100644 QuadTree/COOArray.fs diff --git a/QuadTree.Benchmark/FormatBenchmarks.fs b/QuadTree.Benchmark/FormatBenchmarks.fs index 2e0a62a..d9e154e 100644 --- a/QuadTree.Benchmark/FormatBenchmarks.fs +++ b/QuadTree.Benchmark/FormatBenchmarks.fs @@ -3,7 +3,7 @@ namespace QuadTree.Benchmarks.Formats open System open BenchmarkDotNet.Attributes open Matrix -open COO +open COOArray [)>] type FormatBenchmark() = @@ -12,14 +12,18 @@ type FormatBenchmark() = let mutable cooMatrix2 = Unchecked.defaultof> let mutable qtMatrix1 = Unchecked.defaultof> let mutable qtMatrix2 = Unchecked.defaultof> + let mutable listMatrix1 = Unchecked.defaultof> + let mutable listMatrix2 = Unchecked.defaultof> let mutable lookupCoords: (uint64 * uint64) array = [||] let mutable lookupValues: double array = [||] let mutable resultCoo = Unchecked.defaultof> let mutable resultQt = Unchecked.defaultof> + let mutable resultList = Unchecked.defaultof> let mutable resultCooVal = 0.0 let mutable resultQtVal = 0.0 + let mutable resultListVal = 0.0 [] member val Size = 0 with get, set @@ -57,6 +61,8 @@ type FormatBenchmark() = cooMatrix2 <- CoordinateList(size * 1UL, size * 1UL, entries2) qtMatrix1 <- fromCoordinateList cooMatrix1 qtMatrix2 <- fromCoordinateList cooMatrix2 + listMatrix1 <- COOList.fromArray cooMatrix1 + listMatrix2 <- COOList.fromArray cooMatrix2 lookupCoords <- entries1 |> List.map (fun (i, j, _) -> (i, j)) |> Array.ofList lookupValues <- entries1 |> List.map (fun (_, _, v) -> v) |> Array.ofList @@ -130,6 +136,88 @@ type FormatBenchmark() = | Ok r -> resultQt <- r | Error _ -> () + [] + member this.CooListMap() = + resultList <- COOList.cooMap listMatrix1 (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.CooListMapi() = + resultList <- + COOList.cooMapi listMatrix1 (fun i j v -> + v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.CooListMap2() = + match + COOList.cooMap2 listMatrix1 listMatrix2 (fun a b -> + match a, b with + | Some x, Some y -> Some(x + y) + | Some x, None -> Some x + | None, Some y -> Some y + | None, None -> None) + with + | Ok r -> resultList <- r + | Error _ -> () + + [] + member this.CooListMap2i() = + match + COOList.cooMap2i listMatrix1 listMatrix2 (fun i j a b -> + match a, b with + | Some x, Some y -> Some(x + y + float (uint64 i)) + | Some x, None -> Some x + | None, Some y -> Some y + | None, None -> None) + with + | Ok r -> resultList <- r + | Error _ -> () + + [] + member this.CooListMxm() = + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match COOList.mxmcoo op_add op_mult listMatrix1 listMatrix1 with + | Ok result -> resultList <- result + | Error _ -> failwith "COOList mxmcoo failed" + + [] + member this.CooListGet() = + let n = min lookupCoords.Length 1000 + let mutable acc = 0.0 + + for k = 0 to n - 1 do + let (i, j) = lookupCoords.[k] + + match COOList.cooGet (listMatrix1, i, j) with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultListVal <- acc + + [] + member this.CooListSet() = + let mutable m = listMatrix1 + let n = min lookupCoords.Length 1000 + + for k = 0 to n - 1 do + let (i, j) = lookupCoords.[k] + + match COOList.cooUpdate (m, i, j, lookupValues.[k] * 2.0) with + | Ok updated -> m <- updated + | _ -> () + + resultList <- m + [] member this.CooGet() = let n = min lookupCoords.Length 1000 @@ -228,9 +316,14 @@ type DenseFormatBenchmark() = let mutable cooMatrix = Unchecked.defaultof> let mutable qtMatrix = Unchecked.defaultof> + let mutable listMatrix = Unchecked.defaultof> let mutable resultCoo = Unchecked.defaultof> let mutable resultQt = Unchecked.defaultof> + let mutable resultList = Unchecked.defaultof> + let mutable resultCooVal = 0.0 + let mutable resultQtVal = 0.0 + let mutable resultListVal = 0.0 [] member val Size = 0 with get, set @@ -247,6 +340,7 @@ type DenseFormatBenchmark() = cooMatrix <- CoordinateList(size * 1UL, size * 1UL, entries) qtMatrix <- fromCoordinateList cooMatrix + listMatrix <- COOList.fromArray cooMatrix [] member this.DenseCooMap() = @@ -264,6 +358,58 @@ type DenseFormatBenchmark() = member this.DenseQtMapi() = resultQt <- mapi qtMatrix (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + [] + member this.DenseCooListMap() = + resultList <- COOList.cooMap listMatrix (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.DenseCooListMapi() = + resultList <- + COOList.cooMapi listMatrix (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.DenseCooListMxm() = + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match COOList.mxmcoo op_add op_mult listMatrix listMatrix with + | Ok result -> resultList <- result + | Error _ -> failwith "COOList mxmcoo failed" + + [] + member this.DenseCooListGet() = + let mutable acc = 0.0 + + for i in 0UL .. uint64 this.Size - 1UL do + for j in 0UL .. uint64 this.Size - 1UL do + match COOList.cooGet (listMatrix, i * 1UL, j * 1UL) with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultListVal <- acc + + [] + member this.DenseCooListSet() = + let mutable m = listMatrix + let size = uint64 this.Size + + for i in 0UL .. size - 1UL do + for j in 0UL .. size - 1UL do + match COOList.cooUpdate (m, i * 1UL, j * 1UL, 42.0) with + | Ok updated -> m <- updated + | _ -> () + + resultList <- m + [] member this.DenseCooGet() = let mutable acc = 0.0 diff --git a/QuadTree.Benchmark/RealMatrixBenchmark.fs b/QuadTree.Benchmark/RealMatrixBenchmark.fs index d8bab67..d09bb38 100644 --- a/QuadTree.Benchmark/RealMatrixBenchmark.fs +++ b/QuadTree.Benchmark/RealMatrixBenchmark.fs @@ -4,7 +4,7 @@ open System open System.IO open BenchmarkDotNet.Attributes open Matrix -open COO +open COOArray [)>] [] @@ -12,11 +12,14 @@ type RealMatrixBenchmark() = let mutable cooMatrix = Unchecked.defaultof> let mutable qtMatrix = Unchecked.defaultof> + let mutable listMatrix = Unchecked.defaultof> let mutable resultCoo = Unchecked.defaultof> let mutable resultQt = Unchecked.defaultof> + let mutable resultList = Unchecked.defaultof> let mutable resultCooVal = 0.0 let mutable resultQtVal = 0.0 + let mutable resultListVal = 0.0 let mutable lookupCoords: (uint64 * uint64) array = [||] let mutable lookupValues: double array = [||] @@ -55,6 +58,7 @@ type RealMatrixBenchmark() = cooMatrix <- coo qtMatrix <- qt + listMatrix <- COOList.fromArray coo let nnz = coo.list.Length let dim = max (uint64 coo.nrows) (uint64 coo.ncols) @@ -98,6 +102,65 @@ type RealMatrixBenchmark() = if not skip then resultQt <- mapi qtMatrix (fun i j v -> v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + [] + member this.CooListMap() = + if not skip then + resultList <- COOList.cooMap listMatrix (fun v -> v |> Option.map (fun x -> x * 2.0)) + + [] + member this.CooListMapi() = + if not skip then + resultList <- + COOList.cooMapi listMatrix (fun i j v -> + v |> Option.map (fun x -> x + float (uint64 i) + float (uint64 j))) + + [] + member this.CooListMxm() = + if not skip && doMxm then + let op_add x y = + match x, y with + | Some a, Some b -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | None, None -> None + + let op_mult x y = + match x, y with + | Some a, Some b -> Some(a * b) + | _ -> None + + match COOList.mxmcoo op_add op_mult listMatrix listMatrix with + | Ok result -> resultList <- result + | Error _ -> failwith "COOList mxmcoo failed" + + [] + member this.CooListGet() = + if not skip then + let mutable acc = 0.0 + + for k = 0 to lookupCoords.Length - 1 do + let (i, j) = lookupCoords.[k] + + match COOList.cooGet (listMatrix, i, j) with + | Ok(Some v) -> acc <- acc + v + | _ -> () + + resultListVal <- acc + + [] + member this.CooListSet() = + if not skip then + let mutable m = listMatrix + + for k = 0 to lookupCoords.Length - 1 do + let (i, j) = lookupCoords.[k] + + match COOList.cooUpdate (m, i, j, lookupValues.[k] * 2.0) with + | Ok updated -> m <- updated + | _ -> () + + resultList <- m + [] member this.CooGet() = if not skip then diff --git a/QuadTree.Tests/PropertyTests.fs b/QuadTree.Tests/PropertyTests.fs index 01b2e94..f353dac 100644 --- a/QuadTree.Tests/PropertyTests.fs +++ b/QuadTree.Tests/PropertyTests.fs @@ -6,7 +6,7 @@ open FsCheck open FsCheck.FSharp open FsCheck.Xunit open Matrix -open COO +open COOArray type Input = { Rows: int @@ -55,7 +55,7 @@ type InputArbs = static member Input() = arbInput [ |])>] -let ``get at every cell agrees between QuadTree and COO`` (inp: Input) = +let ``get at every cell agrees between QuadTree and COOArray`` (inp: Input) = let coo = toCoo inp let qt = fromCoordinateList coo let nrows = int (uint64 coo.nrows) @@ -155,3 +155,88 @@ let ``out-of-bounds access raises ArgumentOutOfRangeException`` (inp: Input) = true cooGetThrows && cooUpdateThrows && matrixGetThrows && matrixSetThrows + +let private cooWithDims (nrows: uint64) (ncols: uint64) (inp: Input) : CoordinateList = + let entries = + inp.Cells + |> List.map (fun (r, c, v) -> (abs r, abs c, v)) + |> List.filter (fun (r, c, _) -> r < int nrows && c < int ncols) + |> List.distinctBy (fun (r, c, _) -> (r, c)) + |> List.map (fun (r, c, v) -> (uint64 r * 1UL, uint64 c * 1UL, v)) + |> List.sortBy (fun (r, c, _) -> (r, c)) + + CoordinateList(nrows * 1UL, ncols * 1UL, entries) + +let private opAdd x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b) + | Some a, None + | None, Some a -> Some a + | _ -> None + +let private opMul x y = + match (x, y) with + | Some(a), Some(b) -> Some(a * b) + | _ -> None + +let private naiveMxm (nrowsA: uint64) (k: uint64) (ncolsB: uint64) (m1: COOEntry list) (m2: COOEntry list) = + let m1Map = m1 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let m2Map = m2 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + + [ for i in 0UL .. nrowsA - 1UL do + for j in 0UL .. ncolsB - 1UL do + let products = + [ for t in 0UL .. k - 1UL do + let a = m1Map |> Map.tryFind (i * 1UL, t * 1UL) + let b = m2Map |> Map.tryFind (t * 1UL, j * 1UL) + yield opMul a b ] + + match products |> List.fold (fun acc p -> opAdd acc p) None with + | Some v -> yield (i * 1UL, j * 1UL, v) + | None -> () ] + |> List.sortBy (fun (i, j, _) -> (i, j)) + +let private arbInputPair: Arbitrary = + let gen = + gen { + let! a = Arb.toGen arbInput + let! b = Arb.toGen arbInput + return (a, b) + } + + Arb.fromGen gen + +type InputPairArbs = + static member InputPair() = arbInputPair + +[ |])>] +let ``mxmcoo agrees with naive multiplication, array matches list, keys are sorted and unique`` + ((a, b): Input * Input) + = + let nrowsA = uint64 (max 1 a.Rows) + let k = uint64 (max 1 a.Cols) + let ncolsB = uint64 (max 1 b.Cols) + let m1 = cooWithDims nrowsA k a + let m2 = cooWithDims k ncolsB b + + let expected = + naiveMxm nrowsA k ncolsB (Array.toList m1.list) (Array.toList m2.list) + + let sortedUnique entries = + entries + |> List.map (fun (i, j, _) -> (i, j)) + |> List.pairwise + |> List.forall (fun ((i1, j1), (i2, j2)) -> i1 < i2 || (i1 = i2 && j1 < j2)) + + match + COOArray.mxmcoo opAdd opMul m1 m2, COOList.mxmcoo opAdd opMul (COOList.fromArray m1) (COOList.fromArray m2) + with + | Ok arr, Ok lst -> + let arrEntries = Array.toList arr.list + + List.indexed expected = List.indexed arrEntries + && List.indexed expected = List.indexed lst.entries + && (arrEntries = lst.entries) + && sortedUnique arrEntries + && sortedUnique lst.entries + | _ -> false diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index 4464305..b6020b8 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -8,7 +8,7 @@ - + diff --git a/QuadTree.Tests/Tests.COO.fs b/QuadTree.Tests/Tests.COOArray.fs similarity index 82% rename from QuadTree.Tests/Tests.COO.fs rename to QuadTree.Tests/Tests.COOArray.fs index 3eb7570..c574e7f 100644 --- a/QuadTree.Tests/Tests.COO.fs +++ b/QuadTree.Tests/Tests.COOArray.fs @@ -1,10 +1,10 @@ -module COO.Tests +module COOArray.Tests open System open Xunit open Matrix -open COO +open COOArray open Common let op_add x y = @@ -19,6 +19,12 @@ let op_mult x y = | Some(a), Some(b) -> Some(a * b) | _ -> None +let private keysAscending (entries: COOEntry<'v> list) = + entries + |> List.map (fun (i, j, _) -> (i, j)) + |> List.pairwise + |> List.forall (fun ((a1, b1), (a2, b2)) -> a1 < a2 || (a1 = a2 && b1 < b2)) + // === cooGet tests === [] @@ -557,7 +563,7 @@ let ``Sparse mxmcoo`` () = CoordinateList(3UL, 3UL, d) - match COO.mxmcoo op_add op_mult m1 m2 with + match COOArray.mxmcoo op_add op_mult m1 m2 with | Ok actual -> Assert.Equal(expected.nrows, actual.nrows) Assert.Equal(expected.ncols, actual.ncols) @@ -590,7 +596,7 @@ let ``Shrinking mxmcoo`` () = CoordinateList(2UL, 2UL, d) - match COO.mxmcoo op_add op_mult m1 m2 with + match COOArray.mxmcoo op_add op_mult m1 m2 with | Ok actual -> Assert.Equal(expected.nrows, actual.nrows) Assert.Equal(expected.ncols, actual.ncols) @@ -624,7 +630,7 @@ let ``mxmcoo with non-absorbing op_mult`` () = CoordinateList(2UL, 1UL, d) - match COO.mxmcoo op_add op_mult m1 m2 with + match COOArray.mxmcoo op_add op_mult m1 m2 with | Ok actual -> Assert.Equal(1UL, actual.nrows) Assert.Equal(1UL, actual.ncols) @@ -632,6 +638,166 @@ let ``mxmcoo with non-absorbing op_mult`` () = Assert.Equal(Some 5, actual.list |> Array.tryHead |> Option.map (fun (_, _, v) -> v)) | Error e -> failwith (e.ToString()) +// === mxmcoo list tests === + +let private listCoo nrows ncols entries = COOList.ListCOO(nrows, ncols, entries) + +[] +let ``Sparse mxmcoo list`` () = + let m1 = + listCoo + 3UL + 3UL + [ (0UL, 0UL, 1) + (1UL, 1UL, 2) + (2UL, 2UL, 3) ] + + let m2 = + listCoo + 3UL + 3UL + [ (0UL, 0UL, 3) + (1UL, 1UL, 2) + (2UL, 2UL, 1) ] + + let expected = + [ (0UL, 0UL, 3) + (1UL, 1UL, 4) + (2UL, 2UL, 3) ] + + match COOList.mxmcoo op_add op_mult m1 m2 with + | Ok actual -> + Assert.True((expected = actual.entries), "Sparse mxmcoo list: entries differ") + Assert.True(keysAscending actual.entries) + | Error e -> failwith (e.ToString()) + +[] +let ``Shrinking mxmcoo list`` () = + let m1 = + listCoo + 2UL + 3UL + [ (0UL, 0UL, 1) + (0UL, 2UL, 2) + (1UL, 1UL, 3) ] + + let m2 = + listCoo + 3UL + 2UL + [ (0UL, 1UL, 4) + (1UL, 0UL, 5) + (2UL, 0UL, 6) ] + + match COOList.mxmcoo op_add op_mult m1 m2 with + | Ok actual -> + Assert.Equal(2UL, actual.nrows) + Assert.Equal(2UL, actual.ncols) + + Assert.True( + [ (0UL, 0UL, 12) + (0UL, 1UL, 4) + (1UL, 0UL, 15) ] = + actual.entries + ) + + Assert.True(keysAscending actual.entries) + | Error e -> failwith (e.ToString()) + +[] +let ``mxmcoo with non-absorbing op_mult list`` () = + let op_add x y = + match (x, y) with + | Some(a), Some(b) -> Some(a + b) + | Some a, _ + | _, Some a -> Some a + | _ -> None + + let op_mult x y = + match (x, y) with + | Some(a), Some(b) -> Some(a * b) + | Some a, _ + | _, Some a -> Some a + | _ -> None + + let m1 = + listCoo 1UL 2UL [ (0UL, 0UL, 1); (0UL, 1UL, 2) ] + + let m2 = listCoo 2UL 1UL [ (0UL, 0UL, 3) ] + + match COOList.mxmcoo op_add op_mult m1 m2 with + | Ok actual -> + Assert.Equal(1UL, actual.nrows) + Assert.Equal(1UL, actual.ncols) + Assert.Equal(1, actual.entries.Length) + Assert.Equal(Some 5, actual.entries |> List.tryHead |> Option.map (fun (_, _, v) -> v)) + Assert.True(keysAscending actual.entries) + | Error e -> failwith (e.ToString()) + +[] +let ``mxmcoo collapses products of one cell (array and list)`` () = + let m1 = + CoordinateList( + 2UL, + 2UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (1UL, 1UL, 3) ] + ) + + let m2 = + CoordinateList(2UL, 2UL, [ (0UL, 0UL, 4); (1UL, 0UL, 5) ]) + + let expected = + [ (0UL, 0UL, 14); (1UL, 0UL, 15) ] + + match + COOArray.mxmcoo op_add op_mult m1 m2, + COOList.mxmcoo op_add op_mult (COOList.fromArray m1) (COOList.fromArray m2) + with + | Ok arr, Ok lst -> + let arrEntries = Array.toList arr.list + Assert.True((expected = arrEntries), "collapses: array result differs") + Assert.True((expected = lst.entries), "collapses: list result differs") + Assert.True(keysAscending arrEntries) + Assert.True(keysAscending lst.entries) + | _ -> failwith "mxmcoo failed" + +[] +let ``mxmcoo result stays sorted when k has multiple hits`` () = + let m1 = + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 1) + (0UL, 1UL, 2) + (0UL, 2UL, 3) + (2UL, 0UL, 7) + (2UL, 2UL, 9) ] + ) + + let m2 = + CoordinateList( + 3UL, + 3UL, + [ (0UL, 0UL, 4) + (0UL, 1UL, 5) + (1UL, 0UL, 6) + (1UL, 2UL, 7) + (2UL, 0UL, 8) ] + ) + + match + COOArray.mxmcoo op_add op_mult m1 m2, + COOList.mxmcoo op_add op_mult (COOList.fromArray m1) (COOList.fromArray m2) + with + | Ok arr, Ok lst -> + let arrEntries = Array.toList arr.list + Assert.True((arrEntries = lst.entries), "array and list results differ") + Assert.True(keysAscending arrEntries) + Assert.True(keysAscending lst.entries) + | _ -> failwith "mxmcoo failed" + // === cooMapValues / cooMapiValues tests === [] diff --git a/QuadTree.Tests/Tests.LinearAlgebra.fs b/QuadTree.Tests/Tests.LinearAlgebra.fs index 23540a8..80da6de 100644 --- a/QuadTree.Tests/Tests.LinearAlgebra.fs +++ b/QuadTree.Tests/Tests.LinearAlgebra.fs @@ -4,7 +4,7 @@ open System open Xunit open Matrix -open COO +open COOArray open Vector open Common diff --git a/QuadTree.Tests/Tests.Matrix.fs b/QuadTree.Tests/Tests.Matrix.fs index 7a353b7..e6222c4 100644 --- a/QuadTree.Tests/Tests.Matrix.fs +++ b/QuadTree.Tests/Tests.Matrix.fs @@ -4,7 +4,7 @@ open System open Xunit open Matrix -open COO +open COOArray open Common let printMatrix (matrix: SparseMatrix<_>) = diff --git a/QuadTree/COO.fs b/QuadTree/COO.fs deleted file mode 100644 index 8cf7484..0000000 --- a/QuadTree/COO.fs +++ /dev/null @@ -1,341 +0,0 @@ -module COO - -open Common -open Matrix - -let private range (count: uint64) = - if count = 0UL then [] else [ 0UL .. count - 1UL ] - -let private compareEntriesByRowCol (e1: COOEntry<'v>) (e2: COOEntry<'v>) = - let (i1, j1, _) = e1 - let (i2, j2, _) = e2 - let c = compare i1 i2 - if c <> 0 then c else compare j1 j2 - -let private entryComparer<'v> = - { new System.Collections.Generic.IComparer> with - member _.Compare(e1, e2) = compareEntriesByRowCol e1 e2 } - -let cooGet - (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64) - : Result, Error> = - if uint64 rowindex >= uint64 coo.nrows then - raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) - elif uint64 colindex >= uint64 coo.ncols then - raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) - else - let idx = - System.Array.BinarySearch(coo.list, (rowindex, colindex, Unchecked.defaultof<'a>), entryComparer<'a>) - - if idx >= 0 then - let (_, _, value) = coo.list.[idx] - Ok(Some value) - else - Ok None - -let cooUpdate - (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64, value: 'a) - : Result, Error> = - if uint64 rowindex >= uint64 coo.nrows then - raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) - elif uint64 colindex >= uint64 coo.ncols then - raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) - else - let idx = - System.Array.BinarySearch(coo.list, (rowindex, colindex, value), entryComparer<'a>) - - if idx >= 0 then - let arr = Array.copy coo.list - arr.[idx] <- (rowindex, colindex, value) - Ok(Matrix.createCOO coo.nrows coo.ncols arr) - else - let insertAt = ~~~idx - let arr = Array.zeroCreate (coo.list.Length + 1) - - Array.blit coo.list 0 arr 0 insertAt - arr.[insertAt] <- (rowindex, colindex, value) - Array.blit coo.list insertAt arr (insertAt + 1) (coo.list.Length - insertAt) - - Ok(Matrix.createCOO coo.nrows coo.ncols arr) - -let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : CoordinateList<'b> = - let entries = Array.toList coo.list - - let result = - match op with - | UnaryOp.ValuesOnly f -> entries |> List.choose (fun (i, j, v) -> f v |> Option.map (fun r -> (i, j, r))) - | UnaryOp.ValuesOnlyIndexed f -> - entries - |> List.choose (fun (i, j, v) -> f i j v |> Option.map (fun r -> (i, j, r))) - | UnaryOp.AllCells f -> - match f None with - | None -> - entries - |> List.choose (fun (i, j, v) -> f (Some v) |> Option.map (fun r -> (i, j, r))) - | Some fnone -> - let lookup = entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - - [ for i in range (uint64 coo.nrows) do - let ri = i * 1UL - - for j in range (uint64 coo.ncols) do - let cj = j * 1UL - - let res = - match Map.tryFind (ri, cj) lookup with - | Some value -> f (Some value) - | None -> Some fnone - - match res with - | Some value -> yield (ri, cj, value) - | None -> () ] - | UnaryOp.AllCellsIndexed f -> - let mutable rest = entries - - [ for i in range (uint64 coo.nrows) do - let ri = i * 1UL - - for j in range (uint64 coo.ncols) do - let cj = j * 1UL - - let value = - match rest with - | (ei, ej, ev) :: tail when ei = ri && ej = cj -> - rest <- tail - Some ev - | _ -> None - - match f ri cj value with - | Some value -> yield (ri, cj, value) - | None -> () ] - - Matrix.createCOO coo.nrows coo.ncols (Array.ofList result) - -let private mergeBinary (l1: COOEntry<'a> list) (l2: COOEntry<'b> list) (op: BinaryOp<'a, 'b, 'c>) : COOEntry<'c> list = - let mutable acc = [] - let mutable rest1 = l1 - let mutable rest2 = l2 - - let emit i j v1 v2 = - match applyBinary op i j v1 v2 with - | Some r -> acc <- (i, j, r) :: acc - | None -> () - - while rest1 <> [] || rest2 <> [] do - match rest1, rest2 with - | [], [] -> () - | (i, j, v1) :: t1, [] -> - emit i j (Some v1) None - rest1 <- t1 - | [], (i, j, v2) :: t2 -> - emit i j None (Some v2) - rest2 <- t2 - | (i1, j1, v1) :: t1, (i2, j2, v2) :: t2 -> - if i1 = i2 && j1 = j2 then - emit i1 j1 (Some v1) (Some v2) - rest1 <- t1 - rest2 <- t2 - elif (i1, j1) < (i2, j2) then - emit i1 j1 (Some v1) None - rest1 <- t1 - else - emit i2 j2 None (Some v2) - rest2 <- t2 - - List.rev acc - -let private cooMap2Inner - (coo1: CoordinateList<'a>) - (coo2: CoordinateList<'b>) - (op: BinaryOp<'a, 'b, 'c>) - : Result, Error> = - if uint64 coo1.nrows <> uint64 coo2.nrows || uint64 coo1.ncols <> uint64 coo2.ncols then - Error Error.InconsistentSizeOfArguments - else - let nrows = coo1.nrows - let ncols = coo1.ncols - let entries1 = Array.toList coo1.list - let entries2 = Array.toList coo2.list - - let result = - match op with - | BinaryOp.AllCells f -> - match f None None with - | None -> mergeBinary entries1 entries2 op - | Some _ -> - let lookup1 = entries1 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - - let lookup2 = entries2 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - - [ for i in range (uint64 nrows) do - let ri = i * 1UL - - for j in range (uint64 ncols) do - let cj = j * 1UL - - match f (Map.tryFind (ri, cj) lookup1) (Map.tryFind (ri, cj) lookup2) with - | Some value -> yield (ri, cj, value) - | None -> () ] - | BinaryOp.AllCellsIndexed f -> - let mutable rest1 = entries1 - let mutable rest2 = entries2 - - [ for i in range (uint64 nrows) do - let ri = i * 1UL - - for j in range (uint64 ncols) do - let cj = j * 1UL - - let v1 = - match rest1 with - | (ei, ej, ev) :: tail when ei = ri && ej = cj -> - rest1 <- tail - Some ev - | _ -> None - - let v2 = - match rest2 with - | (ei, ej, ev) :: tail when ei = ri && ej = cj -> - rest2 <- tail - Some ev - | _ -> None - - match f ri cj v1 v2 with - | Some value -> yield (ri, cj, value) - | None -> () ] - | _ -> mergeBinary entries1 entries2 op - - Matrix.createCOO nrows ncols (Array.ofList result) |> Ok - -let cooMap (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.AllCells f) - -let cooMapValues (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.ValuesOnly f) - -let cooMapi (coo: CoordinateList<'a>) f = - cooMapInner coo (UnaryOp.AllCellsIndexed f) - -let cooMapiValues (coo: CoordinateList<'a>) f = - cooMapInner coo (UnaryOp.ValuesOnlyIndexed f) - -let cooMap2 (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) - -let cooMap2Values (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnly f) - -let cooMap2AllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) - -let cooMap2AtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValue f) - -let cooMap2LeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnly f) - -let cooMap2i (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) - -let cooMap2iValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnlyIndexed f) - -let cooMap2iAllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) - -let cooMap2iAtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValueIndexed f) - -let cooMap2iLeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = - cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnlyIndexed f) - -let mxmcoo - (op_add: 'c option -> 'c option -> 'c option) - (op_mult: 'a option -> 'b option -> 'c option) - (m1: CoordinateList<'a>) - (m2: CoordinateList<'b>) - = - if uint64 m1.ncols <> uint64 m2.nrows then - Error Error.InconsistentSizeOfArguments - else - let entries1 = Array.toList m1.list - let entries2 = Array.toList m2.list - - let firstA = entries1 |> List.tryHead |> Option.map (fun (_, _, v) -> v) - let firstB = entries2 |> List.tryHead |> Option.map (fun (_, _, v) -> v) - - let canOptimize = - let noneNone = op_mult None None = None - - let multSomeNone = - match firstA with - | Some v -> op_mult (Some v) None = None - | None -> noneNone - - let multNoneSome = - match firstB with - | Some v -> op_mult None (Some v) = None - | None -> noneNone - - let addNoneSome = - match firstA with - | Some v -> op_add (Some v) None = Some v - | None -> noneNone - - let addSomeNone = - match firstB with - | Some v -> op_add None (Some v) = Some v - | None -> noneNone - - noneNone && multSomeNone && multNoneSome && addNoneSome && addSomeNone - - if canOptimize then - let m1ByRow = entries1 |> List.groupBy (fun (i, _, _) -> i) |> Map.ofList - let m2ByRow = entries2 |> List.groupBy (fun (k, _, _) -> k) |> Map.ofList - - let result = - [ for KeyValue(i, m1Entries) in m1ByRow do - for (_, k, v1) in m1Entries do - let kAsRow = uint64 k * 1UL - - match m2ByRow |> Map.tryFind kAsRow with - | Some m2Entries -> - for (_, j, v2) in m2Entries do - match op_mult (Some v1) (Some v2) with - | Some product -> yield (i, j, product) - | None -> () - | None -> () ] - - let grouped = - result - |> List.groupBy (fun (i, j, _) -> (i, j)) - |> List.map (fun ((i, j), entries) -> - let sum = entries |> List.map (fun (_, _, v) -> Some v) |> List.reduce op_add - (i, j, sum)) - |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) - |> List.sortBy (fun (i, j, _) -> (i, j)) - - Matrix.createCOO m1.nrows m2.ncols (Array.ofList grouped) |> Ok - else - let m1Map = entries1 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - let m2Map = entries2 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - let kCount = uint64 m1.ncols - - let result = - [ for i in range (uint64 m1.nrows) do - let ri = i * 1UL - - for j in range (uint64 m2.ncols) do - let cj = j * 1UL - - let products = - [ for k in range kCount do - let a = m1Map |> Map.tryFind (ri, k * 1UL) - let b = m2Map |> Map.tryFind (k * 1UL, cj) - yield op_mult a b ] - - let sum = products |> List.fold (fun acc p -> op_add acc p) None - - match sum with - | Some value -> yield (ri, cj, value) - | None -> () ] - - Matrix.createCOO m1.nrows m2.ncols (Array.ofList result) |> Ok diff --git a/QuadTree/COOArray.fs b/QuadTree/COOArray.fs new file mode 100644 index 0000000..2e1a464 --- /dev/null +++ b/QuadTree/COOArray.fs @@ -0,0 +1,486 @@ +module COOArray + +open Common +open Matrix + +let private compareEntriesByRowCol (e1: COOEntry<'v>) (e2: COOEntry<'v>) = + let (i1, j1, _) = e1 + let (i2, j2, _) = e2 + let c = compare i1 i2 + if c <> 0 then c else compare j1 j2 + +let private entryComparer<'v> = + { new System.Collections.Generic.IComparer> with + member _.Compare(e1, e2) = compareEntriesByRowCol e1 e2 } + +let private iterCells + (nrows: uint64) + (ncols: uint64) + (action: uint64 -> uint64 -> unit) + = + let mutable i = 0UL + + while i < uint64 nrows do + let ri = i * 1UL + let mutable j = 0UL + + while j < uint64 ncols do + let cj = j * 1UL + action ri cj + j <- j + 1UL + + i <- i + 1UL + +let cooGet + (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64) + : Result, Error> = + if uint64 rowindex >= uint64 coo.nrows then + raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) + elif uint64 colindex >= uint64 coo.ncols then + raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) + else + let idx = + System.Array.BinarySearch(coo.list, (rowindex, colindex, Unchecked.defaultof<'a>), entryComparer<'a>) + + if idx >= 0 then + let (_, _, value) = coo.list.[idx] + Ok(Some value) + else + Ok None + +let cooUpdate + (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64, value: 'a) + : Result, Error> = + if uint64 rowindex >= uint64 coo.nrows then + raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) + elif uint64 colindex >= uint64 coo.ncols then + raise (System.ArgumentOutOfRangeException("colindex", "Column index is outside the matrix bounds.")) + else + let idx = + System.Array.BinarySearch(coo.list, (rowindex, colindex, value), entryComparer<'a>) + + if idx >= 0 then + let arr = Array.copy coo.list + arr.[idx] <- (rowindex, colindex, value) + Ok(Matrix.createCOO coo.nrows coo.ncols arr) + else + let insertAt = ~~~idx + let arr = Array.zeroCreate (coo.list.Length + 1) + + Array.blit coo.list 0 arr 0 insertAt + arr.[insertAt] <- (rowindex, colindex, value) + Array.blit coo.list insertAt arr (insertAt + 1) (coo.list.Length - insertAt) + + Ok(Matrix.createCOO coo.nrows coo.ncols arr) + +let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : CoordinateList<'b> = + match op with + | UnaryOp.ValuesOnly f -> + let buf = ResizeArray>(coo.list.Length) + + for (i, j, v) in coo.list do + match f v with + | Some r -> buf.Add((i, j, r)) + | None -> () + + Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + | UnaryOp.ValuesOnlyIndexed f -> + let buf = ResizeArray>(coo.list.Length) + + for (i, j, v) in coo.list do + match f i j v with + | Some r -> buf.Add((i, j, r)) + | None -> () + + Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + | UnaryOp.AllCells f -> + match f None with + | None -> + let buf = ResizeArray>(coo.list.Length) + + for (i, j, v) in coo.list do + match f (Some v) with + | Some r -> buf.Add((i, j, r)) + | None -> () + + Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + | Some fnone -> + let buf = ResizeArray>() + let mutable ptr = 0 + + iterCells coo.nrows coo.ncols (fun ri cj -> + let v = + if ptr < coo.list.Length then + let (ei, ej, ev) = coo.list.[ptr] + + if ei = ri && ej = cj then + ptr <- ptr + 1 + Some ev + else + None + else + None + + match v with + | Some value -> f (Some value) + | None -> Some fnone + |> Option.iter (fun value -> buf.Add((ri, cj, value)))) + + Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + | UnaryOp.AllCellsIndexed f -> + let buf = ResizeArray>() + let mutable ptr = 0 + + iterCells coo.nrows coo.ncols (fun ri cj -> + let v = + if ptr < coo.list.Length then + let (ei, ej, ev) = coo.list.[ptr] + + if ei = ri && ej = cj then + ptr <- ptr + 1 + Some ev + else + None + else + None + + f ri cj v |> Option.iter (fun value -> buf.Add((ri, cj, value)))) + + Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + +let private mergeBinary (a1: COOEntry<'a>[]) (a2: COOEntry<'b>[]) (op: BinaryOp<'a, 'b, 'c>) : COOEntry<'c>[] = + let buf = ResizeArray>(a1.Length + a2.Length) + let mutable p1 = 0 + let mutable p2 = 0 + + let emit i j v1 v2 = + match applyBinary op i j v1 v2 with + | Some r -> buf.Add((i, j, r)) + | None -> () + + while p1 < a1.Length || p2 < a2.Length do + if p1 >= a1.Length then + let (i, j, v2) = a2.[p2] + emit i j None (Some v2) + p2 <- p2 + 1 + elif p2 >= a2.Length then + let (i, j, v1) = a1.[p1] + emit i j (Some v1) None + p1 <- p1 + 1 + else + let (i1, j1, v1) = a1.[p1] + let (i2, j2, v2) = a2.[p2] + + if i1 = i2 && j1 = j2 then + emit i1 j1 (Some v1) (Some v2) + p1 <- p1 + 1 + p2 <- p2 + 1 + elif (i1, j1) < (i2, j2) then + emit i1 j1 (Some v1) None + p1 <- p1 + 1 + else + emit i2 j2 None (Some v2) + p2 <- p2 + 1 + + buf.ToArray() + +let private cooMap2Inner + (coo1: CoordinateList<'a>) + (coo2: CoordinateList<'b>) + (op: BinaryOp<'a, 'b, 'c>) + : Result, Error> = + if uint64 coo1.nrows <> uint64 coo2.nrows || uint64 coo1.ncols <> uint64 coo2.ncols then + Error Error.InconsistentSizeOfArguments + else + let nrows = coo1.nrows + let ncols = coo1.ncols + + let result = + match op with + | BinaryOp.AllCells f -> + match f None None with + | None -> mergeBinary coo1.list coo2.list op + | Some _ -> + let buf = ResizeArray>() + let mutable p1 = 0 + let mutable p2 = 0 + + iterCells nrows ncols (fun ri cj -> + let v1 = + if p1 < coo1.list.Length then + let (ei, ej, ev) = coo1.list.[p1] + + if ei = ri && ej = cj then + p1 <- p1 + 1 + Some ev + else + None + else + None + + let v2 = + if p2 < coo2.list.Length then + let (ei, ej, ev) = coo2.list.[p2] + + if ei = ri && ej = cj then + p2 <- p2 + 1 + Some ev + else + None + else + None + + match f v1 v2 with + | Some value -> buf.Add((ri, cj, value)) + | None -> ()) + + buf.ToArray() + | BinaryOp.AllCellsIndexed f -> + let buf = ResizeArray>() + let mutable p1 = 0 + let mutable p2 = 0 + + iterCells nrows ncols (fun ri cj -> + let v1 = + if p1 < coo1.list.Length then + let (ei, ej, ev) = coo1.list.[p1] + + if ei = ri && ej = cj then + p1 <- p1 + 1 + Some ev + else + None + else + None + + let v2 = + if p2 < coo2.list.Length then + let (ei, ej, ev) = coo2.list.[p2] + + if ei = ri && ej = cj then + p2 <- p2 + 1 + Some ev + else + None + else + None + + f ri cj v1 v2 |> Option.iter (fun value -> buf.Add((ri, cj, value)))) + + buf.ToArray() + | _ -> mergeBinary coo1.list coo2.list op + + Matrix.createCOO nrows ncols result |> Ok + +let cooMap (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.AllCells f) + +let cooMapValues (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.ValuesOnly f) + +let cooMapi (coo: CoordinateList<'a>) f = + cooMapInner coo (UnaryOp.AllCellsIndexed f) + +let cooMapiValues (coo: CoordinateList<'a>) f = + cooMapInner coo (UnaryOp.ValuesOnlyIndexed f) + +let cooMap2 (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) + +let cooMap2Values (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnly f) + +let cooMap2AllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) + +let cooMap2AtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValue f) + +let cooMap2LeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnly f) + +let cooMap2i (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) + +let cooMap2iValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnlyIndexed f) + +let cooMap2iAllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) + +let cooMap2iAtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValueIndexed f) + +let cooMap2iLeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = + cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnlyIndexed f) + +let mxmcoo + (op_add: 'c option -> 'c option -> 'c option) + (op_mult: 'a option -> 'b option -> 'c option) + (m1: CoordinateList<'a>) + (m2: CoordinateList<'b>) + = + if uint64 m1.ncols <> uint64 m2.nrows then + Error Error.InconsistentSizeOfArguments + else + let valuesOf (arr: COOEntry<'v>[]) = + arr |> Array.map (fun (_, _, v) -> v) |> Array.distinct + + let canOptimize = + let noneNone = op_mult None None = None + + let multSomeNone = + valuesOf m1.list |> Array.forall (fun v -> op_mult (Some v) None = None) + + let multNoneSome = + valuesOf m2.list |> Array.forall (fun v -> op_mult None (Some v) = None) + + noneNone && multSomeNone && multNoneSome + + let generalResult () = + let m1Map = + let mutable m = Map.empty + + for (i, j, v) in m1.list do + m <- Map.add (i, j) v m + + m + + let m2Map = + let mutable m = Map.empty + + for (i, j, v) in m2.list do + m <- Map.add (i, j) v m + + m + + let kCount = uint64 m1.ncols + let result = ResizeArray>() + + iterCells m1.nrows m2.ncols (fun ri cj -> + let mutable acc = None + let mutable k = 0UL + + while k < kCount do + let key1 = (ri, k * 1UL) + let key2 = (k * 1UL, cj) + acc <- op_add acc (op_mult (Map.tryFind key1 m1Map) (Map.tryFind key2 m2Map)) + k <- k + 1UL + + match acc with + | Some value -> result.Add((ri, cj, value)) + | None -> ()) + + Matrix.createCOO m1.nrows m2.ncols (result.ToArray()) + + if canOptimize then + let rowStarts2 = ResizeArray>() + let rowBegins2 = ResizeArray() + let rowEnds2 = ResizeArray() + let mutable idx = 0 + + while idx < m2.list.Length do + let (r, _, _) = m2.list.[idx] + let beginIdx = idx + let mutable advance = true + + while idx < m2.list.Length && advance do + let (r', _, _) = m2.list.[idx] + + if r' = r then idx <- idx + 1 else advance <- false + + rowStarts2.Add(r) + rowBegins2.Add(beginIdx) + rowEnds2.Add(idx) + + let findRowSegments (k: uint64) = + let mutable lo = 0 + let mutable hi = rowStarts2.Count - 1 + let mutable foundMid = -1 + + while lo <= hi && foundMid < 0 do + let mid = (lo + hi) / 2 + + if rowStarts2.[mid] = k then foundMid <- mid + elif rowStarts2.[mid] < k then lo <- mid + 1 + else hi <- mid - 1 + + if foundMid >= 0 then + Some(rowBegins2.[foundMid], rowEnds2.[foundMid]) + else + None + + let products = ResizeArray>() + let mutable baseIdx = 0 + + while baseIdx < m1.list.Length do + let (row, _, _) = m1.list.[baseIdx] + let mutable nextIdx = baseIdx + 1 + let mutable advance = true + + while nextIdx < m1.list.Length && advance do + let (row', _, _) = m1.list.[nextIdx] + + if row' = row then + nextIdx <- nextIdx + 1 + else + advance <- false + + for e in baseIdx .. nextIdx - 1 do + let (_, k, v1) = m1.list.[e] + let kAsRow = uint64 k * 1UL + + match findRowSegments kAsRow with + | Some(beginIdx, endIdx) -> + for q in beginIdx .. endIdx - 1 do + let (_, j, v2) = m2.list.[q] + + match op_mult (Some v1) (Some v2) with + | Some product -> products.Add((row, j, product)) + | None -> () + | None -> () + + baseIdx <- nextIdx + + let canMerge = + let productValues = + products |> Seq.map (fun (_, _, v) -> v) |> Seq.distinct |> Seq.toArray + + productValues + |> Array.forall (fun v -> op_add (Some v) None = Some v && op_add None (Some v) = Some v) + + if canMerge then + let sortedProducts = + products.ToArray() + |> Array.sortWith (fun (i1, j1, _) (i2, j2, _) -> + let c = compare i1 i2 + + if c <> 0 then c else compare j1 j2) + + let result = ResizeArray>() + let mutable q = 0 + + while q < sortedProducts.Length do + let (i, j, v) = sortedProducts.[q] + let mutable sum = Some v + let mutable qq = q + 1 + let mutable advance = true + + while qq < sortedProducts.Length && advance do + let (i', j', v') = sortedProducts.[qq] + + if i' = i && j' = j then + sum <- op_add sum (Some v') + qq <- qq + 1 + else + advance <- false + + match sum with + | Some value -> result.Add((i, j, value)) + | None -> () + + q <- qq + + Matrix.createCOO m1.nrows m2.ncols (result.ToArray()) |> Ok + else + generalResult () |> Ok + else + generalResult () |> Ok diff --git a/QuadTree/COOList.fs b/QuadTree/COOList.fs index 001c8e0..8aa63dc 100644 --- a/QuadTree/COOList.fs +++ b/QuadTree/COOList.fs @@ -84,7 +84,7 @@ let private cooMapInner (coo: ListCOO<'a>) (op: UnaryOp<'a, 'b>) : ListCOO<'b> = coo.entries |> List.choose (fun (i, j, v) -> f (Some v) |> Option.map (fun r -> (i, j, r))) | Some fnone -> - let lookup = coo.entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let mutable rest = coo.entries [ for i in range (uint64 coo.nrows) do let ri = i * 1UL @@ -92,9 +92,16 @@ let private cooMapInner (coo: ListCOO<'a>) (op: UnaryOp<'a, 'b>) : ListCOO<'b> = for j in range (uint64 coo.ncols) do let cj = j * 1UL + let value = + match rest with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest <- tail + Some ev + | _ -> None + let res = - match Map.tryFind (ri, cj) lookup with - | Some value -> f (Some value) + match value with + | Some v -> f (Some v) | None -> Some fnone match res with @@ -172,9 +179,8 @@ let private cooMap2Inner match f None None with | None -> mergeBinary coo1.entries coo2.entries op | Some _ -> - let lookup1 = coo1.entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList - - let lookup2 = coo2.entries |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList + let mutable rest1 = coo1.entries + let mutable rest2 = coo2.entries [ for i in range (uint64 nrows) do let ri = i * 1UL @@ -182,7 +188,21 @@ let private cooMap2Inner for j in range (uint64 ncols) do let cj = j * 1UL - match f (Map.tryFind (ri, cj) lookup1) (Map.tryFind (ri, cj) lookup2) with + let v1 = + match rest1 with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest1 <- tail + Some ev + | _ -> None + + let v2 = + match rest2 with + | (ei, ej, ev) :: tail when ei = ri && ej = cj -> + rest2 <- tail + Some ev + | _ -> None + + match f v1 v2 with | Some value -> yield (ri, cj, value) | None -> () ] | BinaryOp.AllCellsIndexed f -> @@ -268,62 +288,21 @@ let mxmcoo let entries1 = m1.entries let entries2 = m2.entries - let firstA = entries1 |> List.tryHead |> Option.map (fun (_, _, v) -> v) - let firstB = entries2 |> List.tryHead |> Option.map (fun (_, _, v) -> v) + let valuesOf (entries: (uint64 * uint64 * 'v) list) = + entries |> List.map (fun (_, _, v) -> v) |> List.distinct let canOptimize = let noneNone = op_mult None None = None let multSomeNone = - match firstA with - | Some v -> op_mult (Some v) None = None - | None -> noneNone + valuesOf entries1 |> List.forall (fun v -> op_mult (Some v) None = None) let multNoneSome = - match firstB with - | Some v -> op_mult None (Some v) = None - | None -> noneNone - - let addNoneSome = - match firstA with - | Some v -> op_add (Some v) None = Some v - | None -> noneNone - - let addSomeNone = - match firstB with - | Some v -> op_add None (Some v) = Some v - | None -> noneNone - - noneNone && multSomeNone && multNoneSome && addNoneSome && addSomeNone - - if canOptimize then - let m1ByRow = entries1 |> List.groupBy (fun (i, _, _) -> i) |> Map.ofList - let m2ByRow = entries2 |> List.groupBy (fun (k, _, _) -> k) |> Map.ofList - - let result = - [ for KeyValue(i, m1Entries) in m1ByRow do - for (_, k, v1) in m1Entries do - let kAsRow = uint64 k * 1UL - - match m2ByRow |> Map.tryFind kAsRow with - | Some m2Entries -> - for (_, j, v2) in m2Entries do - match op_mult (Some v1) (Some v2) with - | Some product -> yield (i, j, product) - | None -> () - | None -> () ] + valuesOf entries2 |> List.forall (fun v -> op_mult None (Some v) = None) - let grouped = - result - |> List.groupBy (fun (i, j, _) -> (i, j)) - |> List.map (fun ((i, j), entries) -> - let sum = entries |> List.map (fun (_, _, v) -> Some v) |> List.reduce op_add - (i, j, sum)) - |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) - |> List.sortBy (fun (i, j, _) -> (i, j)) + noneNone && multSomeNone && multNoneSome - ListCOO<'c>(m1.nrows, m2.ncols, grouped) |> Ok - else + let generalResult () = let m1Map = entries1 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList let m2Map = entries2 |> List.map (fun (i, j, v) -> ((i, j), v)) |> Map.ofList let kCount = uint64 m1.ncols @@ -347,4 +326,43 @@ let mxmcoo | Some value -> yield (ri, cj, value) | None -> () ] - ListCOO<'c>(m1.nrows, m2.ncols, result) |> Ok + ListCOO<'c>(m1.nrows, m2.ncols, result) + + if canOptimize then + let m1ByRow = entries1 |> List.groupBy (fun (i, _, _) -> i) |> Map.ofList + let m2ByRow = entries2 |> List.groupBy (fun (k, _, _) -> k) |> Map.ofList + + let result = + [ for KeyValue(i, m1Entries) in m1ByRow do + for (_, k, v1) in m1Entries do + let kAsRow = uint64 k * 1UL + + match m2ByRow |> Map.tryFind kAsRow with + | Some m2Entries -> + for (_, j, v2) in m2Entries do + match op_mult (Some v1) (Some v2) with + | Some product -> yield (i, j, product) + | None -> () + | None -> () ] + + let canMerge = + let productValues = result |> List.map (fun (_, _, v) -> v) |> List.distinct + + productValues + |> List.forall (fun v -> op_add (Some v) None = Some v && op_add None (Some v) = Some v) + + if canMerge then + let grouped = + result + |> List.groupBy (fun (i, j, _) -> (i, j)) + |> List.map (fun ((i, j), entries) -> + let sum = entries |> List.map (fun (_, _, v) -> Some v) |> List.reduce op_add + (i, j, sum)) + |> List.choose (fun (i, j, v) -> v |> Option.map (fun v -> (i, j, v))) + |> List.sortBy (fun (i, j, _) -> (i, j)) + + ListCOO<'c>(m1.nrows, m2.ncols, grouped) |> Ok + else + generalResult () |> Ok + else + generalResult () |> Ok diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index 01b5c3d..4325ab5 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -95,7 +95,7 @@ type CoordinateList<'value> = list = sorted } // Fast factory: does NOT re-sort, expects an already sorted array. - // Used by COO operations whose results are built in (row, col) order and + // Used by COOArray operations whose results are built in (row, col) order and // by cooUpdate, which maintains the sorted invariant itself. static member Create (nrows: uint64, ncols: uint64, entries: COOEntry<'value>[]) diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 8648347..719ad7f 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -9,7 +9,7 @@ - + From 328bc71563e172053603fa9d9fd78d726291ad4f Mon Sep 17 00:00:00 2001 From: Narysev Date: Sun, 27 Sep 2026 03:15:27 +0300 Subject: [PATCH 13/13] Revert CoordinateList to list storage; split array storage into ArrayCOO type --- QuadTree.Tests/PropertyTests.fs | 37 +++--- QuadTree.Tests/Tests.COOArray.fs | 196 +++++++++++++------------------ QuadTree/COOArray.fs | 68 ++++++----- QuadTree/COOList.fs | 6 +- QuadTree/Matrix.fs | 33 +++--- 5 files changed, 157 insertions(+), 183 deletions(-) diff --git a/QuadTree.Tests/PropertyTests.fs b/QuadTree.Tests/PropertyTests.fs index f353dac..27deff0 100644 --- a/QuadTree.Tests/PropertyTests.fs +++ b/QuadTree.Tests/PropertyTests.fs @@ -57,6 +57,7 @@ type InputArbs = [ |])>] let ``get at every cell agrees between QuadTree and COOArray`` (inp: Input) = let coo = toCoo inp + let cooA = ArrayCOO(coo.nrows, coo.ncols, coo.list) let qt = fromCoordinateList coo let nrows = int (uint64 coo.nrows) let ncols = int (uint64 coo.ncols) @@ -66,38 +67,41 @@ let ``get at every cell agrees between QuadTree and COOArray`` (inp: Input) = let ri = uint64 r * 1UL let ci = uint64 c * 1UL - Matrix.get qt ri ci = cooGet (coo, ri, ci)) + Matrix.get qt ri ci = cooGet (cooA, ri, ci)) [ |])>] let ``toCoordinateList (fromCoordinateList coo) preserves every value`` (inp: Input) = let coo = toCoo inp let back = toCoordinateList (fromCoordinateList coo) + let backA = ArrayCOO(back.nrows, back.ncols, back.list) back.nrows = coo.nrows && back.ncols = coo.ncols - && Array.length back.list = Array.length coo.list - && coo.list |> Array.forall (fun (r, c, v) -> cooGet (back, r, c) = Ok(Some v)) + && List.length back.list = List.length coo.list + && coo.list |> List.forall (fun (r, c, v) -> cooGet (backA, r, c) = Ok(Some v)) [ |])>] let ``cooUpdate writes a value and adjusts the length`` (inp: Input) = let coo = toCoo inp + let cooA = ArrayCOO(coo.nrows, coo.ncols, coo.list) let nrows = int (uint64 coo.nrows) let ncols = int (uint64 coo.ncols) let r = abs inp.Rows % nrows let c = abs inp.Cols % ncols let ri = uint64 r * 1UL let ci = uint64 c * 1UL - let wasPresent = coo.list |> Array.exists (fun (i, j, _) -> i = ri && j = ci) + let wasPresent = cooA.list |> Array.exists (fun (i, j, _) -> i = ri && j = ci) - match cooUpdate (coo, ri, ci, 777) with + match cooUpdate (cooA, ri, ci, 777) with | Ok updated -> cooGet (updated, ri, ci) = Ok(Some 777) - && Array.length updated.list = Array.length coo.list + (if wasPresent then 0 else 1) + && Array.length updated.list = Array.length cooA.list + (if wasPresent then 0 else 1) | Error _ -> false [ |])>] let ``set and cooUpdate agree on the written cell`` (inp: Input) = let coo = toCoo inp + let cooA = ArrayCOO(coo.nrows, coo.ncols, coo.list) let qt = fromCoordinateList coo let nrows = int (uint64 coo.nrows) let ncols = int (uint64 coo.ncols) @@ -106,36 +110,38 @@ let ``set and cooUpdate agree on the written cell`` (inp: Input) = let ri = uint64 r * 1UL let ci = uint64 c * 1UL - match cooUpdate (coo, ri, ci, 42), Matrix.set qt ri ci 42 with + match cooUpdate (cooA, ri, ci, 42), Matrix.set qt ri ci 42 with | Ok updatedCoo, Ok updatedQt -> cooGet (updatedCoo, ri, ci) = Matrix.get updatedQt ri ci | _ -> false [ |])>] let ``cooMapValues maps every stored value once`` (inp: Input) = let coo = toCoo inp - let mapped = cooMapValues coo (fun v -> Some(v + 1)) + let cooA = ArrayCOO(coo.nrows, coo.ncols, coo.list) + let mapped = cooMapValues cooA (fun v -> Some(v + 1)) - Array.length mapped.list = Array.length coo.list - && coo.list + Array.length mapped.list = Array.length cooA.list + && cooA.list |> Array.forall (fun (r, c, v) -> cooGet (mapped, r, c) = Ok(Some(v + 1))) [ |])>] let ``out-of-bounds access raises ArgumentOutOfRangeException`` (inp: Input) = let coo = toCoo inp + let cooA = ArrayCOO(coo.nrows, coo.ncols, coo.list) let qt = fromCoordinateList coo let nrows = uint64 coo.nrows * 1UL let ncols = uint64 coo.ncols * 1UL let cooGetThrows = try - cooGet (coo, nrows, 0UL) |> ignore + cooGet (cooA, nrows, 0UL) |> ignore false with :? ArgumentOutOfRangeException -> true let cooUpdateThrows = try - cooUpdate (coo, nrows, 0UL, 1) |> ignore + cooUpdate (cooA, nrows, 0UL, 1) |> ignore false with :? ArgumentOutOfRangeException -> true @@ -218,9 +224,10 @@ let ``mxmcoo agrees with naive multiplication, array matches list, keys are sort let ncolsB = uint64 (max 1 b.Cols) let m1 = cooWithDims nrowsA k a let m2 = cooWithDims k ncolsB b + let m1A = ArrayCOO(m1.nrows, m1.ncols, m1.list) + let m2A = ArrayCOO(m2.nrows, m2.ncols, m2.list) - let expected = - naiveMxm nrowsA k ncolsB (Array.toList m1.list) (Array.toList m2.list) + let expected = naiveMxm nrowsA k ncolsB m1.list m2.list let sortedUnique entries = entries @@ -229,7 +236,7 @@ let ``mxmcoo agrees with naive multiplication, array matches list, keys are sort |> List.forall (fun ((i1, j1), (i2, j2)) -> i1 < i2 || (i1 = i2 && j1 < j2)) match - COOArray.mxmcoo opAdd opMul m1 m2, COOList.mxmcoo opAdd opMul (COOList.fromArray m1) (COOList.fromArray m2) + COOArray.mxmcoo opAdd opMul m1A m2A, COOList.mxmcoo opAdd opMul (COOList.fromArray m1A) (COOList.fromArray m2A) with | Ok arr, Ok lst -> let arrEntries = Array.toList arr.list diff --git a/QuadTree.Tests/Tests.COOArray.fs b/QuadTree.Tests/Tests.COOArray.fs index c574e7f..1ca2457 100644 --- a/QuadTree.Tests/Tests.COOArray.fs +++ b/QuadTree.Tests/Tests.COOArray.fs @@ -30,7 +30,7 @@ let private keysAscending (entries: COOEntry<'v> list) = [] let ``cooGet existing value`` () = let coo = - CoordinateList( + ArrayCOO( 4UL, 4UL, [ (0UL, 0UL, 1) @@ -45,7 +45,7 @@ let ``cooGet existing value`` () = [] let ``cooGet missing value`` () = let coo = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) let actual = cooGet (coo, 2UL, 2UL) @@ -53,8 +53,7 @@ let ``cooGet missing value`` () = [] let ``cooGet out of bounds`` () = - let coo = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) + let coo = ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1) ]) Assert.Throws(fun () -> cooGet (coo, 5UL, 5UL) |> ignore) @@ -63,14 +62,10 @@ let ``cooGet out of bounds`` () = [] let ``cooUpdate replaces existing`` () = let coo = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) let expected = - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 99); (1UL, 1UL, 2) ] - ) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 99); (1UL, 1UL, 2) ]) let actual = cooUpdate (coo, 0UL, 0UL, 99) @@ -79,10 +74,10 @@ let ``cooUpdate replaces existing`` () = [] let ``cooUpdate inserts new in middle`` () = let coo = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (2UL, 2UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (2UL, 2UL, 2) ]) let expected = - CoordinateList( + ArrayCOO( 4UL, 4UL, [ (0UL, 0UL, 1) @@ -96,15 +91,10 @@ let ``cooUpdate inserts new in middle`` () = [] let ``cooUpdate inserts at end`` () = - let coo = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) + let coo = ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1) ]) let expected = - CoordinateList( - 4UL, - 4UL, - [ (0UL, 0UL, 1); (3UL, 3UL, 20) ] - ) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (3UL, 3UL, 20) ]) let actual = cooUpdate (coo, 3UL, 3UL, 20) @@ -112,8 +102,7 @@ let ``cooUpdate inserts at end`` () = [] let ``cooUpdate out of bounds`` () = - let coo = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1) ]) + let coo = ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1) ]) Assert.Throws(fun () -> cooUpdate (coo, 5UL, 5UL, 99) |> ignore) @@ -132,12 +121,12 @@ let ``cooMap doubles values`` () = (1UL, 1UL, 4) ] |> List.sort - let coo = CoordinateList(nrows, ncols, data) + let coo = ArrayCOO(nrows, ncols, data) let f v = v |> Option.map (fun v -> v * 2) let expected = - CoordinateList( + ArrayCOO( nrows, ncols, [ (0UL, 0UL, 2) @@ -161,7 +150,7 @@ let ``cooMap filters None results`` () = (1UL, 0UL, 3) (1UL, 1UL, 4) ] - let coo = CoordinateList(nrows, ncols, data) + let coo = ArrayCOO(nrows, ncols, data) let f v = v @@ -171,7 +160,7 @@ let ``cooMap filters None results`` () = | _ -> Some(v * 10)) let expected = - CoordinateList( + ArrayCOO( nrows, ncols, [ (0UL, 1UL, 20) @@ -190,7 +179,7 @@ let ``cooMap fills missing cells (general form)`` () = let data = [ (0UL, 0UL, 1); (2UL, 2UL, 5) ] - let coo = CoordinateList(nrows, ncols, data) + let coo = ArrayCOO(nrows, ncols, data) let f v = Some(defaultArg v 0) @@ -207,10 +196,10 @@ let ``cooMap fills missing cells (general form)`` () = [] let ``cooMap zero-size matrix`` () = - let coo = CoordinateList(0UL, 0UL, []) + let coo = ArrayCOO(0UL, 0UL, []) let f v = v |> Option.map (fun v -> v * 2) let actual = cooMap coo f - let expected = CoordinateList(0UL, 0UL, []) + let expected = ArrayCOO(0UL, 0UL, []) Assert.Equal(expected, actual) // === cooMap2 tests === @@ -240,7 +229,7 @@ let ``cooMap2 addition`` () = | _ -> None let expected = - CoordinateList( + ArrayCOO( nrows, ncols, [ (0UL, 3UL, 10) @@ -250,8 +239,8 @@ let ``cooMap2 addition`` () = |> List.sort ) - let c1 = CoordinateList(nrows, ncols, d1) - let c2 = CoordinateList(nrows, ncols, d2) + let c1 = ArrayCOO(nrows, ncols, d1) + let c2 = ArrayCOO(nrows, ncols, d2) let actual = cooMap2 c1 c2 f @@ -274,7 +263,7 @@ let ``cooMap2 with mismatched positions`` () = | _ -> None let expected = - CoordinateList( + ArrayCOO( nrows, ncols, [ (0UL, 0UL, 101) @@ -283,8 +272,8 @@ let ``cooMap2 with mismatched positions`` () = (3UL, 3UL, 230) ] ) - let c1 = CoordinateList(nrows, ncols, d1) - let c2 = CoordinateList(nrows, ncols, d2) + let c1 = ArrayCOO(nrows, ncols, d1) + let c2 = ArrayCOO(nrows, ncols, d2) let actual = cooMap2 c1 c2 f @@ -307,7 +296,7 @@ let ``cooMap2 dense filters None from existing entries`` () = | None, None -> Some 0 let expected = - CoordinateList( + ArrayCOO( nrows, ncols, [ (0UL, 1UL, 0) @@ -327,8 +316,8 @@ let ``cooMap2 dense filters None from existing entries`` () = (3UL, 3UL, 0) ] ) - let c1 = CoordinateList(nrows, ncols, d1) - let c2 = CoordinateList(nrows, ncols, d2) + let c1 = ArrayCOO(nrows, ncols, d1) + let c2 = ArrayCOO(nrows, ncols, d2) let actual = cooMap2 c1 c2 f @@ -347,13 +336,13 @@ let ``cooMapi position-dependent values`` () = (2UL, 3UL, 3) ] |> List.sort - let coo = CoordinateList(nrows, ncols, data) + let coo = ArrayCOO(nrows, ncols, data) let f i j v = v |> Option.map (fun v -> v + (int (uint64 i))) let expected = - CoordinateList( + ArrayCOO( nrows, ncols, [ (0UL, 0UL, 1) @@ -375,13 +364,13 @@ let ``cooMapi filters None results`` () = (0UL, 1UL, 5) (1UL, 0UL, 3) ] - let coo = CoordinateList(nrows, ncols, data) + let coo = ArrayCOO(nrows, ncols, data) let f _i _j v = v |> Option.bind (fun v -> if v > 2 then Some(v * 10) else None) let expected = - CoordinateList(nrows, ncols, [ (0UL, 1UL, 50); (1UL, 0UL, 30) ]) + ArrayCOO(nrows, ncols, [ (0UL, 1UL, 50); (1UL, 0UL, 30) ]) let actual = cooMapi coo f @@ -389,10 +378,10 @@ let ``cooMapi filters None results`` () = [] let ``cooMapi empty input`` () = - let coo = CoordinateList(4UL, 4UL, []) + let coo = ArrayCOO(4UL, 4UL, []) let f _i _j v = v |> Option.map (fun v -> v * 2) let actual = cooMapi coo f - let expected = CoordinateList(4UL, 4UL, []) + let expected = ArrayCOO(4UL, 4UL, []) Assert.Equal(expected, actual) [] @@ -401,7 +390,7 @@ let ``cooMapi fills missing cells (general form)`` () = let ncols = 3UL let data = [ (0UL, 0UL, 1); (2UL, 2UL, 5) ] - let coo = CoordinateList(nrows, ncols, data) + let coo = ArrayCOO(nrows, ncols, data) let f _i _j v = Some(defaultArg v 0) @@ -422,7 +411,7 @@ let ``cooMapi position-dependent fill of missing cells`` () = let ncols = 2UL let data = [ (0UL, 0UL, 7) ] - let coo = CoordinateList(nrows, ncols, data) + let coo = ArrayCOO(nrows, ncols, data) let f i j v = match v with @@ -441,10 +430,10 @@ let ``cooMapi position-dependent fill of missing cells`` () = [] let ``cooMapi zero-size matrix`` () = - let coo = CoordinateList(0UL, 0UL, []) + let coo = ArrayCOO(0UL, 0UL, []) let f _i _j v = v |> Option.map (fun v -> v * 2) let actual = cooMapi coo f - let expected = CoordinateList(0UL, 0UL, []) + let expected = ArrayCOO(0UL, 0UL, []) Assert.Equal(expected, actual) // === cooMap2i tests === @@ -465,10 +454,10 @@ let ``cooMap2i position-dependent addition`` () = | _ -> None let expected = - CoordinateList(nrows, ncols, [ (0UL, 0UL, 11); (2UL, 2UL, 35) ]) + ArrayCOO(nrows, ncols, [ (0UL, 0UL, 11); (2UL, 2UL, 35) ]) - let c1 = CoordinateList(nrows, ncols, d1) - let c2 = CoordinateList(nrows, ncols, d2) + let c1 = ArrayCOO(nrows, ncols, d1) + let c2 = ArrayCOO(nrows, ncols, d2) let actual = cooMap2i c1 c2 f Assert.Equal(Ok expected, actual) @@ -489,7 +478,7 @@ let ``cooMap2i mismatched positions with index`` () = | _ -> None let expected = - CoordinateList( + ArrayCOO( nrows, ncols, [ (0UL, 0UL, 1) @@ -498,8 +487,8 @@ let ``cooMap2i mismatched positions with index`` () = (3UL, 3UL, 33) ] ) - let c1 = CoordinateList(nrows, ncols, d1) - let c2 = CoordinateList(nrows, ncols, d2) + let c1 = ArrayCOO(nrows, ncols, d1) + let c2 = ArrayCOO(nrows, ncols, d2) let actual = cooMap2i c1 c2 f Assert.Equal(Ok expected, actual) @@ -518,21 +507,21 @@ let ``cooMap2i filters None results`` () = | Some a, Some b -> Some(a + b) | _ -> None - let expected = CoordinateList(nrows, ncols, [ (0UL, 0UL, 3) ]) + let expected = ArrayCOO(nrows, ncols, [ (0UL, 0UL, 3) ]) - let c1 = CoordinateList(nrows, ncols, d1) - let c2 = CoordinateList(nrows, ncols, d2) + let c1 = ArrayCOO(nrows, ncols, d1) + let c2 = ArrayCOO(nrows, ncols, d2) let actual = cooMap2i c1 c2 f Assert.Equal(Ok expected, actual) [] let ``cooMap2i empty inputs`` () = - let c1 = CoordinateList(4UL, 4UL, []) - let c2 = CoordinateList(4UL, 4UL, []) + let c1 = ArrayCOO(4UL, 4UL, []) + let c2 = ArrayCOO(4UL, 4UL, []) let f _i _j x y = None let actual = cooMap2i c1 c2 f - let expected = CoordinateList(4UL, 4UL, []) + let expected = ArrayCOO(4UL, 4UL, []) Assert.Equal(Ok expected, actual) // === mxmcoo tests === @@ -545,7 +534,7 @@ let ``Sparse mxmcoo`` () = 1UL, 1UL, 2 2UL, 2UL, 3 ] - CoordinateList(3UL, 3UL, d) + ArrayCOO(3UL, 3UL, d) let m2 = let d = @@ -553,7 +542,7 @@ let ``Sparse mxmcoo`` () = 1UL, 1UL, 2 2UL, 2UL, 1 ] - CoordinateList(3UL, 3UL, d) + ArrayCOO(3UL, 3UL, d) let expected = let d = @@ -561,7 +550,7 @@ let ``Sparse mxmcoo`` () = 1UL, 1UL, 4 2UL, 2UL, 3 ] - CoordinateList(3UL, 3UL, d) + ArrayCOO(3UL, 3UL, d) match COOArray.mxmcoo op_add op_mult m1 m2 with | Ok actual -> @@ -578,7 +567,7 @@ let ``Shrinking mxmcoo`` () = 0UL, 2UL, 2 1UL, 1UL, 3 ] - CoordinateList(2UL, 3UL, d) + ArrayCOO(2UL, 3UL, d) let m2 = let d = @@ -586,7 +575,7 @@ let ``Shrinking mxmcoo`` () = 1UL, 0UL, 5 2UL, 0UL, 6 ] - CoordinateList(3UL, 2UL, d) + ArrayCOO(3UL, 2UL, d) let expected = let d = @@ -594,7 +583,7 @@ let ``Shrinking mxmcoo`` () = 0UL, 1UL, 4 1UL, 0UL, 15 ] - CoordinateList(2UL, 2UL, d) + ArrayCOO(2UL, 2UL, d) match COOArray.mxmcoo op_add op_mult m1 m2 with | Ok actual -> @@ -623,12 +612,12 @@ let ``mxmcoo with non-absorbing op_mult`` () = let m1 = let d = [ 0UL, 0UL, 1; 0UL, 1UL, 2 ] - CoordinateList(1UL, 2UL, d) + ArrayCOO(1UL, 2UL, d) let m2 = let d = [ 0UL, 0UL, 3 ] - CoordinateList(2UL, 1UL, d) + ArrayCOO(2UL, 1UL, d) match COOArray.mxmcoo op_add op_mult m1 m2 with | Ok actual -> @@ -737,7 +726,7 @@ let ``mxmcoo with non-absorbing op_mult list`` () = [] let ``mxmcoo collapses products of one cell (array and list)`` () = let m1 = - CoordinateList( + ArrayCOO( 2UL, 2UL, [ (0UL, 0UL, 1) @@ -746,7 +735,7 @@ let ``mxmcoo collapses products of one cell (array and list)`` () = ) let m2 = - CoordinateList(2UL, 2UL, [ (0UL, 0UL, 4); (1UL, 0UL, 5) ]) + ArrayCOO(2UL, 2UL, [ (0UL, 0UL, 4); (1UL, 0UL, 5) ]) let expected = [ (0UL, 0UL, 14); (1UL, 0UL, 15) ] @@ -766,7 +755,7 @@ let ``mxmcoo collapses products of one cell (array and list)`` () = [] let ``mxmcoo result stays sorted when k has multiple hits`` () = let m1 = - CoordinateList( + ArrayCOO( 3UL, 3UL, [ (0UL, 0UL, 1) @@ -777,7 +766,7 @@ let ``mxmcoo result stays sorted when k has multiple hits`` () = ) let m2 = - CoordinateList( + ArrayCOO( 3UL, 3UL, [ (0UL, 0UL, 4) @@ -803,7 +792,7 @@ let ``mxmcoo result stays sorted when k has multiple hits`` () = [] let ``cooMapValues applies only to stored values`` () = let coo = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) let actual = cooMapValues coo (fun v -> Some(v * 10)) @@ -816,8 +805,7 @@ let ``cooMapValues applies only to stored values`` () = [] let ``cooMapiValues applies indexed only to stored values`` () = - let coo = - CoordinateList(4UL, 4UL, [ (1UL, 2UL, 5) ]) + let coo = ArrayCOO(4UL, 4UL, [ (1UL, 2UL, 5) ]) let actual = cooMapiValues coo (fun i j v -> Some(v + int (uint64 i) + int (uint64 j))) @@ -834,10 +822,9 @@ let ``cooMapiValues applies indexed only to stored values`` () = [] let ``cooMap2Values applies only where both present`` () = let c1 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) - let c2 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + let c2 = ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 10) ]) match cooMap2Values c1 c2 (fun a b -> Some(a + b)) with | Ok actual -> @@ -852,10 +839,9 @@ let ``cooMap2Values applies only where both present`` () = [] let ``cooMap2AllCells equals cooMap2`` () = let c1 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) - let c2 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + let c2 = ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 10) ]) let f a b = match a, b with @@ -867,14 +853,10 @@ let ``cooMap2AllCells equals cooMap2`` () = [] let ``cooMap2AtLeastOne distinguishes both left right`` () = let c1 = - CoordinateList(3UL, 3UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(3UL, 3UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) let c2 = - CoordinateList( - 3UL, - 3UL, - [ (0UL, 0UL, 10); (2UL, 2UL, 30) ] - ) + ArrayCOO(3UL, 3UL, [ (0UL, 0UL, 10); (2UL, 2UL, 30) ]) let f = function @@ -905,10 +887,9 @@ let ``cooMap2AtLeastOne distinguishes both left right`` () = [] let ``cooMap2LeftValues applies where left present`` () = let c1 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) - let c2 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + let c2 = ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 10) ]) match cooMap2LeftValues c1 c2 (fun a b -> Some(a + (defaultArg b 0))) with | Ok actual -> @@ -927,8 +908,8 @@ let ``cooMap2LeftValues applies where left present`` () = [] let ``cooMap2 sizes mismatch`` () = - let c1 = CoordinateList(4UL, 4UL, []) - let c2 = CoordinateList(2UL, 2UL, []) + let c1 = ArrayCOO(4UL, 4UL, []) + let c2 = ArrayCOO(2UL, 2UL, []) let f a b = None Assert.Equal(Error Error.InconsistentSizeOfArguments, cooMap2 c1 c2 f) @@ -937,15 +918,10 @@ let ``cooMap2 sizes mismatch`` () = [] let ``cooMap2iValues applies indexed where both present`` () = - let c1 = - CoordinateList(4UL, 4UL, [ (1UL, 1UL, 2) ]) + let c1 = ArrayCOO(4UL, 4UL, [ (1UL, 1UL, 2) ]) let c2 = - CoordinateList( - 4UL, - 4UL, - [ (1UL, 1UL, 10); (2UL, 2UL, 20) ] - ) + ArrayCOO(4UL, 4UL, [ (1UL, 1UL, 10); (2UL, 2UL, 20) ]) let f i j a b = Some(a + b + int (uint64 i) + int (uint64 j)) @@ -963,10 +939,9 @@ let ``cooMap2iValues applies indexed where both present`` () = [] let ``cooMap2iAllCells equals cooMap2i`` () = let c1 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) + ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 1); (1UL, 1UL, 2) ]) - let c2 = - CoordinateList(4UL, 4UL, [ (0UL, 0UL, 10) ]) + let c2 = ArrayCOO(4UL, 4UL, [ (0UL, 0UL, 10) ]) let f i j a b = match a, b with @@ -977,15 +952,10 @@ let ``cooMap2iAllCells equals cooMap2i`` () = [] let ``cooMap2iAtLeastOne passes indices and side`` () = - let c1 = - CoordinateList(2UL, 2UL, [ (0UL, 0UL, 1) ]) + let c1 = ArrayCOO(2UL, 2UL, [ (0UL, 0UL, 1) ]) let c2 = - CoordinateList( - 2UL, - 2UL, - [ (0UL, 0UL, 10); (1UL, 1UL, 20) ] - ) + ArrayCOO(2UL, 2UL, [ (0UL, 0UL, 10); (1UL, 1UL, 20) ]) let f i j = function @@ -1010,11 +980,9 @@ let ``cooMap2iAtLeastOne passes indices and side`` () = [] let ``cooMap2iLeftValues applies indexed where left present`` () = - let c1 = - CoordinateList(2UL, 2UL, [ (1UL, 1UL, 2) ]) + let c1 = ArrayCOO(2UL, 2UL, [ (1UL, 1UL, 2) ]) - let c2 = - CoordinateList(2UL, 2UL, [ (1UL, 1UL, 10) ]) + let c2 = ArrayCOO(2UL, 2UL, [ (1UL, 1UL, 10) ]) let f i j a b = Some(a + (defaultArg b 0) + int (uint64 i) * 10 + int (uint64 j)) @@ -1031,8 +999,8 @@ let ``cooMap2iLeftValues applies indexed where left present`` () = [] let ``cooMap2i sizes mismatch`` () = - let c1 = CoordinateList(4UL, 4UL, []) - let c2 = CoordinateList(2UL, 2UL, []) + let c1 = ArrayCOO(4UL, 4UL, []) + let c2 = ArrayCOO(2UL, 2UL, []) let f _i _j a b = None Assert.Equal(Error Error.InconsistentSizeOfArguments, cooMap2i c1 c2 f) diff --git a/QuadTree/COOArray.fs b/QuadTree/COOArray.fs index 2e1a464..d5f1782 100644 --- a/QuadTree/COOArray.fs +++ b/QuadTree/COOArray.fs @@ -31,9 +31,7 @@ let private iterCells i <- i + 1UL -let cooGet - (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64) - : Result, Error> = +let cooGet (coo: ArrayCOO<'a>, rowindex: uint64, colindex: uint64) : Result, Error> = if uint64 rowindex >= uint64 coo.nrows then raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) elif uint64 colindex >= uint64 coo.ncols then @@ -49,8 +47,8 @@ let cooGet Ok None let cooUpdate - (coo: CoordinateList<'a>, rowindex: uint64, colindex: uint64, value: 'a) - : Result, Error> = + (coo: ArrayCOO<'a>, rowindex: uint64, colindex: uint64, value: 'a) + : Result, Error> = if uint64 rowindex >= uint64 coo.nrows then raise (System.ArgumentOutOfRangeException("rowindex", "Row index is outside the matrix bounds.")) elif uint64 colindex >= uint64 coo.ncols then @@ -62,7 +60,7 @@ let cooUpdate if idx >= 0 then let arr = Array.copy coo.list arr.[idx] <- (rowindex, colindex, value) - Ok(Matrix.createCOO coo.nrows coo.ncols arr) + Ok(ArrayCOO.Create(coo.nrows, coo.ncols, arr)) else let insertAt = ~~~idx let arr = Array.zeroCreate (coo.list.Length + 1) @@ -71,9 +69,9 @@ let cooUpdate arr.[insertAt] <- (rowindex, colindex, value) Array.blit coo.list insertAt arr (insertAt + 1) (coo.list.Length - insertAt) - Ok(Matrix.createCOO coo.nrows coo.ncols arr) + Ok(ArrayCOO.Create(coo.nrows, coo.ncols, arr)) -let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : CoordinateList<'b> = +let private cooMapInner (coo: ArrayCOO<'a>) (op: UnaryOp<'a, 'b>) : ArrayCOO<'b> = match op with | UnaryOp.ValuesOnly f -> let buf = ResizeArray>(coo.list.Length) @@ -83,7 +81,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi | Some r -> buf.Add((i, j, r)) | None -> () - Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + ArrayCOO.Create(coo.nrows, coo.ncols, buf.ToArray()) | UnaryOp.ValuesOnlyIndexed f -> let buf = ResizeArray>(coo.list.Length) @@ -92,7 +90,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi | Some r -> buf.Add((i, j, r)) | None -> () - Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + ArrayCOO.Create(coo.nrows, coo.ncols, buf.ToArray()) | UnaryOp.AllCells f -> match f None with | None -> @@ -103,7 +101,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi | Some r -> buf.Add((i, j, r)) | None -> () - Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + ArrayCOO.Create(coo.nrows, coo.ncols, buf.ToArray()) | Some fnone -> let buf = ResizeArray>() let mutable ptr = 0 @@ -126,7 +124,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi | None -> Some fnone |> Option.iter (fun value -> buf.Add((ri, cj, value)))) - Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + ArrayCOO.Create(coo.nrows, coo.ncols, buf.ToArray()) | UnaryOp.AllCellsIndexed f -> let buf = ResizeArray>() let mutable ptr = 0 @@ -146,7 +144,7 @@ let private cooMapInner (coo: CoordinateList<'a>) (op: UnaryOp<'a, 'b>) : Coordi f ri cj v |> Option.iter (fun value -> buf.Add((ri, cj, value)))) - Matrix.createCOO coo.nrows coo.ncols (buf.ToArray()) + ArrayCOO.Create(coo.nrows, coo.ncols, buf.ToArray()) let private mergeBinary (a1: COOEntry<'a>[]) (a2: COOEntry<'b>[]) (op: BinaryOp<'a, 'b, 'c>) : COOEntry<'c>[] = let buf = ResizeArray>(a1.Length + a2.Length) @@ -185,10 +183,10 @@ let private mergeBinary (a1: COOEntry<'a>[]) (a2: COOEntry<'b>[]) (op: BinaryOp< buf.ToArray() let private cooMap2Inner - (coo1: CoordinateList<'a>) - (coo2: CoordinateList<'b>) + (coo1: ArrayCOO<'a>) + (coo2: ArrayCOO<'b>) (op: BinaryOp<'a, 'b, 'c>) - : Result, Error> = + : Result, Error> = if uint64 coo1.nrows <> uint64 coo2.nrows || uint64 coo1.ncols <> uint64 coo2.ncols then Error Error.InconsistentSizeOfArguments else @@ -270,53 +268,53 @@ let private cooMap2Inner buf.ToArray() | _ -> mergeBinary coo1.list coo2.list op - Matrix.createCOO nrows ncols result |> Ok + ArrayCOO.Create(nrows, ncols, result) |> Ok -let cooMap (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.AllCells f) +let cooMap (coo: ArrayCOO<'a>) f = cooMapInner coo (UnaryOp.AllCells f) -let cooMapValues (coo: CoordinateList<'a>) f = cooMapInner coo (UnaryOp.ValuesOnly f) +let cooMapValues (coo: ArrayCOO<'a>) f = cooMapInner coo (UnaryOp.ValuesOnly f) -let cooMapi (coo: CoordinateList<'a>) f = +let cooMapi (coo: ArrayCOO<'a>) f = cooMapInner coo (UnaryOp.AllCellsIndexed f) -let cooMapiValues (coo: CoordinateList<'a>) f = +let cooMapiValues (coo: ArrayCOO<'a>) f = cooMapInner coo (UnaryOp.ValuesOnlyIndexed f) -let cooMap2 (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2 (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) -let cooMap2Values (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2Values (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnly f) -let cooMap2AllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2AllCells (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.AllCells f) -let cooMap2AtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2AtLeastOne (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValue f) -let cooMap2LeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2LeftValues (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnly f) -let cooMap2i (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2i (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) -let cooMap2iValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2iValues (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.ValuesOnlyIndexed f) -let cooMap2iAllCells (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2iAllCells (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.AllCellsIndexed f) -let cooMap2iAtLeastOne (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2iAtLeastOne (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.AtLeastOneValueIndexed f) -let cooMap2iLeftValues (coo1: CoordinateList<'a>) (coo2: CoordinateList<'b>) f = +let cooMap2iLeftValues (coo1: ArrayCOO<'a>) (coo2: ArrayCOO<'b>) f = cooMap2Inner coo1 coo2 (BinaryOp.LeftValuesOnlyIndexed f) let mxmcoo (op_add: 'c option -> 'c option -> 'c option) (op_mult: 'a option -> 'b option -> 'c option) - (m1: CoordinateList<'a>) - (m2: CoordinateList<'b>) + (m1: ArrayCOO<'a>) + (m2: ArrayCOO<'b>) = if uint64 m1.ncols <> uint64 m2.nrows then Error Error.InconsistentSizeOfArguments @@ -369,7 +367,7 @@ let mxmcoo | Some value -> result.Add((ri, cj, value)) | None -> ()) - Matrix.createCOO m1.nrows m2.ncols (result.ToArray()) + ArrayCOO.Create(m1.nrows, m2.ncols, result.ToArray()) if canOptimize then let rowStarts2 = ResizeArray>() @@ -479,7 +477,7 @@ let mxmcoo q <- qq - Matrix.createCOO m1.nrows m2.ncols (result.ToArray()) |> Ok + ArrayCOO.Create(m1.nrows, m2.ncols, result.ToArray()) |> Ok else generalResult () |> Ok else diff --git a/QuadTree/COOList.fs b/QuadTree/COOList.fs index 8aa63dc..934c94b 100644 --- a/QuadTree/COOList.fs +++ b/QuadTree/COOList.fs @@ -17,11 +17,11 @@ type ListCOO<'value> = ncols = _ncols entries = _entries } -let fromArray (coo: CoordinateList<'a>) : ListCOO<'a> = +let fromArray (coo: ArrayCOO<'a>) : ListCOO<'a> = ListCOO<'a>(coo.nrows, coo.ncols, Array.toList coo.list) -let toArray (coo: ListCOO<'a>) : CoordinateList<'a> = - Matrix.createCOO coo.nrows coo.ncols (Array.ofList coo.entries) +let toArray (coo: ListCOO<'a>) : ArrayCOO<'a> = + ArrayCOO.Create(coo.nrows, coo.ncols, Array.ofList coo.entries) let cooGet (coo: ListCOO<'a>, rowindex: uint64, colindex: uint64) : Result, Error> = if uint64 rowindex >= uint64 coo.nrows then diff --git a/QuadTree/Matrix.fs b/QuadTree/Matrix.fs index 4325ab5..408b886 100644 --- a/QuadTree/Matrix.fs +++ b/QuadTree/Matrix.fs @@ -64,6 +64,17 @@ type COOEntry<'value> = uint64 * uint64 * 'value [] type CoordinateList<'value> = + val nrows: uint64 + val ncols: uint64 + val list: COOEntry<'value> list + + new(_nrows, _ncols, _list) = + { nrows = _nrows + ncols = _ncols + list = _list } + +[] +type ArrayCOO<'value> = val nrows: uint64 val ncols: uint64 val list: COOEntry<'value>[] @@ -97,20 +108,11 @@ type CoordinateList<'value> = // Fast factory: does NOT re-sort, expects an already sorted array. // Used by COOArray operations whose results are built in (row, col) order and // by cooUpdate, which maintains the sorted invariant itself. - static member Create - (nrows: uint64, ncols: uint64, entries: COOEntry<'value>[]) - : CoordinateList<'value> = - CoordinateList<'value>(nrows, ncols, entries, true) - -let internal createCOO - (nrows: uint64) - (ncols: uint64) - (entries: COOEntry<'value>[]) - : CoordinateList<'value> = - CoordinateList<'value>.Create(nrows, ncols, entries) + static member Create(nrows: uint64, ncols: uint64, entries: COOEntry<'value>[]) : ArrayCOO<'value> = + ArrayCOO<'value>(nrows, ncols, entries, true) let fromCoordinateList (coo: CoordinateList<'a>) = - let nvals = (uint64 <| Array.length coo.list) * 1UL + let nvals = (uint64 <| List.length coo.list) * 1UL let nrows = coo.nrows let ncols = coo.ncols @@ -143,8 +145,7 @@ let fromCoordinateList (coo: CoordinateList<'a>) = (traverse swCoo swp halfSize) (traverse seCoo sep halfSize) - let tree = - traverse (Array.toList coo.list) (0UL, 0UL) storageSize + let tree = traverse coo.list (0UL, 0UL) storageSize SparseMatrix(nrows, ncols, nvals, Storage(storageSize * 1UL, tree)) @@ -171,10 +172,10 @@ let toCoordinateList (matrix: SparseMatrix<'a>) = let coo = traverse matrix.storage.data (0UL, 0UL) (uint64 matrix.storage.size) - CoordinateList(nrows, ncols, Array.ofList coo) + CoordinateList(nrows, ncols, coo) let empty nrows ncols = - fromCoordinateList (CoordinateList(nrows, ncols, Array.empty)) + fromCoordinateList (CoordinateList(nrows, ncols, [])) let get (matrix: SparseMatrix<'a>) (row: uint64) (col: uint64) : Result, Error> = if uint64 row >= uint64 matrix.nrows then