From ae9028e10145f83dd1d74ebe9a46d055a3f2d973 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Fri, 1 May 2026 14:58:44 +0300 Subject: [PATCH 01/10] feat: add AVLSet implementation, unit tests and benchmarks --- QuadTree.Benchmark/AVLSet.fs | 132 ++++++ QuadTree.Benchmark/Main.fs | 3 +- QuadTree.Benchmark/QuadTree.Benchmark.fsproj | 3 +- QuadTree.Tests/QuadTree.Tests.fsproj | 4 +- QuadTree.Tests/Tests.AVLSet.fs | 416 +++++++++++++++++++ QuadTree/AVLSet.fs | 370 +++++++++++++++++ QuadTree/QuadTree.fsproj | 1 + 7 files changed, 926 insertions(+), 3 deletions(-) create mode 100644 QuadTree.Benchmark/AVLSet.fs create mode 100644 QuadTree.Tests/Tests.AVLSet.fs create mode 100644 QuadTree/AVLSet.fs diff --git a/QuadTree.Benchmark/AVLSet.fs b/QuadTree.Benchmark/AVLSet.fs new file mode 100644 index 0000000..8493f29 --- /dev/null +++ b/QuadTree.Benchmark/AVLSet.fs @@ -0,0 +1,132 @@ +namespace QuadTree.Benchmarks.AVLSet + +open System.Threading.Tasks +open BenchmarkDotNet.Diagnosers +open BenchmarkDotNet.Attributes +open BenchmarkDotNet.Configs +open QuadTree.AVLSet + +[] +[] +[] +[] +[] +[] +type Benchmark() = + let rnd = System.Random(1234561) + + [] + [] + val mutable public A: int + + [] + [] + val mutable public B: int + + [] + [] + val mutable public DataTypeA: string + + [] + [] + val mutable public Threads: int + + [] + val mutable public rndInt: int + + [] + val mutable public setA: AVLTree + + [] + val mutable public setB: AVLTree + + [] + member self.Setup() = + self.rndInt <- rnd.Next(self.A + 1, self.A + 1000) + + let dataA = + match self.DataTypeA with + | "Random" -> Array.init self.A (fun _ -> rnd.Next()) + | _ -> [| 1 .. self.A |] + + let dataB = Array.init self.B (fun _ -> rnd.Next()) + + self.setA <- dataA |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty + self.setB <- dataB |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty + + [] + [] + member self.``Adding one element``() = AVLSet.add self.rndInt self.setA + + [] + [] + member self.``Deleting one element``() = AVLSet.delete self.rndInt self.setA + + [] + [] + member self.``Sequential union``() = AVLSet.union self.setA self.setB + + [] + [] + member self.``Union via tree traversal``() = + AVLSet.unionTraversal self.setA self.setB + + [] + [] + member self.``Parallel union with threads``() = + let opts = ParallelOptions() + opts.MaxDegreeOfParallelism <- self.Threads + + AVLSet.parallelUnion opts self.setA self.setB + + [] + [] + member self.``Sequential intersection``() = AVLSet.intersection self.setA self.setB + + [] + [] + member self.``Intersection via tree traversal``() = + AVLSet.intersectionTraversal self.setA self.setB + + [] + [] + member self.``Parallel intersection with threads``() = + let opts = ParallelOptions() + opts.MaxDegreeOfParallelism <- self.Threads + + AVLSet.parallelIntersection opts self.setA self.setB + + [] + [] + member self.``Sequential difference``() = AVLSet.difference self.setA self.setB + + [] + [] + member self.``Difference via tree traversal``() = + AVLSet.differenceTraversal self.setA self.setB + + [] + [] + member self.``Parallel difference with threads``() = + let opts = ParallelOptions() + opts.MaxDegreeOfParallelism <- self.Threads + + AVLSet.parallelDifference opts self.setA self.setB + + [] + [] + member self.``Sequential symmetrical difference``() = + AVLSet.symmDifference self.setA self.setB + + [] + [] + member self.``Symmetrical difference via tree traversal``() = + AVLSet.symmDifferenceTraversal self.setA self.setB + + [] + [] + member self.``Parallel symmetrical difference with threads``() = + let opts = ParallelOptions() + opts.MaxDegreeOfParallelism <- self.Threads + + AVLSet.parallelSymmDifference opts self.setA self.setB diff --git a/QuadTree.Benchmark/Main.fs b/QuadTree.Benchmark/Main.fs index 61394af..9ea4962 100644 --- a/QuadTree.Benchmark/Main.fs +++ b/QuadTree.Benchmark/Main.fs @@ -6,7 +6,8 @@ let main argv = BenchmarkSwitcher [| 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 4edb362..f3f169f 100644 --- a/QuadTree.Benchmark/QuadTree.Benchmark.fsproj +++ b/QuadTree.Benchmark/QuadTree.Benchmark.fsproj @@ -7,6 +7,7 @@ + @@ -22,4 +23,4 @@ - \ No newline at end of file + diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index 4de3d64..019802e 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -6,6 +6,7 @@ + @@ -18,6 +19,7 @@ + @@ -27,4 +29,4 @@ - \ No newline at end of file + diff --git a/QuadTree.Tests/Tests.AVLSet.fs b/QuadTree.Tests/Tests.AVLSet.fs new file mode 100644 index 0000000..c4b2d17 --- /dev/null +++ b/QuadTree.Tests/Tests.AVLSet.fs @@ -0,0 +1,416 @@ +namespace QuadTree.Tests.AVLSet + +open System.Threading.Tasks +open Xunit +open FsUnit.Xunit +open QuadTree.AVLSet + +module SetTests = + let rec isSetValid n mn mx = + match n with + | Empty -> true + | Node(h, v, ln, rn) -> + let isInBounds = + mn |> Option.forall (fun mn -> v > mn) && mx |> Option.forall (fun mx -> v < mx) + + let lnHeight = Node.height ln + let rnHeight = Node.height rn + + isInBounds + && h = (max lnHeight rnHeight + 1) + && abs (lnHeight - rnHeight) <= 1 + && isSetValid ln mn (Some v) + && isSetValid rn (Some v) mx + + let rec advancedContains (condition: 'A -> bool -> bool) setOfValues targetSet = + match setOfValues with + | Empty -> true + | Node(_, v, ln, rn) -> + let lesser, greater, wasFound = Tree.split v targetSet + + condition v wasFound + && advancedContains condition ln lesser + && advancedContains condition rn greater + + [] + let ``Empty tree insertion`` () = + let resultSet = Empty |> AVLSet.add 15 + + let correctSet = Node(0, 15, Empty, Empty) + + resultSet |> should equal correctSet + + [] + let ``Duplicate element insertion`` () = + let resultSet = Node(0, 15, Empty, Empty) |> AVLSet.add 15 + + let correctSet = Node(0, 15, Empty, Empty) + + resultSet |> should equal correctSet + + [] + let ``Insertion without rotation`` () = + let resultSet = Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.add 20 + + let correctSet = Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) + + resultSet |> should equal correctSet + + [] + let ``Insertion with height update`` () = + let resultSet = + Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Empty), Node(0, 20, Empty, Empty)) + |> AVLSet.add 13 + + let correctSet = + Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Node(0, 13, Empty, Empty)), Node(0, 20, Empty, Empty)) + + resultSet |> should equal correctSet + + [] + let ``Left-Left rotation (RR case)`` () = + let resultSet = Node(1, 15, Empty, Node(0, 20, Empty, Empty)) |> AVLSet.add 25 + + let correctSet = Node(1, 20, Node(0, 15, Empty, Empty), Node(0, 25, Empty, Empty)) + + resultSet |> should equal correctSet + + [] + let ``Right-Left rotation (RL case)`` () = + let resultSet = + Node(2, 15, Node(0, 10, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) + |> AVLSet.add 27 + + let correctSet = + Node( + 2, + 20, + Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 16, Empty, Empty)), + Node(1, 24, Empty, Node(0, 27, Empty, Empty)) + ) + + resultSet |> should equal correctSet + + [] + let ``Left-Right rotation (LR case)`` () = + let resultSet = + Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.add 14 + + let correctSet = + Node( + 2, + 12, + Node(1, 10, Node(0, 6, Empty, Empty), Empty), + Node(1, 15, Node(0, 14, Empty, Empty), Node(0, 20, Empty, Empty)) + ) + + resultSet |> should equal correctSet + + [] + let ``Single-node deletion`` () = + let resultSet = Node(0, 15, Empty, Empty) |> AVLSet.delete 15 + + let correctSet: AVLTree = Empty + + resultSet |> should equal correctSet + + [] + let ``Non-existent element deletion`` () = + let resultSet = Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.delete 20 + + let correctSet = Node(1, 15, Node(0, 10, Empty, Empty), Empty) + + resultSet |> should equal correctSet + + [] + let ``Leaf node deletion`` () = + let resultSet = + Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 10 + + let correctSet = Node(1, 15, Empty, Node(0, 20, Empty, Empty)) + + resultSet |> should equal correctSet + + [] + let ``Deletion with single rotation`` () = + let resultSet = + Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 20 + + let correctSet = + Node(2, 10, Node(0, 6, Empty, Empty), Node(1, 15, Node(0, 12, Empty, Empty), Empty)) + + resultSet |> should equal correctSet + + [] + let ``Node deletion with one child`` () = + let resultSet = + Node( + 2, + 15, + Node(1, 10, Empty, Node(0, 12, Empty, Empty)), + Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) + ) + |> AVLSet.delete 10 + + let correctSet = + Node(2, 15, Node(0, 12, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) + + resultSet |> should equal correctSet + + [] + let ``Root deletion with successor replacement`` () = + let resultSet = + Node( + 2, + 15, + Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), + Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) + ) + |> AVLSet.delete 15 + + let correctSet = + Node( + 2, + 16, + Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), + Node(1, 20, Empty, Node(0, 24, Empty, Empty)) + ) + + resultSet |> should equal correctSet + + [] + let ``Deletion with cascading rebalance`` () = + let resultSet = + Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 15 + + let correctSet = + Node(2, 10, Node(0, 6, Empty, Empty), Node(1, 20, Node(0, 12, Empty, Empty), Empty)) + + resultSet |> should equal correctSet + + [] + let ``Complex multi-level deletion`` () = + let resultSet = + Node( + 3, + 15, + Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), + Node( + 2, + 25, + Node(0, 20, Empty, Empty), + Node(1, 30, Node(0, 27, Empty, Empty), Node(0, 33, Empty, Empty)) + ) + ) + |> AVLSet.delete 15 + + let correctSet = + Node( + 3, + 20, + Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), + Node(2, 30, Node(1, 25, Empty, Node(0, 27, Empty, Empty)), Node(0, 33, Empty, Empty)) + ) + + resultSet |> should equal correctSet + + [] + let ``Search for missing element`` () = + let set = + Node( + 3, + 15, + Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), + Node( + 2, + 25, + Node(0, 20, Empty, Empty), + Node(1, 30, Node(0, 27, Empty, Empty), Node(0, 33, Empty, Empty)) + ) + ) + + AVLSet.contains 100 set |> should be False + + [] + let ``Search for negative value`` () = + let set = + Node( + 3, + 15, + Node(2, 5, Node(1, 0, Node(0, -3, Empty, Empty), Node(0, 2, Empty, Empty)), Node(0, 10, Empty, Empty)), + Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) + ) + + AVLSet.contains -3 set |> should be True + + [] + let ``Tree structure cloning`` () = + let set = + Node( + 3, + 15, + Node(2, 5, Node(1, 0, Node(0, -3, Empty, Empty), Node(0, 2, Empty, Empty)), Node(0, 10, Empty, Empty)), + Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) + ) + + AVLSet.copy set |> should equal set + + let rnd = System.Random(123561) + + let dataA = Array.init 10000 (fun _ -> rnd.Next()) + let dataB = Array.init 2000 (fun _ -> rnd.Next()) + + let setA = dataA |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty + let setB = dataB |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty + + [] + let ``100k operations stress test`` () = + let data = Array.init 100000 (fun _ -> rnd.Next()) + + let set = data |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty + + isSetValid set None None |> should be True + + [] + let ``Standard set union`` () = + let unionSet = AVLSet.union setA setB + + isSetValid unionSet None None |> should be True + + (advancedContains (fun v x -> x) setA unionSet + && advancedContains (fun v x -> x) setB unionSet) + |> should be True + + AVLSet.union setB setA |> should equal unionSet + + [] + let ``Standard set intersection`` () = + let intersectionSet = AVLSet.intersection setA setB + + isSetValid intersectionSet None None |> should be True + + advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet + |> should be True + + AVLSet.intersection setB setA |> should equal intersectionSet + + [] + let ``Standard set difference`` () = + let differenceSet = AVLSet.difference setA setB + + isSetValid differenceSet None None |> should be True + + advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA differenceSet + |> should be True + + [] + let ``Standard symmetric difference`` () = + let symmDiffSet = AVLSet.symmDifference setA setB + + isSetValid symmDiffSet None None |> should be True + + (advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA symmDiffSet + && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) + |> should be True + + AVLSet.symmDifference setB setA |> should equal symmDiffSet + + [] + let ``Union via tree traversal`` () = + let unionSet = AVLSet.unionTraversal setA setB + + isSetValid unionSet None None |> should be True + + (advancedContains (fun v x -> x) setA unionSet + && advancedContains (fun v x -> x) setB unionSet) + |> should be True + + AVLSet.unionTraversal setB setA |> should equal unionSet + + [] + let ``Intersection via tree traversal`` () = + let intersectionSet = AVLSet.intersectionTraversal setA setB + + isSetValid intersectionSet None None |> should be True + + advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet + |> should be True + + AVLSet.intersectionTraversal setB setA |> should equal intersectionSet + + [] + let ``Difference via tree traversal`` () = + let differenceSet = AVLSet.differenceTraversal setA setB + + isSetValid differenceSet None None |> should be True + + advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA differenceSet + |> should be True + + [] + let ``Symmetric difference via tree traversal`` () = + let symmDiffSet = AVLSet.symmDifferenceTraversal setA setB + + isSetValid symmDiffSet None None |> should be True + + (advancedContains (fun v x -> if AVLSet.contains v setB then not x else x = true) setA symmDiffSet + && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) + |> should be True + + AVLSet.symmDifferenceTraversal setB setA |> should equal symmDiffSet + + [] + let ``Parallel set union with threads`` () = + let opts = ParallelOptions() + + let unionSet = AVLSet.parallelUnion opts setA setB + + isSetValid unionSet None None |> should be True + + (advancedContains (fun v x -> x) setA unionSet + && advancedContains (fun v x -> x) setB unionSet) + |> should be True + + AVLSet.parallelUnion opts setB setA |> should equal unionSet + + [] + let ``Parallel set intersection with threads`` () = + let opts = ParallelOptions() + + let intersectionSet = AVLSet.parallelIntersection opts setA setB + + isSetValid intersectionSet None None |> should be True + + advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet + |> should be True + + AVLSet.parallelIntersection opts setB setA |> should equal intersectionSet + + [] + let ``Parallel set difference with threads`` () = + let opts = ParallelOptions() + + let differenceSet = AVLSet.parallelDifference opts setA setB + + isSetValid differenceSet None None |> should be True + + advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA differenceSet + |> should be True + + [] + let ``Parallel set symmetrical difference with threads`` () = + let opts = ParallelOptions() + + let symmDiffSet = AVLSet.parallelSymmDifference opts setA setB + + isSetValid symmDiffSet None None |> should be True + + (advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA symmDiffSet + && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) + |> should be True + + AVLSet.parallelSymmDifference opts setB setA |> should equal symmDiffSet diff --git a/QuadTree/AVLSet.fs b/QuadTree/AVLSet.fs new file mode 100644 index 0000000..59ca72e --- /dev/null +++ b/QuadTree/AVLSet.fs @@ -0,0 +1,370 @@ +namespace QuadTree.AVLSet + +open System.Threading.Tasks + +type AVLTree<'Value> = + | Empty + | Node of int * 'Value * AVLTree<'Value> * AVLTree<'Value> + +module Node = + let height n = + match n with + | Empty -> -1 + | Node(h, _, _, _) -> h + + let value n = + match n with + | Empty -> failwith "Empty node has no value" + | Node(_, v, _, _) -> v + + let leftChild n = + match n with + | Empty -> failwith "Empty node has no left child" + | Node(_, _, ln, _) -> ln + + let rightChild n = + match n with + | Empty -> failwith "Empty node has no right child" + | Node(_, _, _, rn) -> rn + + let maxMinNodesByHeights n1 n2 = + if height n1 >= height n2 then n1, n2 else n2, n1 + +module Tree = + let LLrotate n = + let ln = Node.leftChild n + let lln = Node.leftChild ln + let rln = Node.rightChild ln + let rn = Node.rightChild n + let rlnNew = Node(max (Node.height rln) (Node.height rn) + 1, Node.value n, rln, rn) + Node(max (Node.height lln) (Node.height rlnNew) + 1, Node.value ln, lln, rlnNew) + + let RRrotate n = + let ln = Node.leftChild n + let rn = Node.rightChild n + let rrn = Node.rightChild rn + let lrn = Node.leftChild rn + let lrnNew = Node(max (Node.height ln) (Node.height lrn) + 1, Node.value n, ln, lrn) + Node(max (Node.height lrnNew) (Node.height rrn) + 1, Node.value rn, lrnNew, rrn) + + let LRrotate n = + let lnNew = RRrotate(Node.leftChild n) + let rn = Node.rightChild n + LLrotate(Node(max (Node.height lnNew) (Node.height rn) + 1, Node.value n, lnNew, rn)) + + let RLrotate n = + let rnNew = LLrotate(Node.rightChild n) + let ln = Node.leftChild n + RRrotate(Node(max (Node.height ln) (Node.height rnNew) + 1, Node.value n, ln, rnNew)) + + let balance ln rn v = + let lnHeight = Node.height ln + let rnHeight = Node.height rn + + match lnHeight - rnHeight with + | 2 -> + let llnHeight = Node.height (Node.leftChild ln) + let rlnHeight = Node.height (Node.rightChild ln) + + if llnHeight >= rlnHeight then + LLrotate(Node(0, v, ln, rn)) + else + LRrotate(Node(0, v, ln, rn)) + | -2 -> + let lrnHeight = Node.height (Node.leftChild rn) + let rrnHeight = Node.height (Node.rightChild rn) + + if lrnHeight <= rrnHeight then + RRrotate(Node(0, v, ln, rn)) + else + RLrotate(Node(0, v, ln, rn)) + | _ -> Node(max lnHeight rnHeight + 1, v, ln, rn) + + let rec minNode n = + match n with + | Empty -> failwith "minNode: cannot find minimum of an empty node" + | Node(_, v, Empty, rn) -> v, rn + | Node(_, v, ln, rn) -> + let value, lnNew = minNode ln + value, balance lnNew rn v + + let rec insert value n = + match n with + | Empty -> Node(0, value, Empty, Empty) + | Node(h, v, ln, rn) -> + match value with + | value when value = v -> n + | value when value < v -> + let lnNew = insert value ln + balance lnNew rn v + | _ -> + let rnNew = insert value rn + balance ln rnNew v + + let rec remove value n = + match n with + | Empty -> Empty + | Node(h, v, ln, rn) -> + match value with + | value when value = v -> + match ln, rn with + | Empty, _ -> rn + | _, Empty -> ln + | _, _ -> + let newValue, rnNew = minNode rn + balance ln rnNew newValue + | value when value < v -> + let lnNew = remove value ln + balance lnNew rn v + | _ -> + let rnNew = remove value rn + balance ln rnNew v + + [] + let rec contains value n = + match n with + | Empty -> false + | Node(h, v, ln, rn) -> + match value with + | value when value = v -> true + | value when value < v -> contains value ln + | _ -> contains value rn + + let rec traverse (func: 'A -> AVLTree<'B> -> AVLTree<'B>) nArg n = + match n with + | Empty -> nArg + | Node(_, v, ln, rn) -> + let newNArg = traverse func nArg ln + let newNArg2 = func v newNArg + traverse func newNArg2 rn + + let rec copy n = + match n with + | Empty -> Empty + | Node(h, v, ln, rn) -> Node(h, v, copy ln, copy rn) + + let rec join left key right = + let leftHeight = Node.height left + let rightHeight = Node.height right + + match leftHeight - rightHeight with + | diff when abs diff <= 1 -> Node(max leftHeight rightHeight + 1, key, left, right) + | diff when diff >= 2 -> + match left with + | Empty -> failwith "Unreacheable message 1" + | Node(h, v, ln, rn) -> + let rnNew = join rn key right + balance ln rnNew v + | _ -> + match right with + | Empty -> failwith "Unreacheable message 2" + | Node(h, v, ln, rn) -> + let lnNew = join left key ln + balance lnNew rn v + + let merge left right = + match left, right with + | Empty, _ -> right + | _, Empty -> left + | _, _ -> + let key, newRight = minNode right + join left key newRight + + let rec split key n = + match n with + | Empty -> Empty, Empty, false + | Node(_, v, ln, rn) -> + match key with + | key when key = v -> ln, rn, true + | key when key < v -> + let lesser, greater, wasFound = split key ln + lesser, join greater v rn, wasFound + | _ -> + let lesser, greater, wasFound = split key rn + join ln v lesser, greater, wasFound + +module AVLSet = + let empty = Empty + + let add value set = Tree.insert value set + + let delete value set = Tree.remove value set + + let contains value set = Tree.contains value set + + let copy set = Tree.copy set + + let rec union set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> minSet + | _, Empty -> maxSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, _ = Tree.split v minSet + let leftUnion = union ln lesser + let rightUnion = union rn greater + Tree.join leftUnion v rightUnion + + let rec intersection set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> Empty + | _, Empty -> Empty + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v minSet + let leftInter = intersection ln lesser + let rightInter = intersection rn greater + + if wasFound then + Tree.join leftInter v rightInter + else + Tree.merge leftInter rightInter + + let rec difference minuendSet subtrahendSet = + match minuendSet, subtrahendSet with + | Empty, _ -> Empty + | _, Empty -> minuendSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v subtrahendSet + let leftDiff = difference ln lesser + let rightDiff = difference rn greater + + if wasFound then + Tree.merge leftDiff rightDiff + else + Tree.join leftDiff v rightDiff + + let rec symmDifference set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> minSet + | _, Empty -> maxSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v minSet + let leftSymm = symmDifference ln lesser + let rightSymm = symmDifference rn greater + + if wasFound then + Tree.merge leftSymm rightSymm + else + Tree.join leftSymm v rightSymm + + let unionTraversal set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let unSet = Tree.copy maxSet + Tree.traverse Tree.insert unSet minSet + + let intersectionTraversal set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + Tree.traverse + (fun value set -> + if Tree.contains value maxSet then + Tree.insert value set + else + set) + Empty + minSet + + let differenceTraversal minuendSet subtrahendSet = + let diffSet = Tree.copy minuendSet + Tree.traverse Tree.remove diffSet subtrahendSet + + let symmDifferenceTraversal set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let symmSet = Tree.copy maxSet + + Tree.traverse + (fun value set -> + if Tree.contains value maxSet then + Tree.remove value set + else + Tree.insert value set) + symmSet + minSet + + let rec parallelUnion (opts: ParallelOptions) set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> minSet + | _, Empty -> maxSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, _ = Tree.split v minSet + let mutable leftUnion = Empty + let mutable rightUnion = Empty + + Parallel.Invoke( + opts, + (fun () -> leftUnion <- parallelUnion opts ln lesser), + (fun () -> rightUnion <- parallelUnion opts rn greater) + ) + + Tree.join leftUnion v rightUnion + + let rec parallelIntersection (opts: ParallelOptions) set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> Empty + | _, Empty -> Empty + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v minSet + let mutable leftInter = Empty + let mutable rightInter = Empty + + Parallel.Invoke( + opts, + (fun () -> leftInter <- parallelIntersection opts ln lesser), + (fun () -> rightInter <- parallelIntersection opts rn greater) + ) + + if wasFound then + Tree.join leftInter v rightInter + else + Tree.merge leftInter rightInter + + let rec parallelDifference (opts: ParallelOptions) minuendSet subtrahendSet = + match minuendSet, subtrahendSet with + | Empty, _ -> Empty + | _, Empty -> minuendSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v subtrahendSet + let mutable leftDiff = Empty + let mutable rightDiff = Empty + + Parallel.Invoke( + opts, + (fun () -> leftDiff <- parallelDifference opts ln lesser), + (fun () -> rightDiff <- parallelDifference opts rn greater) + ) + + if wasFound then + Tree.merge leftDiff rightDiff + else + Tree.join leftDiff v rightDiff + + let rec parallelSymmDifference (opts: ParallelOptions) set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> minSet + | _, Empty -> maxSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v minSet + let mutable leftSymm = Empty + let mutable rightSymm = Empty + + Parallel.Invoke( + opts, + (fun () -> leftSymm <- parallelSymmDifference opts ln lesser), + (fun () -> rightSymm <- parallelSymmDifference opts rn greater) + ) + + if wasFound then + Tree.merge leftSymm rightSymm + else + Tree.join leftSymm v rightSymm diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 438678c..a5884e3 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -6,6 +6,7 @@ + From 04e6a9855f6235a4c2b2fe4a79184f453d16b78c Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Fri, 15 May 2026 16:35:29 +0300 Subject: [PATCH 02/10] feat: refactor AVLSet architecture and add property tests - Encapsulate implementation by marking Node and Tree as internal. - Keep AVLSet module public as the primary API. - Implement InternalsVisibleTo to allow testing of internal structures. - Move parallel operations to a dedicated sub-module for better SoC. - Add FsCheck property-based tests for core set operations. - Fix and stabilize benchmarks. --- QuadTree.Benchmark/AVLSet.fs | 40 ++--- QuadTree.Tests/QuadTree.Tests.fsproj | 1 + QuadTree.Tests/Tests.AVLSet.fs | 230 +++++++++++++++------------ QuadTree/AVLSet.fs | 170 +++++--------------- QuadTree/AssemblyInfo.fs | 7 + QuadTree/ParallelAVLSet.fs | 110 +++++++++++++ QuadTree/QuadTree.fsproj | 21 +-- 7 files changed, 312 insertions(+), 267 deletions(-) create mode 100644 QuadTree/AssemblyInfo.fs create mode 100644 QuadTree/ParallelAVLSet.fs diff --git a/QuadTree.Benchmark/AVLSet.fs b/QuadTree.Benchmark/AVLSet.fs index 8493f29..e487e4d 100644 --- a/QuadTree.Benchmark/AVLSet.fs +++ b/QuadTree.Benchmark/AVLSet.fs @@ -1,17 +1,15 @@ namespace QuadTree.Benchmarks.AVLSet -open System.Threading.Tasks -open BenchmarkDotNet.Diagnosers open BenchmarkDotNet.Attributes open BenchmarkDotNet.Configs open QuadTree.AVLSet +open QuadTree.AVLSet.Parallel [] [] [] [] [] -[] type Benchmark() = let rnd = System.Random(1234561) @@ -29,7 +27,7 @@ type Benchmark() = [] [] - val mutable public Threads: int + val mutable public threads: int [] val mutable public rndInt: int @@ -69,15 +67,12 @@ type Benchmark() = [] [] member self.``Union via tree traversal``() = - AVLSet.unionTraversal self.setA self.setB + AVLSet.Traversal.union self.setA self.setB [] [] member self.``Parallel union with threads``() = - let opts = ParallelOptions() - opts.MaxDegreeOfParallelism <- self.Threads - - AVLSet.parallelUnion opts self.setA self.setB + ParallelAVLSet.union (Some self.threads) self.setA self.setB [] [] @@ -86,15 +81,12 @@ type Benchmark() = [] [] member self.``Intersection via tree traversal``() = - AVLSet.intersectionTraversal self.setA self.setB + AVLSet.Traversal.intersection self.setA self.setB [] [] member self.``Parallel intersection with threads``() = - let opts = ParallelOptions() - opts.MaxDegreeOfParallelism <- self.Threads - - AVLSet.parallelIntersection opts self.setA self.setB + ParallelAVLSet.intersection (Some self.threads) self.setA self.setB [] [] @@ -103,30 +95,24 @@ type Benchmark() = [] [] member self.``Difference via tree traversal``() = - AVLSet.differenceTraversal self.setA self.setB + AVLSet.Traversal.difference self.setA self.setB [] [] member self.``Parallel difference with threads``() = - let opts = ParallelOptions() - opts.MaxDegreeOfParallelism <- self.Threads - - AVLSet.parallelDifference opts self.setA self.setB + ParallelAVLSet.difference (Some self.threads) self.setA self.setB [] [] - member self.``Sequential symmetrical difference``() = + member self.``Sequential symmetric difference``() = AVLSet.symmDifference self.setA self.setB [] [] - member self.``Symmetrical difference via tree traversal``() = - AVLSet.symmDifferenceTraversal self.setA self.setB + member self.``Symmetric difference via tree traversal``() = + AVLSet.Traversal.symmDifference self.setA self.setB [] [] - member self.``Parallel symmetrical difference with threads``() = - let opts = ParallelOptions() - opts.MaxDegreeOfParallelism <- self.Threads - - AVLSet.parallelSymmDifference opts self.setA self.setB + member self.``Parallel symmetric difference with threads``() = + ParallelAVLSet.symmDifference (Some self.threads) self.setA self.setB diff --git a/QuadTree.Tests/QuadTree.Tests.fsproj b/QuadTree.Tests/QuadTree.Tests.fsproj index 019802e..a99c6be 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -20,6 +20,7 @@ + diff --git a/QuadTree.Tests/Tests.AVLSet.fs b/QuadTree.Tests/Tests.AVLSet.fs index c4b2d17..37de693 100644 --- a/QuadTree.Tests/Tests.AVLSet.fs +++ b/QuadTree.Tests/Tests.AVLSet.fs @@ -1,9 +1,10 @@ namespace QuadTree.Tests.AVLSet -open System.Threading.Tasks open Xunit open FsUnit.Xunit +open FsCheck.Xunit open QuadTree.AVLSet +open QuadTree.AVLSet.Parallel module SetTests = let rec isSetValid n mn mx = @@ -217,66 +218,37 @@ module SetTests = ) resultSet |> should equal correctSet + + [] + let ``Adding elemements to set`` (elements: int list) = + let set = elements |> List.fold (fun t x -> AVLSet.add x t) AVLSet.empty + + let rec setContainsList list set = + match list with + | [ ] -> true + | head :: tail -> AVLSet.contains head set && setContainsList tail set + + isSetValid set None None |> should be True + setContainsList elements set |> should be True - [] - let ``Search for missing element`` () = - let set = - Node( - 3, - 15, - Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), - Node( - 2, - 25, - Node(0, 20, Empty, Empty), - Node(1, 30, Node(0, 27, Empty, Empty), Node(0, 33, Empty, Empty)) - ) - ) - - AVLSet.contains 100 set |> should be False - - [] - let ``Search for negative value`` () = - let set = - Node( - 3, - 15, - Node(2, 5, Node(1, 0, Node(0, -3, Empty, Empty), Node(0, 2, Empty, Empty)), Node(0, 10, Empty, Empty)), - Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) - ) - - AVLSet.contains -3 set |> should be True - - [] - let ``Tree structure cloning`` () = - let set = - Node( - 3, - 15, - Node(2, 5, Node(1, 0, Node(0, -3, Empty, Empty), Node(0, 2, Empty, Empty)), Node(0, 10, Empty, Empty)), - Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) - ) + [] + let ``Set cloning`` (elements: int list) = + let set = elements |> List.fold (fun t x -> AVLSet.add x t) AVLSet.empty AVLSet.copy set |> should equal set - - let rnd = System.Random(123561) - - let dataA = Array.init 10000 (fun _ -> rnd.Next()) - let dataB = Array.init 2000 (fun _ -> rnd.Next()) - - let setA = dataA |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty - let setB = dataB |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty - - [] - let ``100k operations stress test`` () = - let data = Array.init 100000 (fun _ -> rnd.Next()) - - let set = data |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty - - isSetValid set None None |> should be True - - [] - let ``Standard set union`` () = + + [] + let ``Deleting elements from set`` (elements: int list) = + let set = elements |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let emptySet = elements |> List.fold (fun t e -> AVLSet.delete e t) set + let empty: AVLTree = AVLSet.empty + + emptySet |> should equal empty + + [] + let ``Standard set union`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let unionSet = AVLSet.union setA setB isSetValid unionSet None None |> should be True @@ -285,10 +257,17 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - AVLSet.union setB setA |> should equal unionSet + let unionSetSwapped = AVLSet.union setB setA - [] - let ``Standard set intersection`` () = + (advancedContains (fun v x -> x) unionSet unionSetSwapped + && advancedContains (fun v x -> x) unionSetSwapped unionSet) + |> should be True + + + [] + let ``Standard set intersection`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let intersectionSet = AVLSet.intersection setA setB isSetValid intersectionSet None None |> should be True @@ -296,10 +275,16 @@ module SetTests = advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - AVLSet.intersection setB setA |> should equal intersectionSet + let intersectionSetSwapped = AVLSet.intersection setB setA - [] - let ``Standard set difference`` () = + (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped + && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) + |> should be True + + [] + let ``Standard set difference`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let differenceSet = AVLSet.difference setA setB isSetValid differenceSet None None |> should be True @@ -307,8 +292,10 @@ module SetTests = advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA differenceSet |> should be True - [] - let ``Standard symmetric difference`` () = + [] + let ``Standard symmetric difference`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let symmDiffSet = AVLSet.symmDifference setA setB isSetValid symmDiffSet None None |> should be True @@ -317,11 +304,17 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - AVLSet.symmDifference setB setA |> should equal symmDiffSet + let symmDiffSetSwapped = AVLSet.symmDifference setB setA - [] - let ``Union via tree traversal`` () = - let unionSet = AVLSet.unionTraversal setA setB + (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped + && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) + |> should be True + + [] + let ``Union via tree traversal`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let unionSet = AVLSet.Traversal.union setA setB isSetValid unionSet None None |> should be True @@ -329,45 +322,63 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - AVLSet.unionTraversal setB setA |> should equal unionSet + let unionSetSwapped = AVLSet.union setB setA - [] - let ``Intersection via tree traversal`` () = - let intersectionSet = AVLSet.intersectionTraversal setA setB + (advancedContains (fun v x -> x) unionSet unionSetSwapped + && advancedContains (fun v x -> x) unionSetSwapped unionSet) + |> should be True + + [] + let ``Intersection via tree traversal`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let intersectionSet = AVLSet.Traversal.intersection setA setB isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - AVLSet.intersectionTraversal setB setA |> should equal intersectionSet + let intersectionSetSwapped = AVLSet.intersection setB setA - [] - let ``Difference via tree traversal`` () = - let differenceSet = AVLSet.differenceTraversal setA setB + (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped + && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) + |> should be True + + [] + let ``Difference via tree traversal`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let differenceSet = AVLSet.Traversal.difference setA setB isSetValid differenceSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA differenceSet |> should be True - [] - let ``Symmetric difference via tree traversal`` () = - let symmDiffSet = AVLSet.symmDifferenceTraversal setA setB + [] + let ``Symmetric difference via tree traversal`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let symmDiffSet = AVLSet.Traversal.symmDifference setA setB isSetValid symmDiffSet None None |> should be True - (advancedContains (fun v x -> if AVLSet.contains v setB then not x else x = true) setA symmDiffSet + (advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA symmDiffSet && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - AVLSet.symmDifferenceTraversal setB setA |> should equal symmDiffSet + let symmDiffSetSwapped = AVLSet.symmDifference setB setA - [] - let ``Parallel set union with threads`` () = - let opts = ParallelOptions() + (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped + && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) + |> should be True - let unionSet = AVLSet.parallelUnion opts setA setB + [] + let ``Parallel set union with threads`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let unionSet = ParallelAVLSet.union None setA setB isSetValid unionSet None None |> should be True @@ -375,37 +386,45 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - AVLSet.parallelUnion opts setB setA |> should equal unionSet + let unionSetSwapped = AVLSet.union setB setA - [] - let ``Parallel set intersection with threads`` () = - let opts = ParallelOptions() + (advancedContains (fun v x -> x) unionSet unionSetSwapped + && advancedContains (fun v x -> x) unionSetSwapped unionSet) + |> should be True - let intersectionSet = AVLSet.parallelIntersection opts setA setB + [] + let ``Parallel set intersection with threads`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let intersectionSet = ParallelAVLSet.intersection None setA setB isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - AVLSet.parallelIntersection opts setB setA |> should equal intersectionSet + let intersectionSetSwapped = AVLSet.intersection setB setA - [] - let ``Parallel set difference with threads`` () = - let opts = ParallelOptions() + (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped + && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) + |> should be True - let differenceSet = AVLSet.parallelDifference opts setA setB + [] + let ``Parallel set difference with threads`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let differenceSet = ParallelAVLSet.difference None setA setB isSetValid differenceSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA differenceSet |> should be True - [] - let ``Parallel set symmetrical difference with threads`` () = - let opts = ParallelOptions() - - let symmDiffSet = AVLSet.parallelSymmDifference opts setA setB + [] + let ``Parallel set symmetric difference with threads`` (elementsA: int list, elementsB: int list) = + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let symmDiffSet = ParallelAVLSet.symmDifference None setA setB isSetValid symmDiffSet None None |> should be True @@ -413,4 +432,9 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - AVLSet.parallelSymmDifference opts setB setA |> should equal symmDiffSet + let symmDiffSetSwapped = AVLSet.symmDifference setB setA + + (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped + && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) + |> should be True + diff --git a/QuadTree/AVLSet.fs b/QuadTree/AVLSet.fs index 59ca72e..e90f840 100644 --- a/QuadTree/AVLSet.fs +++ b/QuadTree/AVLSet.fs @@ -1,12 +1,10 @@ namespace QuadTree.AVLSet -open System.Threading.Tasks - type AVLTree<'Value> = | Empty | Node of int * 'Value * AVLTree<'Value> * AVLTree<'Value> -module Node = +module internal Node = let height n = match n with | Empty -> -1 @@ -14,23 +12,23 @@ module Node = let value n = match n with - | Empty -> failwith "Empty node has no value" + | Empty -> failwith "Empty node has no value. This error should be unreachable" | Node(_, v, _, _) -> v let leftChild n = match n with - | Empty -> failwith "Empty node has no left child" + | Empty -> failwith "Empty node has no left child. This error should be unreachable" | Node(_, _, ln, _) -> ln let rightChild n = match n with - | Empty -> failwith "Empty node has no right child" + | Empty -> failwith "Empty node has no right child. This error should be unreachable" | Node(_, _, _, rn) -> rn let maxMinNodesByHeights n1 n2 = if height n1 >= height n2 then n1, n2 else n2, n1 -module Tree = +module internal Tree = let LLrotate n = let ln = Node.leftChild n let lln = Node.leftChild ln @@ -82,7 +80,7 @@ module Tree = let rec minNode n = match n with - | Empty -> failwith "minNode: cannot find minimum of an empty node" + | Empty -> failwith "minNode: cannot find minimum of an empty node. This error should be unreachable" | Node(_, v, Empty, rn) -> v, rn | Node(_, v, ln, rn) -> let value, lnNew = minNode ln @@ -151,13 +149,13 @@ module Tree = | diff when abs diff <= 1 -> Node(max leftHeight rightHeight + 1, key, left, right) | diff when diff >= 2 -> match left with - | Empty -> failwith "Unreacheable message 1" + | Empty -> failwith "Left subtree is Empty in join operation. This error should be unreachable" | Node(h, v, ln, rn) -> let rnNew = join rn key right balance ln rnNew v | _ -> match right with - | Empty -> failwith "Unreacheable message 2" + | Empty -> failwith "Right subtree is Empty in join operation. This error should be unreachable" | Node(h, v, ln, rn) -> let lnNew = join left key ln balance lnNew rn v @@ -183,7 +181,7 @@ module Tree = let lesser, greater, wasFound = split key rn join ln v lesser, greater, wasFound -module AVLSet = +module public AVLSet = let empty = Empty let add value set = Tree.insert value set @@ -252,119 +250,37 @@ module AVLSet = else Tree.join leftSymm v rightSymm - let unionTraversal set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 - let unSet = Tree.copy maxSet - Tree.traverse Tree.insert unSet minSet - - let intersectionTraversal set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 - - Tree.traverse - (fun value set -> - if Tree.contains value maxSet then - Tree.insert value set - else - set) - Empty - minSet - - let differenceTraversal minuendSet subtrahendSet = - let diffSet = Tree.copy minuendSet - Tree.traverse Tree.remove diffSet subtrahendSet - - let symmDifferenceTraversal set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 - let symmSet = Tree.copy maxSet - - Tree.traverse - (fun value set -> - if Tree.contains value maxSet then - Tree.remove value set - else - Tree.insert value set) - symmSet - minSet - - let rec parallelUnion (opts: ParallelOptions) set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 - - match maxSet, minSet with - | Empty, _ -> minSet - | _, Empty -> maxSet - | Node(_, v, ln, rn), _ -> - let lesser, greater, _ = Tree.split v minSet - let mutable leftUnion = Empty - let mutable rightUnion = Empty - - Parallel.Invoke( - opts, - (fun () -> leftUnion <- parallelUnion opts ln lesser), - (fun () -> rightUnion <- parallelUnion opts rn greater) - ) - - Tree.join leftUnion v rightUnion - - let rec parallelIntersection (opts: ParallelOptions) set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 - - match maxSet, minSet with - | Empty, _ -> Empty - | _, Empty -> Empty - | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v minSet - let mutable leftInter = Empty - let mutable rightInter = Empty - - Parallel.Invoke( - opts, - (fun () -> leftInter <- parallelIntersection opts ln lesser), - (fun () -> rightInter <- parallelIntersection opts rn greater) - ) - - if wasFound then - Tree.join leftInter v rightInter - else - Tree.merge leftInter rightInter - - let rec parallelDifference (opts: ParallelOptions) minuendSet subtrahendSet = - match minuendSet, subtrahendSet with - | Empty, _ -> Empty - | _, Empty -> minuendSet - | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v subtrahendSet - let mutable leftDiff = Empty - let mutable rightDiff = Empty - - Parallel.Invoke( - opts, - (fun () -> leftDiff <- parallelDifference opts ln lesser), - (fun () -> rightDiff <- parallelDifference opts rn greater) - ) - - if wasFound then - Tree.merge leftDiff rightDiff - else - Tree.join leftDiff v rightDiff - - let rec parallelSymmDifference (opts: ParallelOptions) set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 - - match maxSet, minSet with - | Empty, _ -> minSet - | _, Empty -> maxSet - | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v minSet - let mutable leftSymm = Empty - let mutable rightSymm = Empty - - Parallel.Invoke( - opts, - (fun () -> leftSymm <- parallelSymmDifference opts ln lesser), - (fun () -> rightSymm <- parallelSymmDifference opts rn greater) - ) - - if wasFound then - Tree.merge leftSymm rightSymm - else - Tree.join leftSymm v rightSymm + module Traversal = + let union set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let unSet = Tree.copy maxSet + Tree.traverse Tree.insert unSet minSet + + let intersection set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + Tree.traverse + (fun value set -> + if Tree.contains value maxSet then + Tree.insert value set + else + set) + Empty + minSet + + let difference minuendSet subtrahendSet = + let diffSet = Tree.copy minuendSet + Tree.traverse Tree.remove diffSet subtrahendSet + + let symmDifference set1 set2 = + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let symmSet = Tree.copy maxSet + + Tree.traverse + (fun value set -> + if Tree.contains value maxSet then + Tree.remove value set + else + Tree.insert value set) + symmSet + minSet diff --git a/QuadTree/AssemblyInfo.fs b/QuadTree/AssemblyInfo.fs new file mode 100644 index 0000000..05e5473 --- /dev/null +++ b/QuadTree/AssemblyInfo.fs @@ -0,0 +1,7 @@ +namespace QuadTree + +open System.Runtime.CompilerServices + +[] +[] +do () \ No newline at end of file diff --git a/QuadTree/ParallelAVLSet.fs b/QuadTree/ParallelAVLSet.fs new file mode 100644 index 0000000..31cbd58 --- /dev/null +++ b/QuadTree/ParallelAVLSet.fs @@ -0,0 +1,110 @@ +namespace QuadTree.AVLSet.Parallel + +open QuadTree.AVLSet + +/// +/// Parallel union of two AVL sets. +/// +/// +/// Optional thread limit: +/// - None: Auto-detect (uses all available CPU cores via System.Environment.ProcessorCount). +/// - Some(x): Hard limit to x threads (useful for benchmarking and resource control). +/// + +module ParallelAVLSet = + let rec unionAsync threads set1 set2 = + async { + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> return minSet + | _, Empty -> return maxSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, _ = Tree.split v minSet + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = unionAsync threads ln lesser + let right = unionAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + let leftUnion, rightUnion = results[0], results[1] + + return Tree.join leftUnion v rightUnion + } + + let rec intersectionAsync threads set1 set2 = + async { + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> return Empty + | _, Empty -> return Empty + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v minSet + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = intersectionAsync threads ln lesser + let right = intersectionAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + let leftInter, rightInter = results[0], results[1] + + return if wasFound then Tree.join leftInter v rightInter + else Tree.merge leftInter rightInter + } + + let rec differenceAsync threads minuendSet subtrahendSet = + async { + match minuendSet, subtrahendSet with + | Empty, _ -> return Empty + | _, Empty -> return minuendSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v subtrahendSet + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = differenceAsync threads ln lesser + let right = differenceAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + let leftDiff, rightDiff = results[0], results[1] + + return if wasFound then Tree.merge leftDiff rightDiff + else Tree.join leftDiff v rightDiff + } + + let rec symmDifferenceAsync threads set1 set2 = + async { + let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + + match maxSet, minSet with + | Empty, _ -> return minSet + | _, Empty -> return maxSet + | Node(_, v, ln, rn), _ -> + let lesser, greater, wasFound = Tree.split v minSet + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = symmDifferenceAsync threads ln lesser + let right = symmDifferenceAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + let leftSymm, rightSymm = results[0], results[1] + + return if wasFound then Tree.merge leftSymm rightSymm + else Tree.join leftSymm v rightSymm + } + + let union threads t1 t2 = + unionAsync threads t1 t2 |> Async.RunSynchronously + + let intersection threads t1 t2 = + intersectionAsync threads t1 t2 |> Async.RunSynchronously + + let difference threads t1 t2 = + differenceAsync threads t1 t2 |> Async.RunSynchronously + + let symmDifference threads t1 t2 = + symmDifferenceAsync threads t1 t2 |> Async.RunSynchronously \ No newline at end of file diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index a5884e3..28e7916 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -1,19 +1,20 @@ - + net10.0 - - - - - - - - - + + + + + + + + + + From c8bead97d4b1c5de0ec91848a455dbab499a8133 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Fri, 15 May 2026 16:39:39 +0300 Subject: [PATCH 03/10] format files --- QuadTree.Tests/Tests.AVLSet.fs | 45 +++++++++++++++++----------------- QuadTree/AssemblyInfo.fs | 2 +- QuadTree/ParallelAVLSet.fs | 37 +++++++++++++++++----------- 3 files changed, 46 insertions(+), 38 deletions(-) diff --git a/QuadTree.Tests/Tests.AVLSet.fs b/QuadTree.Tests/Tests.AVLSet.fs index 37de693..9fef382 100644 --- a/QuadTree.Tests/Tests.AVLSet.fs +++ b/QuadTree.Tests/Tests.AVLSet.fs @@ -218,16 +218,16 @@ module SetTests = ) resultSet |> should equal correctSet - + [] let ``Adding elemements to set`` (elements: int list) = - let set = elements |> List.fold (fun t x -> AVLSet.add x t) AVLSet.empty + let set = elements |> List.fold (fun t x -> AVLSet.add x t) AVLSet.empty - let rec setContainsList list set = + let rec setContainsList list set = match list with - | [ ] -> true + | [] -> true | head :: tail -> AVLSet.contains head set && setContainsList tail set - + isSetValid set None None |> should be True setContainsList elements set |> should be True @@ -236,10 +236,10 @@ module SetTests = let set = elements |> List.fold (fun t x -> AVLSet.add x t) AVLSet.empty AVLSet.copy set |> should equal set - + [] let ``Deleting elements from set`` (elements: int list) = - let set = elements |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let set = elements |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let emptySet = elements |> List.fold (fun t e -> AVLSet.delete e t) set let empty: AVLTree = AVLSet.empty @@ -247,8 +247,8 @@ module SetTests = [] let ``Standard set union`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let unionSet = AVLSet.union setA setB isSetValid unionSet None None |> should be True @@ -266,8 +266,8 @@ module SetTests = [] let ``Standard set intersection`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let intersectionSet = AVLSet.intersection setA setB isSetValid intersectionSet None None |> should be True @@ -283,8 +283,8 @@ module SetTests = [] let ``Standard set difference`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let differenceSet = AVLSet.difference setA setB isSetValid differenceSet None None |> should be True @@ -294,7 +294,7 @@ module SetTests = [] let ``Standard symmetric difference`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let symmDiffSet = AVLSet.symmDifference setA setB @@ -312,7 +312,7 @@ module SetTests = [] let ``Union via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let unionSet = AVLSet.Traversal.union setA setB @@ -330,7 +330,7 @@ module SetTests = [] let ``Intersection via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let intersectionSet = AVLSet.Traversal.intersection setA setB @@ -347,7 +347,7 @@ module SetTests = [] let ``Difference via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let differenceSet = AVLSet.Traversal.difference setA setB @@ -358,7 +358,7 @@ module SetTests = [] let ``Symmetric difference via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let symmDiffSet = AVLSet.Traversal.symmDifference setA setB @@ -376,7 +376,7 @@ module SetTests = [] let ``Parallel set union with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let unionSet = ParallelAVLSet.union None setA setB @@ -394,7 +394,7 @@ module SetTests = [] let ``Parallel set intersection with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let intersectionSet = ParallelAVLSet.intersection None setA setB @@ -411,7 +411,7 @@ module SetTests = [] let ``Parallel set difference with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let differenceSet = ParallelAVLSet.difference None setA setB @@ -422,7 +422,7 @@ module SetTests = [] let ``Parallel set symmetric difference with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty + let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let symmDiffSet = ParallelAVLSet.symmDifference None setA setB @@ -437,4 +437,3 @@ module SetTests = (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) |> should be True - diff --git a/QuadTree/AssemblyInfo.fs b/QuadTree/AssemblyInfo.fs index 05e5473..ab49311 100644 --- a/QuadTree/AssemblyInfo.fs +++ b/QuadTree/AssemblyInfo.fs @@ -4,4 +4,4 @@ open System.Runtime.CompilerServices [] [] -do () \ No newline at end of file +do () diff --git a/QuadTree/ParallelAVLSet.fs b/QuadTree/ParallelAVLSet.fs index 31cbd58..a043d0f 100644 --- a/QuadTree/ParallelAVLSet.fs +++ b/QuadTree/ParallelAVLSet.fs @@ -11,7 +11,7 @@ open QuadTree.AVLSet /// - Some(x): Hard limit to x threads (useful for benchmarking and resource control). /// -module ParallelAVLSet = +module ParallelAVLSet = let rec unionAsync threads set1 set2 = async { let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 @@ -24,7 +24,7 @@ module ParallelAVLSet = let limit = defaultArg threads System.Environment.ProcessorCount - let left = unionAsync threads ln lesser + let left = unionAsync threads ln lesser let right = unionAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) @@ -45,14 +45,17 @@ module ParallelAVLSet = let limit = defaultArg threads System.Environment.ProcessorCount - let left = intersectionAsync threads ln lesser + let left = intersectionAsync threads ln lesser let right = intersectionAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) let leftInter, rightInter = results[0], results[1] - return if wasFound then Tree.join leftInter v rightInter - else Tree.merge leftInter rightInter + return + if wasFound then + Tree.join leftInter v rightInter + else + Tree.merge leftInter rightInter } let rec differenceAsync threads minuendSet subtrahendSet = @@ -64,15 +67,18 @@ module ParallelAVLSet = let lesser, greater, wasFound = Tree.split v subtrahendSet let limit = defaultArg threads System.Environment.ProcessorCount - - let left = differenceAsync threads ln lesser + + let left = differenceAsync threads ln lesser let right = differenceAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) let leftDiff, rightDiff = results[0], results[1] - return if wasFound then Tree.merge leftDiff rightDiff - else Tree.join leftDiff v rightDiff + return + if wasFound then + Tree.merge leftDiff rightDiff + else + Tree.join leftDiff v rightDiff } let rec symmDifferenceAsync threads set1 set2 = @@ -86,15 +92,18 @@ module ParallelAVLSet = let lesser, greater, wasFound = Tree.split v minSet let limit = defaultArg threads System.Environment.ProcessorCount - - let left = symmDifferenceAsync threads ln lesser + + let left = symmDifferenceAsync threads ln lesser let right = symmDifferenceAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) let leftSymm, rightSymm = results[0], results[1] - return if wasFound then Tree.merge leftSymm rightSymm - else Tree.join leftSymm v rightSymm + return + if wasFound then + Tree.merge leftSymm rightSymm + else + Tree.join leftSymm v rightSymm } let union threads t1 t2 = @@ -107,4 +116,4 @@ module ParallelAVLSet = differenceAsync threads t1 t2 |> Async.RunSynchronously let symmDifference threads t1 t2 = - symmDifferenceAsync threads t1 t2 |> Async.RunSynchronously \ No newline at end of file + symmDifferenceAsync threads t1 t2 |> Async.RunSynchronously From 6a3bfb6ac530e2e8cda9aa2459c7eb9f345af6dd Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Sat, 16 May 2026 18:24:48 +0300 Subject: [PATCH 04/10] Refactor to AVLSet: remove Node module, simplify rotations via pattern matching, open modules, clean up redundant pattern matchings and replace them with if-else --- QuadTree.Benchmark/AVLSet.fs | 4 +- QuadTree.Tests/Tests.AVLSet.fs | 8 +- QuadTree/AVLSet.fs | 190 ++++++++++++++++----------------- QuadTree/AssemblyInfo.fs | 7 -- QuadTree/ParallelAVLSet.fs | 6 +- 5 files changed, 100 insertions(+), 115 deletions(-) delete mode 100644 QuadTree/AssemblyInfo.fs diff --git a/QuadTree.Benchmark/AVLSet.fs b/QuadTree.Benchmark/AVLSet.fs index e487e4d..fbaafc1 100644 --- a/QuadTree.Benchmark/AVLSet.fs +++ b/QuadTree.Benchmark/AVLSet.fs @@ -33,10 +33,10 @@ type Benchmark() = val mutable public rndInt: int [] - val mutable public setA: AVLTree + val mutable public setA: AVLSet [] - val mutable public setB: AVLTree + val mutable public setB: AVLSet [] member self.Setup() = diff --git a/QuadTree.Tests/Tests.AVLSet.fs b/QuadTree.Tests/Tests.AVLSet.fs index 9fef382..e9601ce 100644 --- a/QuadTree.Tests/Tests.AVLSet.fs +++ b/QuadTree.Tests/Tests.AVLSet.fs @@ -14,8 +14,8 @@ module SetTests = let isInBounds = mn |> Option.forall (fun mn -> v > mn) && mx |> Option.forall (fun mx -> v < mx) - let lnHeight = Node.height ln - let rnHeight = Node.height rn + let lnHeight = Tree.height ln + let rnHeight = Tree.height rn isInBounds && h = (max lnHeight rnHeight + 1) @@ -112,7 +112,7 @@ module SetTests = let ``Single-node deletion`` () = let resultSet = Node(0, 15, Empty, Empty) |> AVLSet.delete 15 - let correctSet: AVLTree = Empty + let correctSet: AVLSet = Empty resultSet |> should equal correctSet @@ -241,7 +241,7 @@ module SetTests = let ``Deleting elements from set`` (elements: int list) = let set = elements |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty let emptySet = elements |> List.fold (fun t e -> AVLSet.delete e t) set - let empty: AVLTree = AVLSet.empty + let empty: AVLSet = AVLSet.empty emptySet |> should equal empty diff --git a/QuadTree/AVLSet.fs b/QuadTree/AVLSet.fs index e90f840..655a741 100644 --- a/QuadTree/AVLSet.fs +++ b/QuadTree/AVLSet.fs @@ -1,101 +1,92 @@ namespace QuadTree.AVLSet -type AVLTree<'Value> = +type AVLSet<'Value> = | Empty - | Node of int * 'Value * AVLTree<'Value> * AVLTree<'Value> + | Node of int * 'Value * AVLSet<'Value> * AVLSet<'Value> -module internal Node = +module Tree = let height n = match n with | Empty -> -1 | Node(h, _, _, _) -> h - let value n = - match n with - | Empty -> failwith "Empty node has no value. This error should be unreachable" - | Node(_, v, _, _) -> v - - let leftChild n = - match n with - | Empty -> failwith "Empty node has no left child. This error should be unreachable" - | Node(_, _, ln, _) -> ln - - let rightChild n = - match n with - | Empty -> failwith "Empty node has no right child. This error should be unreachable" - | Node(_, _, _, rn) -> rn - let maxMinNodesByHeights n1 n2 = - if height n1 >= height n2 then n1, n2 else n2, n1 + match n1, n2 with + | Empty, _ -> n2, n1 + | _, Empty -> n1, n2 + | Node(h1, _, _, _), Node(h2, _, _, _) -> if h1 >= h2 then n1, n2 else n2, n1 -module internal Tree = let LLrotate n = - let ln = Node.leftChild n - let lln = Node.leftChild ln - let rln = Node.rightChild ln - let rn = Node.rightChild n - let rlnNew = Node(max (Node.height rln) (Node.height rn) + 1, Node.value n, rln, rn) - Node(max (Node.height lln) (Node.height rlnNew) + 1, Node.value ln, lln, rlnNew) + match n with + | Node(_, vn, Node(_, vln, lln, rln), rn) -> + let rlnNew = Node(max (height rln) (height rn) + 1, vn, rln, rn) + Node(max (height lln) (height rlnNew) + 1, vln, lln, rlnNew) + | _ -> invalidArg "n" "Node cannot be rotated" let RRrotate n = - let ln = Node.leftChild n - let rn = Node.rightChild n - let rrn = Node.rightChild rn - let lrn = Node.leftChild rn - let lrnNew = Node(max (Node.height ln) (Node.height lrn) + 1, Node.value n, ln, lrn) - Node(max (Node.height lrnNew) (Node.height rrn) + 1, Node.value rn, lrnNew, rrn) + match n with + | Node(_, vn, ln, Node(_, vrn, lrn, rrn)) -> + let lrnNew = Node(max (height ln) (height lrn) + 1, vn, ln, lrn) + Node(max (height lrnNew) (height rrn) + 1, vrn, lrnNew, rrn) + | _ -> invalidArg "n" "Node cannot be rotated" let LRrotate n = - let lnNew = RRrotate(Node.leftChild n) - let rn = Node.rightChild n - LLrotate(Node(max (Node.height lnNew) (Node.height rn) + 1, Node.value n, lnNew, rn)) + match n with + | Node(hn, vn, ln, rn) -> + let lnNew = RRrotate ln + LLrotate(Node(max (height lnNew) (height rn) + 1, vn, lnNew, rn)) + | _ -> invalidArg "n" "Node cannot be rotated" let RLrotate n = - let rnNew = LLrotate(Node.rightChild n) - let ln = Node.leftChild n - RRrotate(Node(max (Node.height ln) (Node.height rnNew) + 1, Node.value n, ln, rnNew)) + match n with + | Node(hn, vn, ln, rn) -> + let rnNew = LLrotate rn + RRrotate(Node(max (height ln) (height rnNew) + 1, vn, ln, rnNew)) + | _ -> invalidArg "n" "Node cannot be rotated" let balance ln rn v = - let lnHeight = Node.height ln - let rnHeight = Node.height rn - - match lnHeight - rnHeight with - | 2 -> - let llnHeight = Node.height (Node.leftChild ln) - let rlnHeight = Node.height (Node.rightChild ln) - - if llnHeight >= rlnHeight then - LLrotate(Node(0, v, ln, rn)) - else - LRrotate(Node(0, v, ln, rn)) - | -2 -> - let lrnHeight = Node.height (Node.leftChild rn) - let rrnHeight = Node.height (Node.rightChild rn) - - if lrnHeight <= rrnHeight then - RRrotate(Node(0, v, ln, rn)) - else - RLrotate(Node(0, v, ln, rn)) - | _ -> Node(max lnHeight rnHeight + 1, v, ln, rn) + let lnHeight = height ln + let rnHeight = height rn + let diff = lnHeight - rnHeight + + if diff >= 2 then + match ln with + | Empty -> invalidArg "rn" "left child is Empty but diff is lesser than 2" + | Node(_, _, lln, rln) -> + if height lln >= height rln then + LLrotate(Node(0, v, ln, rn)) + else + LRrotate(Node(0, v, ln, rn)) + elif diff <= -2 then + match rn with + | Empty -> invalidArg "rn" "right child is Empty but diff is greater than -2" + | Node(_, _, lrn, rrn) -> + if height lrn <= height rrn then + RRrotate(Node(0, v, ln, rn)) + else + RLrotate(Node(0, v, ln, rn)) + else + Node(max lnHeight rnHeight + 1, v, ln, rn) let rec minNode n = match n with - | Empty -> failwith "minNode: cannot find minimum of an empty node. This error should be unreachable" - | Node(_, v, Empty, rn) -> v, rn + | Empty -> None + | Node(_, v, Empty, rn) -> Some(v, rn) | Node(_, v, ln, rn) -> - let value, lnNew = minNode ln - value, balance lnNew rn v + match minNode ln with + | None -> None + | Some(value, lnNew) -> Some(value, balance lnNew rn v) let rec insert value n = match n with | Empty -> Node(0, value, Empty, Empty) | Node(h, v, ln, rn) -> - match value with - | value when value = v -> n - | value when value < v -> + if value = v then + n + elif value < v then let lnNew = insert value ln balance lnNew rn v - | _ -> + else let rnNew = insert value rn balance ln rnNew v @@ -103,18 +94,18 @@ module internal Tree = match n with | Empty -> Empty | Node(h, v, ln, rn) -> - match value with - | value when value = v -> + if value = v then match ln, rn with | Empty, _ -> rn | _, Empty -> ln | _, _ -> - let newValue, rnNew = minNode rn - balance ln rnNew newValue - | value when value < v -> + match minNode rn with + | None -> failwith "impossible error: rn is not Empty" + | Some(newValue, rnNew) -> balance ln rnNew newValue + elif value < v then let lnNew = remove value ln balance lnNew rn v - | _ -> + else let rnNew = remove value rn balance ln rnNew v @@ -123,12 +114,11 @@ module internal Tree = match n with | Empty -> false | Node(h, v, ln, rn) -> - match value with - | value when value = v -> true - | value when value < v -> contains value ln - | _ -> contains value rn + if value = v then true + elif value < v then contains value ln + else contains value rn - let rec traverse (func: 'A -> AVLTree<'B> -> AVLTree<'B>) nArg n = + let rec traverse (func: 'A -> AVLSet<'B> -> AVLSet<'B>) nArg n = match n with | Empty -> nArg | Node(_, v, ln, rn) -> @@ -142,20 +132,21 @@ module internal Tree = | Node(h, v, ln, rn) -> Node(h, v, copy ln, copy rn) let rec join left key right = - let leftHeight = Node.height left - let rightHeight = Node.height right + let leftHeight = height left + let rightHeight = height right + let diff = leftHeight - rightHeight - match leftHeight - rightHeight with - | diff when abs diff <= 1 -> Node(max leftHeight rightHeight + 1, key, left, right) - | diff when diff >= 2 -> + if abs diff <= 1 then + Node(max leftHeight rightHeight + 1, key, left, right) + elif diff >= 2 then match left with - | Empty -> failwith "Left subtree is Empty in join operation. This error should be unreachable" + | Empty -> invalidArg "right" "left child is Empty but diff is lesser than 2" | Node(h, v, ln, rn) -> let rnNew = join rn key right balance ln rnNew v - | _ -> + else match right with - | Empty -> failwith "Right subtree is Empty in join operation. This error should be unreachable" + | Empty -> invalidArg "left" "right child is Empty but diff is greater than -2" | Node(h, v, ln, rn) -> let lnNew = join left key ln balance lnNew rn v @@ -165,23 +156,24 @@ module internal Tree = | Empty, _ -> right | _, Empty -> left | _, _ -> - let key, newRight = minNode right - join left key newRight + match minNode right with + | None -> failwith "impossible error. right is not Empty" + | Some(key, newRight) -> join left key newRight let rec split key n = match n with | Empty -> Empty, Empty, false | Node(_, v, ln, rn) -> - match key with - | key when key = v -> ln, rn, true - | key when key < v -> + if key = v then + ln, rn, true + elif key < v then let lesser, greater, wasFound = split key ln lesser, join greater v rn, wasFound - | _ -> + else let lesser, greater, wasFound = split key rn join ln v lesser, greater, wasFound -module public AVLSet = +module AVLSet = let empty = Empty let add value set = Tree.insert value set @@ -193,7 +185,7 @@ module public AVLSet = let copy set = Tree.copy set let rec union set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 match maxSet, minSet with | Empty, _ -> minSet @@ -205,7 +197,7 @@ module public AVLSet = Tree.join leftUnion v rightUnion let rec intersection set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 match maxSet, minSet with | Empty, _ -> Empty @@ -235,7 +227,7 @@ module public AVLSet = Tree.join leftDiff v rightDiff let rec symmDifference set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 match maxSet, minSet with | Empty, _ -> minSet @@ -252,12 +244,12 @@ module public AVLSet = module Traversal = let union set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 let unSet = Tree.copy maxSet Tree.traverse Tree.insert unSet minSet let intersection set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 Tree.traverse (fun value set -> @@ -273,7 +265,7 @@ module public AVLSet = Tree.traverse Tree.remove diffSet subtrahendSet let symmDifference set1 set2 = - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 let symmSet = Tree.copy maxSet Tree.traverse diff --git a/QuadTree/AssemblyInfo.fs b/QuadTree/AssemblyInfo.fs deleted file mode 100644 index ab49311..0000000 --- a/QuadTree/AssemblyInfo.fs +++ /dev/null @@ -1,7 +0,0 @@ -namespace QuadTree - -open System.Runtime.CompilerServices - -[] -[] -do () diff --git a/QuadTree/ParallelAVLSet.fs b/QuadTree/ParallelAVLSet.fs index a043d0f..c04fd98 100644 --- a/QuadTree/ParallelAVLSet.fs +++ b/QuadTree/ParallelAVLSet.fs @@ -14,7 +14,7 @@ open QuadTree.AVLSet module ParallelAVLSet = let rec unionAsync threads set1 set2 = async { - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 match maxSet, minSet with | Empty, _ -> return minSet @@ -35,7 +35,7 @@ module ParallelAVLSet = let rec intersectionAsync threads set1 set2 = async { - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 match maxSet, minSet with | Empty, _ -> return Empty @@ -83,7 +83,7 @@ module ParallelAVLSet = let rec symmDifferenceAsync threads set1 set2 = async { - let maxSet, minSet = Node.maxMinNodesByHeights set1 set2 + let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 match maxSet, minSet with | Empty, _ -> return minSet From 593a5c8508ee120e036a230b28f3bcf0b2f242a7 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Tue, 19 May 2026 22:31:36 +0300 Subject: [PATCH 05/10] refactor: replace exceptions with Result type for error handling --- QuadTree.Benchmark/AVLSet.fs | 13 +- QuadTree.Tests/Tests.AVLSet.fs | 153 ++++++++--------- QuadTree/AVLSet.fs | 296 ++++++++++++++++++--------------- QuadTree/ParallelAVLSet.fs | 165 +++++++++++------- QuadTree/QuadTree.fsproj | 2 +- 5 files changed, 358 insertions(+), 271 deletions(-) diff --git a/QuadTree.Benchmark/AVLSet.fs b/QuadTree.Benchmark/AVLSet.fs index fbaafc1..fb27827 100644 --- a/QuadTree.Benchmark/AVLSet.fs +++ b/QuadTree.Benchmark/AVLSet.fs @@ -49,8 +49,17 @@ type Benchmark() = let dataB = Array.init self.B (fun _ -> rnd.Next()) - self.setA <- dataA |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty - self.setB <- dataB |> Array.fold (fun s v -> AVLSet.add v s) AVLSet.empty + self.setA <- dataA |> Array.fold (fun (set: AVLSet) v -> + match AVLSet.add v set with + | Ok nextSet -> nextSet + | Error err -> failwithf "Benchmark setup failed: %A" err + ) AVLSet.empty + + self.setB <- dataB |> Array.fold (fun (set: AVLSet) v -> + match AVLSet.add v set with + | Ok nextSet -> nextSet + | Error err -> failwithf "Benchmark setup failed: %A" err + ) AVLSet.empty [] [] diff --git a/QuadTree.Tests/Tests.AVLSet.fs b/QuadTree.Tests/Tests.AVLSet.fs index e9601ce..e5fbb7e 100644 --- a/QuadTree.Tests/Tests.AVLSet.fs +++ b/QuadTree.Tests/Tests.AVLSet.fs @@ -23,11 +23,16 @@ module SetTests = && isSetValid ln mn (Some v) && isSetValid rn (Some v) mx + let (!!) result = + match result with + | Ok v -> v + | Error e -> failwithf "Test infrastructure failure. Expected Ok, got: %A" e + let rec advancedContains (condition: 'A -> bool -> bool) setOfValues targetSet = match setOfValues with | Empty -> true | Node(_, v, ln, rn) -> - let lesser, greater, wasFound = Tree.split v targetSet + let lesser, greater, wasFound = !! (Tree.split v targetSet) condition v wasFound && advancedContains condition ln lesser @@ -35,7 +40,7 @@ module SetTests = [] let ``Empty tree insertion`` () = - let resultSet = Empty |> AVLSet.add 15 + let resultSet = !! (Empty |> AVLSet.add 15) let correctSet = Node(0, 15, Empty, Empty) @@ -43,7 +48,7 @@ module SetTests = [] let ``Duplicate element insertion`` () = - let resultSet = Node(0, 15, Empty, Empty) |> AVLSet.add 15 + let resultSet = !! (Node(0, 15, Empty, Empty) |> AVLSet.add 15) let correctSet = Node(0, 15, Empty, Empty) @@ -51,7 +56,7 @@ module SetTests = [] let ``Insertion without rotation`` () = - let resultSet = Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.add 20 + let resultSet = !! (Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.add 20) let correctSet = Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) @@ -60,8 +65,8 @@ module SetTests = [] let ``Insertion with height update`` () = let resultSet = - Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Empty), Node(0, 20, Empty, Empty)) - |> AVLSet.add 13 + !! (Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Empty), Node(0, 20, Empty, Empty)) + |> AVLSet.add 13) let correctSet = Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Node(0, 13, Empty, Empty)), Node(0, 20, Empty, Empty)) @@ -70,7 +75,7 @@ module SetTests = [] let ``Left-Left rotation (RR case)`` () = - let resultSet = Node(1, 15, Empty, Node(0, 20, Empty, Empty)) |> AVLSet.add 25 + let resultSet = !! (Node(1, 15, Empty, Node(0, 20, Empty, Empty)) |> AVLSet.add 25) let correctSet = Node(1, 20, Node(0, 15, Empty, Empty), Node(0, 25, Empty, Empty)) @@ -79,8 +84,8 @@ module SetTests = [] let ``Right-Left rotation (RL case)`` () = let resultSet = - Node(2, 15, Node(0, 10, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) - |> AVLSet.add 27 + !! (Node(2, 15, Node(0, 10, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) + |> AVLSet.add 27) let correctSet = Node( @@ -95,8 +100,8 @@ module SetTests = [] let ``Left-Right rotation (LR case)`` () = let resultSet = - Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) - |> AVLSet.add 14 + !! (Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.add 14) let correctSet = Node( @@ -110,7 +115,7 @@ module SetTests = [] let ``Single-node deletion`` () = - let resultSet = Node(0, 15, Empty, Empty) |> AVLSet.delete 15 + let resultSet = !! (Node(0, 15, Empty, Empty) |> AVLSet.delete 15) let correctSet: AVLSet = Empty @@ -118,7 +123,7 @@ module SetTests = [] let ``Non-existent element deletion`` () = - let resultSet = Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.delete 20 + let resultSet = !! (Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.delete 20) let correctSet = Node(1, 15, Node(0, 10, Empty, Empty), Empty) @@ -127,8 +132,8 @@ module SetTests = [] let ``Leaf node deletion`` () = let resultSet = - Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) - |> AVLSet.delete 10 + !! (Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 10) let correctSet = Node(1, 15, Empty, Node(0, 20, Empty, Empty)) @@ -137,8 +142,8 @@ module SetTests = [] let ``Deletion with single rotation`` () = let resultSet = - Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) - |> AVLSet.delete 20 + !! (Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 20) let correctSet = Node(2, 10, Node(0, 6, Empty, Empty), Node(1, 15, Node(0, 12, Empty, Empty), Empty)) @@ -148,13 +153,13 @@ module SetTests = [] let ``Node deletion with one child`` () = let resultSet = - Node( + !! (Node( 2, 15, Node(1, 10, Empty, Node(0, 12, Empty, Empty)), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) ) - |> AVLSet.delete 10 + |> AVLSet.delete 10) let correctSet = Node(2, 15, Node(0, 12, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) @@ -164,13 +169,13 @@ module SetTests = [] let ``Root deletion with successor replacement`` () = let resultSet = - Node( + !! (Node( 2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) ) - |> AVLSet.delete 15 + |> AVLSet.delete 15) let correctSet = Node( @@ -185,8 +190,8 @@ module SetTests = [] let ``Deletion with cascading rebalance`` () = let resultSet = - Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) - |> AVLSet.delete 15 + !! (Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 15) let correctSet = Node(2, 10, Node(0, 6, Empty, Empty), Node(1, 20, Node(0, 12, Empty, Empty), Empty)) @@ -196,7 +201,7 @@ module SetTests = [] let ``Complex multi-level deletion`` () = let resultSet = - Node( + !! (Node( 3, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), @@ -207,7 +212,7 @@ module SetTests = Node(1, 30, Node(0, 27, Empty, Empty), Node(0, 33, Empty, Empty)) ) ) - |> AVLSet.delete 15 + |> AVLSet.delete 15) let correctSet = Node( @@ -221,7 +226,7 @@ module SetTests = [] let ``Adding elemements to set`` (elements: int list) = - let set = elements |> List.fold (fun t x -> AVLSet.add x t) AVLSet.empty + let set = elements |> List.fold (fun t x -> !! (AVLSet.add x t)) AVLSet.empty let rec setContainsList list set = match list with @@ -233,23 +238,23 @@ module SetTests = [] let ``Set cloning`` (elements: int list) = - let set = elements |> List.fold (fun t x -> AVLSet.add x t) AVLSet.empty + let set = elements |> List.fold (fun t x -> !! (AVLSet.add x t)) AVLSet.empty AVLSet.copy set |> should equal set [] let ``Deleting elements from set`` (elements: int list) = - let set = elements |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let emptySet = elements |> List.fold (fun t e -> AVLSet.delete e t) set + let set = elements |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let emptySet = elements |> List.fold (fun t e -> !! (AVLSet.delete e t)) set let empty: AVLSet = AVLSet.empty emptySet |> should equal empty [] let ``Standard set union`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let unionSet = AVLSet.union setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let unionSet = !! (AVLSet.union setA setB) isSetValid unionSet None None |> should be True @@ -257,7 +262,7 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - let unionSetSwapped = AVLSet.union setB setA + let unionSetSwapped = !! (AVLSet.union setB setA) (advancedContains (fun v x -> x) unionSet unionSetSwapped && advancedContains (fun v x -> x) unionSetSwapped unionSet) @@ -266,16 +271,16 @@ module SetTests = [] let ``Standard set intersection`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let intersectionSet = AVLSet.intersection setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let intersectionSet = !! (AVLSet.intersection setA setB) isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - let intersectionSetSwapped = AVLSet.intersection setB setA + let intersectionSetSwapped = !! (AVLSet.intersection setB setA) (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) @@ -283,9 +288,9 @@ module SetTests = [] let ``Standard set difference`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let differenceSet = AVLSet.difference setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let differenceSet = !! (AVLSet.difference setA setB) isSetValid differenceSet None None |> should be True @@ -294,9 +299,9 @@ module SetTests = [] let ``Standard symmetric difference`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let symmDiffSet = AVLSet.symmDifference setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let symmDiffSet = !! (AVLSet.symmDifference setA setB) isSetValid symmDiffSet None None |> should be True @@ -304,7 +309,7 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - let symmDiffSetSwapped = AVLSet.symmDifference setB setA + let symmDiffSetSwapped = !! (AVLSet.symmDifference setB setA) (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) @@ -312,9 +317,9 @@ module SetTests = [] let ``Union via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let unionSet = AVLSet.Traversal.union setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let unionSet = !! (AVLSet.Traversal.union setA setB) isSetValid unionSet None None |> should be True @@ -322,7 +327,7 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - let unionSetSwapped = AVLSet.union setB setA + let unionSetSwapped = !! (AVLSet.union setB setA) (advancedContains (fun v x -> x) unionSet unionSetSwapped && advancedContains (fun v x -> x) unionSetSwapped unionSet) @@ -330,16 +335,16 @@ module SetTests = [] let ``Intersection via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let intersectionSet = AVLSet.Traversal.intersection setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let intersectionSet = !! (AVLSet.Traversal.intersection setA setB) isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - let intersectionSetSwapped = AVLSet.intersection setB setA + let intersectionSetSwapped = !! (AVLSet.Traversal.intersection setB setA) (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) @@ -347,9 +352,9 @@ module SetTests = [] let ``Difference via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let differenceSet = AVLSet.Traversal.difference setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let differenceSet = !! (AVLSet.Traversal.difference setA setB) isSetValid differenceSet None None |> should be True @@ -358,9 +363,9 @@ module SetTests = [] let ``Symmetric difference via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let symmDiffSet = AVLSet.Traversal.symmDifference setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let symmDiffSet = !! (AVLSet.Traversal.symmDifference setA setB) isSetValid symmDiffSet None None |> should be True @@ -368,7 +373,7 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - let symmDiffSetSwapped = AVLSet.symmDifference setB setA + let symmDiffSetSwapped = !! (AVLSet.symmDifference setB setA) (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) @@ -376,9 +381,9 @@ module SetTests = [] let ``Parallel set union with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let unionSet = ParallelAVLSet.union None setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let unionSet = !! (ParallelAVLSet.union None setA setB) isSetValid unionSet None None |> should be True @@ -386,7 +391,7 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - let unionSetSwapped = AVLSet.union setB setA + let unionSetSwapped = !! (AVLSet.union setB setA) (advancedContains (fun v x -> x) unionSet unionSetSwapped && advancedContains (fun v x -> x) unionSetSwapped unionSet) @@ -394,16 +399,16 @@ module SetTests = [] let ``Parallel set intersection with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let intersectionSet = ParallelAVLSet.intersection None setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let intersectionSet = !! (ParallelAVLSet.intersection None setA setB) isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - let intersectionSetSwapped = AVLSet.intersection setB setA + let intersectionSetSwapped = !! (AVLSet.intersection setB setA) (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) @@ -411,9 +416,9 @@ module SetTests = [] let ``Parallel set difference with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let differenceSet = ParallelAVLSet.difference None setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let differenceSet = !! (ParallelAVLSet.difference None setA setB) isSetValid differenceSet None None |> should be True @@ -422,9 +427,9 @@ module SetTests = [] let ``Parallel set symmetric difference with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> AVLSet.add e t) AVLSet.empty - let symmDiffSet = ParallelAVLSet.symmDifference None setA setB + let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty + let symmDiffSet = !! (ParallelAVLSet.symmDifference None setA setB) isSetValid symmDiffSet None None |> should be True @@ -432,7 +437,7 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - let symmDiffSetSwapped = AVLSet.symmDifference setB setA + let symmDiffSetSwapped = !! (AVLSet.symmDifference setB setA) (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) diff --git a/QuadTree/AVLSet.fs b/QuadTree/AVLSet.fs index 655a741..cc16e41 100644 --- a/QuadTree/AVLSet.fs +++ b/QuadTree/AVLSet.fs @@ -1,9 +1,16 @@ namespace QuadTree.AVLSet +open Result + type AVLSet<'Value> = | Empty | Node of int * 'Value * AVLSet<'Value> * AVLSet<'Value> +type AVLSetError = + | RotationError + | InvalidHeightOfNode + | EmptyNodeWasNotExpected + module Tree = let height n = match n with @@ -20,29 +27,34 @@ module Tree = match n with | Node(_, vn, Node(_, vln, lln, rln), rn) -> let rlnNew = Node(max (height rln) (height rn) + 1, vn, rln, rn) - Node(max (height lln) (height rlnNew) + 1, vln, lln, rlnNew) - | _ -> invalidArg "n" "Node cannot be rotated" + Ok (Node(max (height lln) (height rlnNew) + 1, vln, lln, rlnNew)) + | _ -> Error RotationError let RRrotate n = match n with | Node(_, vn, ln, Node(_, vrn, lrn, rrn)) -> let lrnNew = Node(max (height ln) (height lrn) + 1, vn, ln, lrn) - Node(max (height lrnNew) (height rrn) + 1, vrn, lrnNew, rrn) - | _ -> invalidArg "n" "Node cannot be rotated" + Ok (Node(max (height lrnNew) (height rrn) + 1, vrn, lrnNew, rrn)) + | _ -> Error RotationError + let LRrotate n = - match n with - | Node(hn, vn, ln, rn) -> - let lnNew = RRrotate ln - LLrotate(Node(max (height lnNew) (height rn) + 1, vn, lnNew, rn)) - | _ -> invalidArg "n" "Node cannot be rotated" + resultM { + match n with + | Node(hn, vn, ln, rn) -> + let! lnNew = RRrotate ln + return! LLrotate(Node(max (height lnNew) (height rn) + 1, vn, lnNew, rn)) + | _ -> return! Error RotationError + } let RLrotate n = - match n with - | Node(hn, vn, ln, rn) -> - let rnNew = LLrotate rn - RRrotate(Node(max (height ln) (height rnNew) + 1, vn, ln, rnNew)) - | _ -> invalidArg "n" "Node cannot be rotated" + resultM { + match n with + | Node(hn, vn, ln, rn) -> + let! rnNew = LLrotate rn + return! RRrotate(Node(max (height ln) (height rnNew) + 1, vn, ln, rnNew)) + | _ -> return! Error RotationError + } let balance ln rn v = let lnHeight = height ln @@ -51,7 +63,7 @@ module Tree = if diff >= 2 then match ln with - | Empty -> invalidArg "rn" "left child is Empty but diff is lesser than 2" + | Empty -> Error InvalidHeightOfNode | Node(_, _, lln, rln) -> if height lln >= height rln then LLrotate(Node(0, v, ln, rn)) @@ -59,55 +71,59 @@ module Tree = LRrotate(Node(0, v, ln, rn)) elif diff <= -2 then match rn with - | Empty -> invalidArg "rn" "right child is Empty but diff is greater than -2" + | Empty -> Error InvalidHeightOfNode | Node(_, _, lrn, rrn) -> if height lrn <= height rrn then RRrotate(Node(0, v, ln, rn)) else RLrotate(Node(0, v, ln, rn)) else - Node(max lnHeight rnHeight + 1, v, ln, rn) + Ok (Node(max lnHeight rnHeight + 1, v, ln, rn)) let rec minNode n = - match n with - | Empty -> None - | Node(_, v, Empty, rn) -> Some(v, rn) - | Node(_, v, ln, rn) -> - match minNode ln with - | None -> None - | Some(value, lnNew) -> Some(value, balance lnNew rn v) + resultM { + match n with + | Empty -> return! Error EmptyNodeWasNotExpected + | Node(_, v, Empty, rn) -> return! Ok (v, rn) + | Node(_, v, ln, rn) -> + let! value, lnNew = minNode ln + let! balanceRes = balance lnNew rn v + return value, balanceRes + } let rec insert value n = - match n with - | Empty -> Node(0, value, Empty, Empty) - | Node(h, v, ln, rn) -> - if value = v then - n - elif value < v then - let lnNew = insert value ln - balance lnNew rn v - else - let rnNew = insert value rn - balance ln rnNew v + resultM { + match n with + | Empty -> return Node(0, value, Empty, Empty) + | Node(h, v, ln, rn) -> + if value = v then return n + elif value < v then + let! lnNew = insert value ln + return! balance lnNew rn v + else + let! rnNew = insert value rn + return! balance ln rnNew v + } let rec remove value n = - match n with - | Empty -> Empty - | Node(h, v, ln, rn) -> - if value = v then - match ln, rn with - | Empty, _ -> rn - | _, Empty -> ln - | _, _ -> - match minNode rn with - | None -> failwith "impossible error: rn is not Empty" - | Some(newValue, rnNew) -> balance ln rnNew newValue - elif value < v then - let lnNew = remove value ln - balance lnNew rn v - else - let rnNew = remove value rn - balance ln rnNew v + resultM { + match n with + | Empty -> return Empty + | Node(h, v, ln, rn) -> + if value = v then + match ln, rn with + | Empty, _ -> return rn + | _, Empty -> return ln + | _, _ -> + let! newValue, rnNew = minNode rn + return! balance ln rnNew newValue + elif value < v then + let! lnNew = remove value ln + return! balance lnNew rn v + else + let! rnNew = remove value rn + return! balance ln rnNew v + } [] let rec contains value n = @@ -125,6 +141,16 @@ module Tree = let newNArg = traverse func nArg ln let newNArg2 = func v newNArg traverse func newNArg2 rn + + let rec traverseRes (func: 'A -> AVLSet<'B> -> Result,AVLSetError>) nArg n = + resultM { + match n with + | Empty -> return nArg + | Node(_, v, ln, rn) -> + let! newNArg = traverseRes func nArg ln + let! newNArg2 = func v newNArg + return! traverseRes func newNArg2 rn + } let rec copy n = match n with @@ -136,42 +162,49 @@ module Tree = let rightHeight = height right let diff = leftHeight - rightHeight - if abs diff <= 1 then - Node(max leftHeight rightHeight + 1, key, left, right) - elif diff >= 2 then - match left with - | Empty -> invalidArg "right" "left child is Empty but diff is lesser than 2" - | Node(h, v, ln, rn) -> - let rnNew = join rn key right - balance ln rnNew v - else - match right with - | Empty -> invalidArg "left" "right child is Empty but diff is greater than -2" - | Node(h, v, ln, rn) -> - let lnNew = join left key ln - balance lnNew rn v + resultM { + if abs diff <= 1 then + return Node(max leftHeight rightHeight + 1, key, left, right) + elif diff >= 2 then + match left with + | Empty -> return! Error InvalidHeightOfNode + | Node(h, v, ln, rn) -> + let! rnNew = join rn key right + return! balance ln rnNew v + else + match right with + | Empty -> return! Error InvalidHeightOfNode + | Node(h, v, ln, rn) -> + let! lnNew = join left key ln + return! balance lnNew rn v + } let merge left right = - match left, right with - | Empty, _ -> right - | _, Empty -> left - | _, _ -> - match minNode right with - | None -> failwith "impossible error. right is not Empty" - | Some(key, newRight) -> join left key newRight + resultM { + match left, right with + | Empty, _ -> return right + | _, Empty -> return left + | _, _ -> + let! key, newRight = minNode right + return! join left key newRight + } let rec split key n = - match n with - | Empty -> Empty, Empty, false - | Node(_, v, ln, rn) -> - if key = v then - ln, rn, true - elif key < v then - let lesser, greater, wasFound = split key ln - lesser, join greater v rn, wasFound - else - let lesser, greater, wasFound = split key rn - join ln v lesser, greater, wasFound + resultM { + match n with + | Empty -> return Empty, Empty, false + | Node(_, v, ln, rn) -> + if key = v then + return ln, rn, true + elif key < v then + let! lesser, greater, wasFound = split key ln + let! joinRes = join greater v rn + return lesser, joinRes, wasFound + else + let! lesser, greater, wasFound = split key rn + let! joinRes = join ln v lesser + return joinRes, greater, wasFound + } module AVLSet = let empty = Empty @@ -187,88 +220,87 @@ module AVLSet = let rec union set1 set2 = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - match maxSet, minSet with - | Empty, _ -> minSet - | _, Empty -> maxSet - | Node(_, v, ln, rn), _ -> - let lesser, greater, _ = Tree.split v minSet - let leftUnion = union ln lesser - let rightUnion = union rn greater - Tree.join leftUnion v rightUnion + resultM { + match maxSet, minSet with + | Empty, _ -> return minSet + | _, Empty -> return maxSet + | Node(_, v, ln, rn), _ -> + let! lesser, greater, _ = Tree.split v minSet + let! leftUnion = union ln lesser + let! rightUnion = union rn greater + return! Tree.join leftUnion v rightUnion + } let rec intersection set1 set2 = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - match maxSet, minSet with - | Empty, _ -> Empty - | _, Empty -> Empty - | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v minSet - let leftInter = intersection ln lesser - let rightInter = intersection rn greater + resultM { + match maxSet, minSet with + | Empty, _ -> return Empty + | _, Empty -> return Empty + | Node(_, v, ln, rn), _ -> + let! lesser, greater, wasFound = Tree.split v minSet + let! leftInter = intersection ln lesser + let! rightInter = intersection rn greater - if wasFound then - Tree.join leftInter v rightInter - else - Tree.merge leftInter rightInter + return! if wasFound then Tree.join leftInter v rightInter else Tree.merge leftInter rightInter + } let rec difference minuendSet subtrahendSet = - match minuendSet, subtrahendSet with - | Empty, _ -> Empty - | _, Empty -> minuendSet - | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v subtrahendSet - let leftDiff = difference ln lesser - let rightDiff = difference rn greater - - if wasFound then - Tree.merge leftDiff rightDiff - else - Tree.join leftDiff v rightDiff + resultM { + match minuendSet, subtrahendSet with + | Empty, _ -> return Empty + | _, Empty -> return minuendSet + | Node(_, v, ln, rn), _ -> + let! lesser, greater, wasFound = Tree.split v subtrahendSet + let! leftDiff = difference ln lesser + let! rightDiff = difference rn greater + + return! if wasFound then Tree.merge leftDiff rightDiff else Tree.join leftDiff v rightDiff + } let rec symmDifference set1 set2 = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - match maxSet, minSet with - | Empty, _ -> minSet - | _, Empty -> maxSet - | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v minSet - let leftSymm = symmDifference ln lesser - let rightSymm = symmDifference rn greater + resultM { + match maxSet, minSet with + | Empty, _ -> return minSet + | _, Empty -> return maxSet + | Node(_, v, ln, rn), _ -> + let! lesser, greater, wasFound = Tree.split v minSet + let! leftSymm = symmDifference ln lesser + let! rightSymm = symmDifference rn greater - if wasFound then - Tree.merge leftSymm rightSymm - else - Tree.join leftSymm v rightSymm + return! if wasFound then Tree.merge leftSymm rightSymm else Tree.join leftSymm v rightSymm + } module Traversal = let union set1 set2 = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - let unSet = Tree.copy maxSet - Tree.traverse Tree.insert unSet minSet + let unSet = Tree.copy maxSet + Tree.traverseRes Tree.insert unSet minSet let intersection set1 set2 = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - Tree.traverse + Tree.traverseRes (fun value set -> if Tree.contains value maxSet then Tree.insert value set else - set) + Ok set) Empty minSet let difference minuendSet subtrahendSet = let diffSet = Tree.copy minuendSet - Tree.traverse Tree.remove diffSet subtrahendSet + Tree.traverseRes Tree.remove diffSet subtrahendSet let symmDifference set1 set2 = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 let symmSet = Tree.copy maxSet - Tree.traverse + Tree.traverseRes (fun value set -> if Tree.contains value maxSet then Tree.remove value set diff --git a/QuadTree/ParallelAVLSet.fs b/QuadTree/ParallelAVLSet.fs index c04fd98..b12b614 100644 --- a/QuadTree/ParallelAVLSet.fs +++ b/QuadTree/ParallelAVLSet.fs @@ -1,6 +1,7 @@ namespace QuadTree.AVLSet.Parallel open QuadTree.AVLSet +open Result /// /// Parallel union of two AVL sets. @@ -17,93 +18,133 @@ module ParallelAVLSet = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 match maxSet, minSet with - | Empty, _ -> return minSet - | _, Empty -> return maxSet + | Empty, _ -> return Ok minSet + | _, Empty -> return Ok maxSet | Node(_, v, ln, rn), _ -> - let lesser, greater, _ = Tree.split v minSet - let limit = defaultArg threads System.Environment.ProcessorCount - - let left = unionAsync threads ln lesser - let right = unionAsync threads rn greater - - let! results = Async.Parallel([| left; right |], limit) - let leftUnion, rightUnion = results[0], results[1] - - return Tree.join leftUnion v rightUnion + match Tree.split v minSet with + | Error err -> + return Error err + | Ok (lesser, greater, _) -> + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = unionAsync threads ln lesser + let right = unionAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + + let finalResult = resultM { + let! leftUnion = results[0] + let! rightUnion = results[1] + + return! Tree.join leftUnion v rightUnion + } + + return finalResult } let rec intersectionAsync threads set1 set2 = async { let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - + match maxSet, minSet with - | Empty, _ -> return Empty - | _, Empty -> return Empty + | Empty, _ -> return Ok Empty + | _, Empty -> return Ok Empty | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v minSet - - let limit = defaultArg threads System.Environment.ProcessorCount - - let left = intersectionAsync threads ln lesser - let right = intersectionAsync threads rn greater - - let! results = Async.Parallel([| left; right |], limit) - let leftInter, rightInter = results[0], results[1] - return - if wasFound then - Tree.join leftInter v rightInter - else - Tree.merge leftInter rightInter + match Tree.split v minSet with + | Error err -> + return Error err + | Ok (lesser, greater, wasFound) -> + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = intersectionAsync threads ln lesser + let right = intersectionAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + + let finalResult = resultM { + let! leftInter = results[0] + let! rightInter = results[1] + + return! + if wasFound then + Tree.join leftInter v rightInter + else + Tree.merge leftInter rightInter + } + + return finalResult } let rec differenceAsync threads minuendSet subtrahendSet = async { match minuendSet, subtrahendSet with - | Empty, _ -> return Empty - | _, Empty -> return minuendSet + | Empty, _ -> return Ok Empty + | _, Empty -> return Ok minuendSet | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v subtrahendSet - let limit = defaultArg threads System.Environment.ProcessorCount - - let left = differenceAsync threads ln lesser - let right = differenceAsync threads rn greater - - let! results = Async.Parallel([| left; right |], limit) - let leftDiff, rightDiff = results[0], results[1] - - return - if wasFound then - Tree.merge leftDiff rightDiff - else - Tree.join leftDiff v rightDiff + match Tree.split v subtrahendSet with + | Error err -> + return Error err + | Ok (lesser, greater, wasFound) -> + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = differenceAsync threads ln lesser + let right = differenceAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + + let finalResult = resultM { + let! leftDiff = results[0] + let! rightDiff = results[1] + + return! + if wasFound then + Tree.merge leftDiff rightDiff + else + Tree.join leftDiff v rightDiff + } + + return finalResult } let rec symmDifferenceAsync threads set1 set2 = async { let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - + match maxSet, minSet with - | Empty, _ -> return minSet - | _, Empty -> return maxSet + | Empty, _ -> return Ok minSet + | _, Empty -> return Ok maxSet | Node(_, v, ln, rn), _ -> - let lesser, greater, wasFound = Tree.split v minSet - - let limit = defaultArg threads System.Environment.ProcessorCount - - let left = symmDifferenceAsync threads ln lesser - let right = symmDifferenceAsync threads rn greater - - let! results = Async.Parallel([| left; right |], limit) - let leftSymm, rightSymm = results[0], results[1] - return - if wasFound then - Tree.merge leftSymm rightSymm - else - Tree.join leftSymm v rightSymm + match Tree.split v minSet with + | Error err -> + return Error err + | Ok (lesser, greater, wasFound) -> + + let limit = defaultArg threads System.Environment.ProcessorCount + + let left = symmDifferenceAsync threads ln lesser + let right = symmDifferenceAsync threads rn greater + + let! results = Async.Parallel([| left; right |], limit) + + let finalResult = resultM { + let! leftSymm = results[0] + let! rightSymm = results[1] + + return! + if wasFound then + Tree.merge leftSymm rightSymm + else + Tree.join leftSymm v rightSymm + } + + return finalResult } let union threads t1 t2 = diff --git a/QuadTree/QuadTree.fsproj b/QuadTree/QuadTree.fsproj index 28e7916..1509c26 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -15,7 +15,7 @@ - + From bcaceaed7fb6e11c1dbea252aff1941e48e96333 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Tue, 19 May 2026 23:29:56 +0300 Subject: [PATCH 06/10] format files --- QuadTree.Benchmark/AVLSet.fs | 28 +++--- QuadTree.Tests/Tests.AVLSet.fs | 157 +++++++++++++++++---------------- QuadTree/AVLSet.fs | 39 +++++--- QuadTree/ParallelAVLSet.fs | 124 +++++++++++++------------- 4 files changed, 184 insertions(+), 164 deletions(-) diff --git a/QuadTree.Benchmark/AVLSet.fs b/QuadTree.Benchmark/AVLSet.fs index fb27827..aa3b17a 100644 --- a/QuadTree.Benchmark/AVLSet.fs +++ b/QuadTree.Benchmark/AVLSet.fs @@ -49,17 +49,23 @@ type Benchmark() = let dataB = Array.init self.B (fun _ -> rnd.Next()) - self.setA <- dataA |> Array.fold (fun (set: AVLSet) v -> - match AVLSet.add v set with - | Ok nextSet -> nextSet - | Error err -> failwithf "Benchmark setup failed: %A" err - ) AVLSet.empty - - self.setB <- dataB |> Array.fold (fun (set: AVLSet) v -> - match AVLSet.add v set with - | Ok nextSet -> nextSet - | Error err -> failwithf "Benchmark setup failed: %A" err - ) AVLSet.empty + self.setA <- + dataA + |> Array.fold + (fun (set: AVLSet) v -> + match AVLSet.add v set with + | Ok nextSet -> nextSet + | Error err -> failwithf "Benchmark setup failed: %A" err) + AVLSet.empty + + self.setB <- + dataB + |> Array.fold + (fun (set: AVLSet) v -> + match AVLSet.add v set with + | Ok nextSet -> nextSet + | Error err -> failwithf "Benchmark setup failed: %A" err) + AVLSet.empty [] [] diff --git a/QuadTree.Tests/Tests.AVLSet.fs b/QuadTree.Tests/Tests.AVLSet.fs index e5fbb7e..593279e 100644 --- a/QuadTree.Tests/Tests.AVLSet.fs +++ b/QuadTree.Tests/Tests.AVLSet.fs @@ -23,7 +23,7 @@ module SetTests = && isSetValid ln mn (Some v) && isSetValid rn (Some v) mx - let (!!) result = + let (!!) result = match result with | Ok v -> v | Error e -> failwithf "Test infrastructure failure. Expected Ok, got: %A" e @@ -32,7 +32,7 @@ module SetTests = match setOfValues with | Empty -> true | Node(_, v, ln, rn) -> - let lesser, greater, wasFound = !! (Tree.split v targetSet) + let lesser, greater, wasFound = !!(Tree.split v targetSet) condition v wasFound && advancedContains condition ln lesser @@ -40,7 +40,7 @@ module SetTests = [] let ``Empty tree insertion`` () = - let resultSet = !! (Empty |> AVLSet.add 15) + let resultSet = !!(Empty |> AVLSet.add 15) let correctSet = Node(0, 15, Empty, Empty) @@ -48,7 +48,7 @@ module SetTests = [] let ``Duplicate element insertion`` () = - let resultSet = !! (Node(0, 15, Empty, Empty) |> AVLSet.add 15) + let resultSet = !!(Node(0, 15, Empty, Empty) |> AVLSet.add 15) let correctSet = Node(0, 15, Empty, Empty) @@ -56,7 +56,7 @@ module SetTests = [] let ``Insertion without rotation`` () = - let resultSet = !! (Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.add 20) + let resultSet = !!(Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.add 20) let correctSet = Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) @@ -65,8 +65,8 @@ module SetTests = [] let ``Insertion with height update`` () = let resultSet = - !! (Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Empty), Node(0, 20, Empty, Empty)) - |> AVLSet.add 13) + !!(Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Empty), Node(0, 20, Empty, Empty)) + |> AVLSet.add 13) let correctSet = Node(2, 15, Node(1, 10, Node(0, 7, Empty, Empty), Node(0, 13, Empty, Empty)), Node(0, 20, Empty, Empty)) @@ -75,7 +75,7 @@ module SetTests = [] let ``Left-Left rotation (RR case)`` () = - let resultSet = !! (Node(1, 15, Empty, Node(0, 20, Empty, Empty)) |> AVLSet.add 25) + let resultSet = !!(Node(1, 15, Empty, Node(0, 20, Empty, Empty)) |> AVLSet.add 25) let correctSet = Node(1, 20, Node(0, 15, Empty, Empty), Node(0, 25, Empty, Empty)) @@ -84,8 +84,8 @@ module SetTests = [] let ``Right-Left rotation (RL case)`` () = let resultSet = - !! (Node(2, 15, Node(0, 10, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) - |> AVLSet.add 27) + !!(Node(2, 15, Node(0, 10, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) + |> AVLSet.add 27) let correctSet = Node( @@ -100,8 +100,8 @@ module SetTests = [] let ``Left-Right rotation (LR case)`` () = let resultSet = - !! (Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) - |> AVLSet.add 14) + !!(Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.add 14) let correctSet = Node( @@ -115,7 +115,7 @@ module SetTests = [] let ``Single-node deletion`` () = - let resultSet = !! (Node(0, 15, Empty, Empty) |> AVLSet.delete 15) + let resultSet = !!(Node(0, 15, Empty, Empty) |> AVLSet.delete 15) let correctSet: AVLSet = Empty @@ -123,7 +123,8 @@ module SetTests = [] let ``Non-existent element deletion`` () = - let resultSet = !! (Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.delete 20) + let resultSet = + !!(Node(1, 15, Node(0, 10, Empty, Empty), Empty) |> AVLSet.delete 20) let correctSet = Node(1, 15, Node(0, 10, Empty, Empty), Empty) @@ -132,8 +133,8 @@ module SetTests = [] let ``Leaf node deletion`` () = let resultSet = - !! (Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) - |> AVLSet.delete 10) + !!(Node(1, 15, Node(0, 10, Empty, Empty), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 10) let correctSet = Node(1, 15, Empty, Node(0, 20, Empty, Empty)) @@ -142,8 +143,8 @@ module SetTests = [] let ``Deletion with single rotation`` () = let resultSet = - !! (Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) - |> AVLSet.delete 20) + !!(Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 20) let correctSet = Node(2, 10, Node(0, 6, Empty, Empty), Node(1, 15, Node(0, 12, Empty, Empty), Empty)) @@ -153,13 +154,13 @@ module SetTests = [] let ``Node deletion with one child`` () = let resultSet = - !! (Node( + !!(Node( 2, 15, Node(1, 10, Empty, Node(0, 12, Empty, Empty)), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) - ) - |> AVLSet.delete 10) + ) + |> AVLSet.delete 10) let correctSet = Node(2, 15, Node(0, 12, Empty, Empty), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty))) @@ -169,13 +170,13 @@ module SetTests = [] let ``Root deletion with successor replacement`` () = let resultSet = - !! (Node( + !!(Node( 2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(1, 20, Node(0, 16, Empty, Empty), Node(0, 24, Empty, Empty)) - ) - |> AVLSet.delete 15) + ) + |> AVLSet.delete 15) let correctSet = Node( @@ -190,8 +191,8 @@ module SetTests = [] let ``Deletion with cascading rebalance`` () = let resultSet = - !! (Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) - |> AVLSet.delete 15) + !!(Node(2, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), Node(0, 20, Empty, Empty)) + |> AVLSet.delete 15) let correctSet = Node(2, 10, Node(0, 6, Empty, Empty), Node(1, 20, Node(0, 12, Empty, Empty), Empty)) @@ -201,7 +202,7 @@ module SetTests = [] let ``Complex multi-level deletion`` () = let resultSet = - !! (Node( + !!(Node( 3, 15, Node(1, 10, Node(0, 6, Empty, Empty), Node(0, 12, Empty, Empty)), @@ -211,8 +212,8 @@ module SetTests = Node(0, 20, Empty, Empty), Node(1, 30, Node(0, 27, Empty, Empty), Node(0, 33, Empty, Empty)) ) - ) - |> AVLSet.delete 15) + ) + |> AVLSet.delete 15) let correctSet = Node( @@ -226,7 +227,7 @@ module SetTests = [] let ``Adding elemements to set`` (elements: int list) = - let set = elements |> List.fold (fun t x -> !! (AVLSet.add x t)) AVLSet.empty + let set = elements |> List.fold (fun t x -> !!(AVLSet.add x t)) AVLSet.empty let rec setContainsList list set = match list with @@ -238,23 +239,23 @@ module SetTests = [] let ``Set cloning`` (elements: int list) = - let set = elements |> List.fold (fun t x -> !! (AVLSet.add x t)) AVLSet.empty + let set = elements |> List.fold (fun t x -> !!(AVLSet.add x t)) AVLSet.empty AVLSet.copy set |> should equal set [] let ``Deleting elements from set`` (elements: int list) = - let set = elements |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let emptySet = elements |> List.fold (fun t e -> !! (AVLSet.delete e t)) set + let set = elements |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let emptySet = elements |> List.fold (fun t e -> !!(AVLSet.delete e t)) set let empty: AVLSet = AVLSet.empty emptySet |> should equal empty [] let ``Standard set union`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let unionSet = !! (AVLSet.union setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let unionSet = !!(AVLSet.union setA setB) isSetValid unionSet None None |> should be True @@ -262,7 +263,7 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - let unionSetSwapped = !! (AVLSet.union setB setA) + let unionSetSwapped = !!(AVLSet.union setB setA) (advancedContains (fun v x -> x) unionSet unionSetSwapped && advancedContains (fun v x -> x) unionSetSwapped unionSet) @@ -271,16 +272,16 @@ module SetTests = [] let ``Standard set intersection`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let intersectionSet = !! (AVLSet.intersection setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let intersectionSet = !!(AVLSet.intersection setA setB) isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - let intersectionSetSwapped = !! (AVLSet.intersection setB setA) + let intersectionSetSwapped = !!(AVLSet.intersection setB setA) (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) @@ -288,9 +289,9 @@ module SetTests = [] let ``Standard set difference`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let differenceSet = !! (AVLSet.difference setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let differenceSet = !!(AVLSet.difference setA setB) isSetValid differenceSet None None |> should be True @@ -299,9 +300,9 @@ module SetTests = [] let ``Standard symmetric difference`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let symmDiffSet = !! (AVLSet.symmDifference setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let symmDiffSet = !!(AVLSet.symmDifference setA setB) isSetValid symmDiffSet None None |> should be True @@ -309,7 +310,7 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - let symmDiffSetSwapped = !! (AVLSet.symmDifference setB setA) + let symmDiffSetSwapped = !!(AVLSet.symmDifference setB setA) (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) @@ -317,9 +318,9 @@ module SetTests = [] let ``Union via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let unionSet = !! (AVLSet.Traversal.union setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let unionSet = !!(AVLSet.Traversal.union setA setB) isSetValid unionSet None None |> should be True @@ -327,7 +328,7 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - let unionSetSwapped = !! (AVLSet.union setB setA) + let unionSetSwapped = !!(AVLSet.union setB setA) (advancedContains (fun v x -> x) unionSet unionSetSwapped && advancedContains (fun v x -> x) unionSetSwapped unionSet) @@ -335,16 +336,16 @@ module SetTests = [] let ``Intersection via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let intersectionSet = !! (AVLSet.Traversal.intersection setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let intersectionSet = !!(AVLSet.Traversal.intersection setA setB) isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - let intersectionSetSwapped = !! (AVLSet.Traversal.intersection setB setA) + let intersectionSetSwapped = !!(AVLSet.Traversal.intersection setB setA) (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) @@ -352,9 +353,9 @@ module SetTests = [] let ``Difference via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let differenceSet = !! (AVLSet.Traversal.difference setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let differenceSet = !!(AVLSet.Traversal.difference setA setB) isSetValid differenceSet None None |> should be True @@ -363,9 +364,9 @@ module SetTests = [] let ``Symmetric difference via tree traversal`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let symmDiffSet = !! (AVLSet.Traversal.symmDifference setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let symmDiffSet = !!(AVLSet.Traversal.symmDifference setA setB) isSetValid symmDiffSet None None |> should be True @@ -373,7 +374,7 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - let symmDiffSetSwapped = !! (AVLSet.symmDifference setB setA) + let symmDiffSetSwapped = !!(AVLSet.symmDifference setB setA) (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) @@ -381,9 +382,9 @@ module SetTests = [] let ``Parallel set union with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let unionSet = !! (ParallelAVLSet.union None setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let unionSet = !!(ParallelAVLSet.union None setA setB) isSetValid unionSet None None |> should be True @@ -391,7 +392,7 @@ module SetTests = && advancedContains (fun v x -> x) setB unionSet) |> should be True - let unionSetSwapped = !! (AVLSet.union setB setA) + let unionSetSwapped = !!(AVLSet.union setB setA) (advancedContains (fun v x -> x) unionSet unionSetSwapped && advancedContains (fun v x -> x) unionSetSwapped unionSet) @@ -399,16 +400,16 @@ module SetTests = [] let ``Parallel set intersection with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let intersectionSet = !! (ParallelAVLSet.intersection None setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let intersectionSet = !!(ParallelAVLSet.intersection None setA setB) isSetValid intersectionSet None None |> should be True advancedContains (fun v x -> if AVLSet.contains v setB then x else not x) setA intersectionSet |> should be True - let intersectionSetSwapped = !! (AVLSet.intersection setB setA) + let intersectionSetSwapped = !!(AVLSet.intersection setB setA) (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) @@ -416,9 +417,9 @@ module SetTests = [] let ``Parallel set difference with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let differenceSet = !! (ParallelAVLSet.difference None setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let differenceSet = !!(ParallelAVLSet.difference None setA setB) isSetValid differenceSet None None |> should be True @@ -427,9 +428,9 @@ module SetTests = [] let ``Parallel set symmetric difference with threads`` (elementsA: int list, elementsB: int list) = - let setA = elementsA |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let setB = elementsB |> List.fold (fun t e -> !! (AVLSet.add e t)) AVLSet.empty - let symmDiffSet = !! (ParallelAVLSet.symmDifference None setA setB) + let setA = elementsA |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let setB = elementsB |> List.fold (fun t e -> !!(AVLSet.add e t)) AVLSet.empty + let symmDiffSet = !!(ParallelAVLSet.symmDifference None setA setB) isSetValid symmDiffSet None None |> should be True @@ -437,7 +438,7 @@ module SetTests = && advancedContains (fun v x -> if AVLSet.contains v setA then not x else x) setB symmDiffSet) |> should be True - let symmDiffSetSwapped = !! (AVLSet.symmDifference setB setA) + let symmDiffSetSwapped = !!(AVLSet.symmDifference setB setA) (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) diff --git a/QuadTree/AVLSet.fs b/QuadTree/AVLSet.fs index cc16e41..407e2b7 100644 --- a/QuadTree/AVLSet.fs +++ b/QuadTree/AVLSet.fs @@ -6,7 +6,7 @@ type AVLSet<'Value> = | Empty | Node of int * 'Value * AVLSet<'Value> * AVLSet<'Value> -type AVLSetError = +type AVLSetError = | RotationError | InvalidHeightOfNode | EmptyNodeWasNotExpected @@ -27,14 +27,14 @@ module Tree = match n with | Node(_, vn, Node(_, vln, lln, rln), rn) -> let rlnNew = Node(max (height rln) (height rn) + 1, vn, rln, rn) - Ok (Node(max (height lln) (height rlnNew) + 1, vln, lln, rlnNew)) + Ok(Node(max (height lln) (height rlnNew) + 1, vln, lln, rlnNew)) | _ -> Error RotationError let RRrotate n = match n with | Node(_, vn, ln, Node(_, vrn, lrn, rrn)) -> let lrnNew = Node(max (height ln) (height lrn) + 1, vn, ln, lrn) - Ok (Node(max (height lrnNew) (height rrn) + 1, vrn, lrnNew, rrn)) + Ok(Node(max (height lrnNew) (height rrn) + 1, vrn, lrnNew, rrn)) | _ -> Error RotationError @@ -78,14 +78,14 @@ module Tree = else RLrotate(Node(0, v, ln, rn)) else - Ok (Node(max lnHeight rnHeight + 1, v, ln, rn)) + Ok(Node(max lnHeight rnHeight + 1, v, ln, rn)) let rec minNode n = resultM { match n with | Empty -> return! Error EmptyNodeWasNotExpected - | Node(_, v, Empty, rn) -> return! Ok (v, rn) - | Node(_, v, ln, rn) -> + | Node(_, v, Empty, rn) -> return! Ok(v, rn) + | Node(_, v, ln, rn) -> let! value, lnNew = minNode ln let! balanceRes = balance lnNew rn v return value, balanceRes @@ -96,7 +96,8 @@ module Tree = match n with | Empty -> return Node(0, value, Empty, Empty) | Node(h, v, ln, rn) -> - if value = v then return n + if value = v then + return n elif value < v then let! lnNew = insert value ln return! balance lnNew rn v @@ -141,8 +142,8 @@ module Tree = let newNArg = traverse func nArg ln let newNArg2 = func v newNArg traverse func newNArg2 rn - - let rec traverseRes (func: 'A -> AVLSet<'B> -> Result,AVLSetError>) nArg n = + + let rec traverseRes (func: 'A -> AVLSet<'B> -> Result, AVLSetError>) nArg n = resultM { match n with | Empty -> return nArg @@ -243,7 +244,11 @@ module AVLSet = let! leftInter = intersection ln lesser let! rightInter = intersection rn greater - return! if wasFound then Tree.join leftInter v rightInter else Tree.merge leftInter rightInter + return! + if wasFound then + Tree.join leftInter v rightInter + else + Tree.merge leftInter rightInter } let rec difference minuendSet subtrahendSet = @@ -256,7 +261,11 @@ module AVLSet = let! leftDiff = difference ln lesser let! rightDiff = difference rn greater - return! if wasFound then Tree.merge leftDiff rightDiff else Tree.join leftDiff v rightDiff + return! + if wasFound then + Tree.merge leftDiff rightDiff + else + Tree.join leftDiff v rightDiff } let rec symmDifference set1 set2 = @@ -271,13 +280,17 @@ module AVLSet = let! leftSymm = symmDifference ln lesser let! rightSymm = symmDifference rn greater - return! if wasFound then Tree.merge leftSymm rightSymm else Tree.join leftSymm v rightSymm + return! + if wasFound then + Tree.merge leftSymm rightSymm + else + Tree.join leftSymm v rightSymm } module Traversal = let union set1 set2 = let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - let unSet = Tree.copy maxSet + let unSet = Tree.copy maxSet Tree.traverseRes Tree.insert unSet minSet let intersection set1 set2 = diff --git a/QuadTree/ParallelAVLSet.fs b/QuadTree/ParallelAVLSet.fs index b12b614..a0026b3 100644 --- a/QuadTree/ParallelAVLSet.fs +++ b/QuadTree/ParallelAVLSet.fs @@ -23,59 +23,59 @@ module ParallelAVLSet = | Node(_, v, ln, rn), _ -> match Tree.split v minSet with - | Error err -> - return Error err - | Ok (lesser, greater, _) -> - + | Error err -> return Error err + | Ok(lesser, greater, _) -> + let limit = defaultArg threads System.Environment.ProcessorCount let left = unionAsync threads ln lesser let right = unionAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) - - let finalResult = resultM { - let! leftUnion = results[0] - let! rightUnion = results[1] - - return! Tree.join leftUnion v rightUnion - } - + + let finalResult = + resultM { + let! leftUnion = results[0] + let! rightUnion = results[1] + + return! Tree.join leftUnion v rightUnion + } + return finalResult } let rec intersectionAsync threads set1 set2 = async { let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - + match maxSet, minSet with | Empty, _ -> return Ok Empty | _, Empty -> return Ok Empty | Node(_, v, ln, rn), _ -> match Tree.split v minSet with - | Error err -> - return Error err - | Ok (lesser, greater, wasFound) -> - + | Error err -> return Error err + | Ok(lesser, greater, wasFound) -> + let limit = defaultArg threads System.Environment.ProcessorCount let left = intersectionAsync threads ln lesser let right = intersectionAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) - - let finalResult = resultM { - let! leftInter = results[0] - let! rightInter = results[1] - - return! - if wasFound then - Tree.join leftInter v rightInter - else - Tree.merge leftInter rightInter - } - + + let finalResult = + resultM { + let! leftInter = results[0] + let! rightInter = results[1] + + return! + if wasFound then + Tree.join leftInter v rightInter + else + Tree.merge leftInter rightInter + } + return finalResult } @@ -87,63 +87,63 @@ module ParallelAVLSet = | Node(_, v, ln, rn), _ -> match Tree.split v subtrahendSet with - | Error err -> - return Error err - | Ok (lesser, greater, wasFound) -> - + | Error err -> return Error err + | Ok(lesser, greater, wasFound) -> + let limit = defaultArg threads System.Environment.ProcessorCount let left = differenceAsync threads ln lesser let right = differenceAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) - - let finalResult = resultM { - let! leftDiff = results[0] - let! rightDiff = results[1] - - return! - if wasFound then - Tree.merge leftDiff rightDiff - else - Tree.join leftDiff v rightDiff - } - + + let finalResult = + resultM { + let! leftDiff = results[0] + let! rightDiff = results[1] + + return! + if wasFound then + Tree.merge leftDiff rightDiff + else + Tree.join leftDiff v rightDiff + } + return finalResult } let rec symmDifferenceAsync threads set1 set2 = async { let maxSet, minSet = Tree.maxMinNodesByHeights set1 set2 - + match maxSet, minSet with | Empty, _ -> return Ok minSet | _, Empty -> return Ok maxSet | Node(_, v, ln, rn), _ -> match Tree.split v minSet with - | Error err -> - return Error err - | Ok (lesser, greater, wasFound) -> - + | Error err -> return Error err + | Ok(lesser, greater, wasFound) -> + let limit = defaultArg threads System.Environment.ProcessorCount let left = symmDifferenceAsync threads ln lesser let right = symmDifferenceAsync threads rn greater let! results = Async.Parallel([| left; right |], limit) - - let finalResult = resultM { - let! leftSymm = results[0] - let! rightSymm = results[1] - - return! - if wasFound then - Tree.merge leftSymm rightSymm - else - Tree.join leftSymm v rightSymm - } - + + let finalResult = + resultM { + let! leftSymm = results[0] + let! rightSymm = results[1] + + return! + if wasFound then + Tree.merge leftSymm rightSymm + else + Tree.join leftSymm v rightSymm + } + return finalResult } From f70610527d51a06bf82906f7800288b3343707a5 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Wed, 27 May 2026 14:43:38 +0300 Subject: [PATCH 07/10] add info to README and improve benchmarks --- QuadTree.Benchmark/AVLSet.fs | 167 +++++++++++++++++++++++++---------- QuadTree.Benchmark/Main.fs | 4 +- QuadTree.Benchmark/README.md | 26 +++++- README.md | 1 + 4 files changed, 148 insertions(+), 50 deletions(-) diff --git a/QuadTree.Benchmark/AVLSet.fs b/QuadTree.Benchmark/AVLSet.fs index aa3b17a..37d08a9 100644 --- a/QuadTree.Benchmark/AVLSet.fs +++ b/QuadTree.Benchmark/AVLSet.fs @@ -9,28 +9,58 @@ open QuadTree.AVLSet.Parallel [] [] [] -[] -type Benchmark() = +type SingleOpsBenchmark() = let rnd = System.Random(1234561) - [] + [] [] val mutable public A: int - [] [] - val mutable public B: int + val mutable public rndInt: int - [] [] - val mutable public DataTypeA: string + val mutable public setA: AVLSet + + [] + member self.Setup() = + self.rndInt <- rnd.Next(self.A + 1, self.A + 1000) + + let dataA = + Array.init self.A (fun _ -> rnd.Next()) + + self.setA <- + dataA + |> Array.fold + (fun (set: AVLSet) v -> + match AVLSet.add v set with + | Ok nextSet -> nextSet + | Error err -> failwithf "Benchmark setup failed: %A" err) + AVLSet.empty + + [] + [] + member self.AddingOneElement() = AVLSet.add self.rndInt self.setA + + [] + [] + member self.DeletingOneElement() = AVLSet.delete self.rndInt self.setA + + +[] +[] +[] +[] +type SequentialSetsBenchmark() = + let rnd = System.Random(1234561) - [] + [] [] - val mutable public threads: int + val mutable public A: int + [] [] - val mutable public rndInt: int + val mutable public B: int [] val mutable public setA: AVLSet @@ -40,12 +70,8 @@ type Benchmark() = [] member self.Setup() = - self.rndInt <- rnd.Next(self.A + 1, self.A + 1000) - let dataA = - match self.DataTypeA with - | "Random" -> Array.init self.A (fun _ -> rnd.Next()) - | _ -> [| 1 .. self.A |] + Array.init self.A (fun _ -> rnd.Next()) let dataB = Array.init self.B (fun _ -> rnd.Next()) @@ -67,67 +93,112 @@ type Benchmark() = | Error err -> failwithf "Benchmark setup failed: %A" err) AVLSet.empty - [] - [] - member self.``Adding one element``() = AVLSet.add self.rndInt self.setA - - [] - [] - member self.``Deleting one element``() = AVLSet.delete self.rndInt self.setA - [] [] - member self.``Sequential union``() = AVLSet.union self.setA self.setB + member self.SequentialUnion() = AVLSet.union self.setA self.setB [] [] - member self.``Union via tree traversal``() = + member self.UnionViaTreeTraversal() = AVLSet.Traversal.union self.setA self.setB - [] - [] - member self.``Parallel union with threads``() = - ParallelAVLSet.union (Some self.threads) self.setA self.setB - [] [] - member self.``Sequential intersection``() = AVLSet.intersection self.setA self.setB + member self.SequentialIntersection() = AVLSet.intersection self.setA self.setB [] [] - member self.``Intersection via tree traversal``() = + member self.IntersectionViaTreeTraversal() = AVLSet.Traversal.intersection self.setA self.setB - [] - [] - member self.``Parallel intersection with threads``() = - ParallelAVLSet.intersection (Some self.threads) self.setA self.setB - [] [] - member self.``Sequential difference``() = AVLSet.difference self.setA self.setB + member self.SequentialDifference() = AVLSet.difference self.setA self.setB [] [] - member self.``Difference via tree traversal``() = + member self.DifferenceViaTreeTraversal() = AVLSet.Traversal.difference self.setA self.setB - [] - [] - member self.``Parallel difference with threads``() = - ParallelAVLSet.difference (Some self.threads) self.setA self.setB - [] [] - member self.``Sequential symmetric difference``() = + member self.SequentialSymmetricalDifference() = AVLSet.symmDifference self.setA self.setB [] [] - member self.``Symmetric difference via tree traversal``() = + member self.SymmetricalDifferenceViaTreeTraversal() = AVLSet.Traversal.symmDifference self.setA self.setB + +[] +[] +[] +[] +[] +[] +type ParallelSetsBenchmark() = + let rnd = System.Random(1234561) + + [] + [] + val mutable public A: int + + [] + [] + val mutable public B: int + + [] + [] + val mutable public threads: int + + [] + val mutable public setA: AVLSet + + [] + val mutable public setB: AVLSet + + [] + member self.Setup() = + let dataA = + Array.init self.A (fun _ -> rnd.Next()) + + let dataB = Array.init self.B (fun _ -> rnd.Next()) + + self.setA <- + dataA |> Array.fold (fun set v -> match AVLSet.add v set with | Ok s -> s | Error e -> failwithf "%A" e) AVLSet.empty + self.setB <- + dataB |> Array.fold (fun set v -> match AVLSet.add v set with | Ok s -> s | Error e -> failwithf "%A" e) AVLSet.empty + + + [] + [] + member self.SequentialUnion() = AVLSet.union self.setA self.setB + + [] + [] + member self.ParallelUnionWithThreads() = ParallelAVLSet.union (Some self.threads) self.setA self.setB + + [] + [] + member self.SequentialIntersection() = AVLSet.intersection self.setA self.setB + + [] + [] + member self.ParallelIntersectionWithThreads() = ParallelAVLSet.intersection (Some self.threads) self.setA self.setB + + [] + [] + member self.SequentialDifference() = AVLSet.difference self.setA self.setB + + [] + [] + member self.ParallelDifferenceWithThreads() = ParallelAVLSet.difference (Some self.threads) self.setA self.setB + + [] + [] + member self.SequentialSymmetricalDifference() = AVLSet.symmDifference self.setA self.setB + [] [] - member self.``Parallel symmetric difference with threads``() = - ParallelAVLSet.symmDifference (Some self.threads) self.setA self.setB + member self.ParallelSymmetricalDifferenceWithThreads() = ParallelAVLSet.symmDifference (Some self.threads) self.setA self.setB diff --git a/QuadTree.Benchmark/Main.fs b/QuadTree.Benchmark/Main.fs index 9ea4962..d1fd934 100644 --- a/QuadTree.Benchmark/Main.fs +++ b/QuadTree.Benchmark/Main.fs @@ -7,7 +7,9 @@ let main argv = [| typeof typeof typeof - typeof |] + typeof + typeof + typeof |] benchmarks.Run argv |> ignore 0 diff --git a/QuadTree.Benchmark/README.md b/QuadTree.Benchmark/README.md index 0b1b0d5..5594dbe 100644 --- a/QuadTree.Benchmark/README.md +++ b/QuadTree.Benchmark/README.md @@ -4,6 +4,7 @@ Benchmarking infrastructure for * [BFS](BFS.fs) * [SSSP](SSSP.fs) * [Triangles counting](Triangles.fs) +* [AVLSet](AVLSet.fs) ## Steps to run @@ -15,4 +16,27 @@ Benchmarking infrastructure for ``` 3. Ensure the matrix reader is correctly configured. In ```LoadMatrix ()``` , you can pass a boolean flag to ```readMtx``` indicating whether the matrix should be treated as a directed or undirected graph. Current configuration: undirected for all ```BFS```, ```SSSP``` and ```Triangles counting```. 4. Run evaluation: ```dotnet run -c Release -- --filter '*.SSSP.*'``` You can use ```--filter``` to specify particular benchmarks. Use ```--filter '*'``` to run all available benchmarks. -5. Raw benchmarking results are saved in ```BenchmarkDotNet.Artifacts/results/*.csv```. \ No newline at end of file +5. Raw benchmarking results are saved in ```BenchmarkDotNet.Artifacts/results/*.csv```. + +### AVLSet + +Benchmarking the `AVLSet` data structure operations. + +**Tested operations:** +- `Adding` and `Deleting` single elements. +- Set operations: `Union`, `Intersection`, `Difference`, `Symmetrical Difference`. + +For set operations, three implementations are compared: +- **Sequential:** Standard sequential operations (used as the Baseline). +- **Tree Traversal:** Optimized operations using tree traversal. +- **Parallel:** Multi-threaded operations. + +**Parameters evaluated:** +- `A`: Size of the primary set (100; 10,000; 1,000,000). +- `B`: Size of the secondary set (100; 1,000; 100,000). +- `DataTypeA`: Data distribution for the primary set (`Random` or `Sorted`). +- `threads`: Number of threads allocated for parallel operations (1, 2, 4, 8). + +**How to run AVLSet benchmarks:** +To run only the AVLSet benchmarks, use the following command: +`dotnet run -c Release --filter '*AVLSet*'` \ No newline at end of file diff --git a/README.md b/README.md index 8084adb..22569bb 100644 --- a/README.md +++ b/README.md @@ -5,6 +5,7 @@ Quad‑tree based linear algebra in F# for GraphBLAS‑style graph analysis. Thi ## Benchmarks Infrastructure for benchmarking the implemented algorithms is available in the [respective project](QuadTree.Benchmark/). +For performance testing details and instructions on how to run them, see the [Benchmarks README](QuadTree.Benchmark/README.md). ## Implemented Algorithms From 7916f509c597174af46947d3737eb50df15ce963 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Wed, 27 May 2026 14:46:17 +0300 Subject: [PATCH 08/10] formatted --- QuadTree.Benchmark/AVLSet.fs | 45 ++++++++++++++++++++++++------------ 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/QuadTree.Benchmark/AVLSet.fs b/QuadTree.Benchmark/AVLSet.fs index 37d08a9..1481712 100644 --- a/QuadTree.Benchmark/AVLSet.fs +++ b/QuadTree.Benchmark/AVLSet.fs @@ -26,8 +26,7 @@ type SingleOpsBenchmark() = member self.Setup() = self.rndInt <- rnd.Next(self.A + 1, self.A + 1000) - let dataA = - Array.init self.A (fun _ -> rnd.Next()) + let dataA = Array.init self.A (fun _ -> rnd.Next()) self.setA <- dataA @@ -70,8 +69,7 @@ type SequentialSetsBenchmark() = [] member self.Setup() = - let dataA = - Array.init self.A (fun _ -> rnd.Next()) + let dataA = Array.init self.A (fun _ -> rnd.Next()) let dataB = Array.init self.B (fun _ -> rnd.Next()) @@ -136,7 +134,7 @@ type SequentialSetsBenchmark() = [] [] [] -[] +[] type ParallelSetsBenchmark() = let rnd = System.Random(1234561) @@ -160,24 +158,37 @@ type ParallelSetsBenchmark() = [] member self.Setup() = - let dataA = - Array.init self.A (fun _ -> rnd.Next()) + let dataA = Array.init self.A (fun _ -> rnd.Next()) let dataB = Array.init self.B (fun _ -> rnd.Next()) self.setA <- - dataA |> Array.fold (fun set v -> match AVLSet.add v set with | Ok s -> s | Error e -> failwithf "%A" e) AVLSet.empty + dataA + |> Array.fold + (fun set v -> + match AVLSet.add v set with + | Ok s -> s + | Error e -> failwithf "%A" e) + AVLSet.empty + self.setB <- - dataB |> Array.fold (fun set v -> match AVLSet.add v set with | Ok s -> s | Error e -> failwithf "%A" e) AVLSet.empty + dataB + |> Array.fold + (fun set v -> + match AVLSet.add v set with + | Ok s -> s + | Error e -> failwithf "%A" e) + AVLSet.empty + - [] [] member self.SequentialUnion() = AVLSet.union self.setA self.setB [] [] - member self.ParallelUnionWithThreads() = ParallelAVLSet.union (Some self.threads) self.setA self.setB + member self.ParallelUnionWithThreads() = + ParallelAVLSet.union (Some self.threads) self.setA self.setB [] [] @@ -185,7 +196,8 @@ type ParallelSetsBenchmark() = [] [] - member self.ParallelIntersectionWithThreads() = ParallelAVLSet.intersection (Some self.threads) self.setA self.setB + member self.ParallelIntersectionWithThreads() = + ParallelAVLSet.intersection (Some self.threads) self.setA self.setB [] [] @@ -193,12 +205,15 @@ type ParallelSetsBenchmark() = [] [] - member self.ParallelDifferenceWithThreads() = ParallelAVLSet.difference (Some self.threads) self.setA self.setB + member self.ParallelDifferenceWithThreads() = + ParallelAVLSet.difference (Some self.threads) self.setA self.setB [] [] - member self.SequentialSymmetricalDifference() = AVLSet.symmDifference self.setA self.setB + member self.SequentialSymmetricalDifference() = + AVLSet.symmDifference self.setA self.setB [] [] - member self.ParallelSymmetricalDifferenceWithThreads() = ParallelAVLSet.symmDifference (Some self.threads) self.setA self.setB + member self.ParallelSymmetricalDifferenceWithThreads() = + ParallelAVLSet.symmDifference (Some self.threads) self.setA self.setB From 8eb71a75bcca1f95795781404a38f0f11f13c494 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Thu, 28 May 2026 23:59:45 +0300 Subject: [PATCH 09/10] add benchmark results to README --- QuadTree.Benchmark/README.md | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/QuadTree.Benchmark/README.md b/QuadTree.Benchmark/README.md index 5594dbe..96a46f8 100644 --- a/QuadTree.Benchmark/README.md +++ b/QuadTree.Benchmark/README.md @@ -39,4 +39,23 @@ For set operations, three implementations are compared: **How to run AVLSet benchmarks:** To run only the AVLSet benchmarks, use the following command: -`dotnet run -c Release --filter '*AVLSet*'` \ No newline at end of file +`dotnet run -c Release --filter '*AVLSet*'` + +--- + +#### Benchmark Results Summary + +Based on the benchmarking data, we can draw the following architectural conclusions: + +**1. Single Element Operations (`Adding`, `Deleting`)** +Perform predictably well, showing characteristic logarithmic $O(\log N)$ scaling. Increasing the set size by a factor of 1,000 (from 100 to 100,000) only increases execution time by roughly 2.3x (from ~580 ns to ~1.3 μs). Memory allocations per operation are minimal and stable. + +**2. Tree Traversal vs. Sequential Operations** +The `Traversal` optimization is highly situational and depends heavily on the ratio between set sizes: +* **Best Case ($A \gg B$):** When the primary set is large and the secondary set is small (e.g., $A=100,000, B=100$), `Traversal` is significantly faster. For instance, `Intersection` via traversal is ~4x faster (Ratio 0.26) than the sequential baseline. +* **Worst Case ($A \le B$):** When sets are of equal size or $B$ is larger, the traversal overhead drastically degrades performance, making it up to 40x slower than standard sequential operations. + +**3. Parallel Execution (Parallel Slowdown)** +Currently, the multi-threaded implementation across all operations (`Union`, `Intersection`, `Difference`, `Symmetrical Difference`) suffers from a severe **parallel slowdown**. +* Parallel execution is consistently **2x to 24x slower** than the single-threaded baseline. +* **Task Explosion & GC Pressure:** The recursive nature of the tasks generates tens of thousands of work items for larger trees (e.g., 71,300+ completed work items for $A=100k, B=10k$). The overhead of task scheduling, context switching, and massive memory allocations (up to 100MB+ causing heavy Garbage Collection) entirely negates the benefits of concurrent execution. \ No newline at end of file From e52c2fd89a5ea776005c2f9fd3af713b39fb94fd Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Fri, 29 May 2026 21:25:12 +0300 Subject: [PATCH 10/10] make benchmark results in README more detailed --- QuadTree.Benchmark/README.md | 50 +++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 12 deletions(-) diff --git a/QuadTree.Benchmark/README.md b/QuadTree.Benchmark/README.md index 96a46f8..1ba97ab 100644 --- a/QuadTree.Benchmark/README.md +++ b/QuadTree.Benchmark/README.md @@ -43,19 +43,45 @@ To run only the AVLSet benchmarks, use the following command: --- -#### Benchmark Results Summary +### Benchmark Results -Based on the benchmarking data, we can draw the following architectural conclusions: +Based on the benchmarking data obtained via BenchmarkDotNet, we can draw comprehensive architectural conclusions regarding asymptotic complexity, algorithmic trade-offs, and multi-threading overhead in immutable data structures. -**1. Single Element Operations (`Adding`, `Deleting`)** -Perform predictably well, showing characteristic logarithmic $O(\log N)$ scaling. Increasing the set size by a factor of 1,000 (from 100 to 100,000) only increases execution time by roughly 2.3x (from ~580 ns to ~1.3 μs). Memory allocations per operation are minimal and stable. +#### 1. Single Element Operations: Asymptotic Complexity Validation +Operations for single elements (`Adding`, `Deleting`) perfectly demonstrate the expected logarithmic **$O(\log N)$** time complexity associated with balanced AVL trees. +* **Execution Time:** Increasing the tree size by a factor of 1,000 (from $100$ to $100,000$ elements) only increases execution time by approximately **2.3x** (e.g., adding an element scales from $582.1$ ns to $1,376.7$ ns). +* **Memory Allocations:** Memory consumption also scales logarithmically. Adding an element to a tree of $100$ nodes allocates $880$ Bytes, while a tree of $100,000$ nodes requires only $2,080$ Bytes. This perfectly reflects the cost of path-copying (creating new nodes from the inserted leaf up to the root) in immutable tree structures. -**2. Tree Traversal vs. Sequential Operations** -The `Traversal` optimization is highly situational and depends heavily on the ratio between set sizes: -* **Best Case ($A \gg B$):** When the primary set is large and the secondary set is small (e.g., $A=100,000, B=100$), `Traversal` is significantly faster. For instance, `Intersection` via traversal is ~4x faster (Ratio 0.26) than the sequential baseline. -* **Worst Case ($A \le B$):** When sets are of equal size or $B$ is larger, the traversal overhead drastically degrades performance, making it up to 40x slower than standard sequential operations. +#### 2. Tree Traversal vs. Sequential (Algorithmic Trade-offs) +The `Traversal` optimization yields highly polarized results depending on the specific operation and the ratio between the sizes of sets $A$ and $B$. -**3. Parallel Execution (Parallel Slowdown)** -Currently, the multi-threaded implementation across all operations (`Union`, `Intersection`, `Difference`, `Symmetrical Difference`) suffers from a severe **parallel slowdown**. -* Parallel execution is consistently **2x to 24x slower** than the single-threaded baseline. -* **Task Explosion & GC Pressure:** The recursive nature of the tasks generates tens of thousands of work items for larger trees (e.g., 71,300+ completed work items for $A=100k, B=10k$). The overhead of task scheduling, context switching, and massive memory allocations (up to 100MB+ causing heavy Garbage Collection) entirely negates the benefits of concurrent execution. \ No newline at end of file +* **The Triumphs (`Intersection`):** Traversal completely dominates standard sequential intersection when set sizes are heavily skewed. For $A=100,000$ and $B=100$, Traversal takes **$83.9$ μs** compared to Sequential's **$318.2$ μs** (a **~3.8x speedup**). It bypasses deep recursive merges and instead maps the smaller set against the larger one efficiently. +* **The Catastrophes (`Difference` & `Symmetrical Difference`):** Traversal causes catastrophic algorithmic degradation for difference operations when applied to the wrong set ratios. For instance, calculating the Difference for $A=100$ and $B=10,000$ takes Sequential operations $168.1$ μs, while Traversal takes **$6,958.6$ μs** (a massive **41.3x slowdown**). This highlights the cost of blindly traversing a large tree to perform sequential lookups. +* **Conclusion:** The `Traversal` strategy should only be conditionally invoked using heuristics. + +#### 3. The Parallel Slowdown Phenomenon +The multi-threaded implementation (`ParallelAVLSet`) was benchmarked across 1, 2, and 4 threads. Counter-intuitively, the parallel implementation consistently underperforms the sequential baseline across all metrics (time and memory), providing an example of **Parallel Slowdown**. + +* **Task Explosion:** The recursive divide-and-conquer strategy spawns an excessive number of micro-tasks. In the `Intersection` benchmark ($A=100k, B=10k$), the parallel execution generated **$71,315$ completed work items** for a single operation. The overhead of scheduling and synchronizing these micro-tasks in the Thread Pool entirely eclipses the actual computational work. +* **Core Contention:** In almost all scenarios, allocating *more* threads worsened the execution time. For $A=10k, B=10k$ Difference, running on 1 thread took $16.7$ ms, but spreading it across 2 threads spiked the time to **$62.1$ ms**. This indicates severe CPU cache trashing, lock contention, and context switching penalties. +* **GC Thrashing & Memory Pressure:** Parallelizing immutable tree operations causes a severe allocation spike. In extreme cases, parallel operations allocated over **$100$ MB** of memory (compared to $18.4$ MB for Sequential), triggering over **17,000 Gen0 Garbage Collection cycles** in a single benchmark run. The GC "stop-the-world" pauses negate any multi-core benefits. +* **Architectural Takeaway:** Fine-grained parallelism is unsuited for lightweight immutable tree operations. To make parallelization viable in the future, a **Granularity Threshold** must be implemented (e.g., falling back to sequential execution for subtrees with fewer than $5,000$ nodes) to drastically reduce task overhead. + +#### Table + +| Operation Scenario (A × B) | Implementation Type | Execution Time | Memory Allocated | Ratio | Algorithmic Insight | +| --- | --- | --- | --- | --- | --- | +| **Single Add** (100) | Sequential Baseline | 582.1 ns | 880 B | 1.00 (Base) | Logarithmic $O(\log N)$ baseline. | +| **Single Add** (100,000) | Sequential Baseline | 1,376.7 ns | 2,080 B | ~2.3x scales | Expected path-copying cost. | +| --- | --- | --- | --- | --- | --- | +| **Intersection** (100k × 100) | Sequential Baseline | 318.25 μs | 447.82 KB | 1.00 (Base) | Standard recursive merge. | +| **Intersection** (100k × 100) | Tree Traversal | **83.99 μs** | **86.54 KB** | **~3.8x Speedup** | **Optimal Heuristic:** Huge $A \gg B$ asymmetry. | +| --- | --- | --- | --- | --- | --- | +| **Difference** (100 × 10k) | Sequential Baseline | 168.15 μs | 230.23 KB | 1.00 (Base) | Efficient baseline difference. | +| **Difference** (100 × 10k) | Tree Traversal | 6,958.68 μs | 8.86 MB | **41.39x Slowdown** | **Catastrophic Degradation:** Wrong tree ratio. | +| --- | --- | --- | --- | --- | --- | +| **Difference** (10k × 10k) | Sequential Baseline | 5.68 ms | 6.41 MB | 1.00 (Base) | Balanced trees sequential. | +| **Difference** (10k × 10k) | Parallel (4 Threads) | 57.65 ms | 26.66 MB | **10.28x Slowdown** | High Thread Pool & GC contention. | +| --- | --- | --- | --- | --- | --- | +| **Intersection** (100k × 10k) | Sequential Baseline | 16.29 ms | 18.45 MB | 1.00 (Base) | Large scale baseline. | +| **Intersection** (100k × 10k) | Parallel (4 Threads) | 357.84 ms | 103.17 MB | **22.03x Slowdown** | **Max Task Explosion:** 71,300+ tasks created. | \ No newline at end of file