From d7a903b24b8d0f05d72a203e9ae5f206d7af57b2 Mon Sep 17 00:00:00 2001 From: Taranukha Leonid Date: Fri, 1 May 2026 14:58:44 +0300 Subject: [PATCH] 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 96f4102..3f58bd1 100644 --- a/QuadTree.Tests/QuadTree.Tests.fsproj +++ b/QuadTree.Tests/QuadTree.Tests.fsproj @@ -6,6 +6,7 @@ + @@ -17,6 +18,7 @@ + @@ -26,4 +28,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 2b2b699..3c88dde 100644 --- a/QuadTree/QuadTree.fsproj +++ b/QuadTree/QuadTree.fsproj @@ -6,6 +6,7 @@ +