diff --git a/AVLSet_Solution.slnx b/AVLSet_Solution.slnx index 8fdfd91..513dd38 100644 --- a/AVLSet_Solution.slnx +++ b/AVLSet_Solution.slnx @@ -6,6 +6,7 @@ + diff --git a/README.md b/README.md index 9413bc9..cd00226 100644 --- a/README.md +++ b/README.md @@ -86,29 +86,41 @@ The `AVLSet` module provides a comprehensive interface: |:---|:---|:---| | **add** | `'a -> AVLTree<'a> -> AVLTree<'a>` | Adds an element. | | **delete** | `'a -> AVLTree<'a> -> AVLTree<'a>` | Removes an element. | -| **contains** | `'a -> AVLTree<'a> -> bool` | Checks membership. | +| **contains** | `'a -> AVLTree<'a> -> AVLTree<'a>` | Checks membership. | +| **copy** | `'a -> AVLTree<'a> -> bool` | Copies an set. | | **union** | `AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Standard union ($A \cup B$). | | **intersection** | `AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Standard intersection ($A \cap B$). | | **difference** | `AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Standard difference ($A \setminus B$). | | **symmDifference** | `AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Standard symmetrical difference ($A \vartriangle B$). | -| **parallel(Union/Intersection/Difference/SymmDiff)**| `ParallelOptions -> AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Multi-threaded set-theoretic operations. | -| **(union/intersection/difference/symmDiff)Traversal**| `AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Set-theoretic operations via tree traversal. | +| **Traversal.{union/intersection/difference/symmDiff}**| `AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Set-theoretic operations via tree traversal. | + +The `ParallelAVLSet` module provides an interface for parallel set-theoretic operations: +| **union** | `option -> AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Parallel union ($A \cup B$). | +| **intersection** | `option -> AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Parallel intersection ($A \cap B$). | +| **difference** | `option -> AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Parallel difference ($A \setminus B$). | +| **symmDifference** | `option -> AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Parallel symmetrical difference ($A \vartriangle B$). | +| **{union/intersection/difference/symmDiff}Async** | `option -> AVLTree<'a> -> AVLTree<'a> -> AVLTree<'a>` | Creates an asynchronous computation for set-theoretic operations. | --- ## Project Structure ```text /src -└── AVLSet.Library - ├── AVLSet.Library.fsproj -   └── Library.fs + └── AVLSet.Library + ├── AssemblyInfo.fs + ├── AVLSet.Library.fsproj + ├── Library.fs +   └── LibraryParallel.fs /tests -└── AVLSet.UnitTests - ├── AVLSet.UnitTests.fsproj -   └── Tests.fs + └── AVLSet.UnitTests + │ ├── AVLSet.UnitTests.fsproj +   │ └── Tests.fs + └── AVLSet.PropertyTests + ├── AVLSet.PropertyTests.fsproj +   └── Tests.fs /benchmarks -└── AVLSet.Benchmarks - ├── AVLSet.Benchmarks.fsproj -   ├── Benchmarks.fs - └── Program.fs + └── AVLSet.Benchmarks + ├── AVLSet.Benchmarks.fsproj +   ├── Benchmarks.fs + └── Program.fs ``` diff --git a/benchmarks/AVLSet.Benchmarks/Benchmarks.fs b/benchmarks/AVLSet.Benchmarks/Benchmarks.fs index 42af1e0..e0f0f59 100644 --- a/benchmarks/AVLSet.Benchmarks/Benchmarks.fs +++ b/benchmarks/AVLSet.Benchmarks/Benchmarks.fs @@ -1,132 +1,184 @@ namespace AVLSet.Benchmarks -open System.Threading.Tasks -open BenchmarkDotNet.Diagnosers open BenchmarkDotNet.Attributes open BenchmarkDotNet.Configs open AVLSet.Library +open AVLSet.Library.Parallel [] [] [] [] -[] -[] -type SetBenchmarks() = +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 -> AVLSet.add v set) 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: AVLTree + val mutable public setA: AVLSet [] - val mutable public setB: AVLTree + val mutable public setB: AVLSet [] 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 dataA = Array.init self.A (fun _ -> rnd.Next()) 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 -> AVLSet.add v set) AVLSet.empty + + self.setB <- dataB |> Array.fold (fun (set: AVLSet) v -> AVLSet.add v set) AVLSet.empty + + [] + [] + member self.SequentialUnion() = AVLSet.union self.setA self.setB [] - [] - member self.``Adding one element``() = AVLSet.add self.rndInt self.setA + [] + member self.UnionViaTreeTraversal() = + AVLSet.Traversal.union self.setA self.setB + + [] + [] + member self.SequentialIntersection() = AVLSet.intersection self.setA self.setB [] - [] - member self.``Deleting one element``() = AVLSet.delete self.rndInt self.setA + [] + member self.IntersectionViaTreeTraversal() = + AVLSet.Traversal.intersection self.setA self.setB [] - [] - member self.``Sequential union``() = AVLSet.union self.setA self.setB + [] + member self.SequentialDifference() = AVLSet.difference self.setA self.setB [] - [] - member self.``Union via tree traversal``() = - AVLSet.unionTraversal self.setA self.setB + [] + member self.DifferenceViaTreeTraversal() = + AVLSet.Traversal.difference self.setA self.setB + + [] + [] + member self.SequentialSymmetricalDifference() = + AVLSet.symmDifference self.setA self.setB [] - [] - member self.``Parallel union with threads``() = - let opts = ParallelOptions() - opts.MaxDegreeOfParallelism <- self.Threads + [] + 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: AVLSet) v -> AVLSet.add v set) AVLSet.empty + + self.setB <- dataB |> Array.fold (fun (set: AVLSet) v -> AVLSet.add v set) AVLSet.empty - AVLSet.parallelUnion opts self.setA self.setB [] - [] - member self.``Sequential intersection``() = AVLSet.intersection self.setA self.setB + [] + member self.SequentialUnion() = AVLSet.union self.setA self.setB [] + [] + member self.ParallelUnionWithThreads() = + ParallelAVLSet.union (Some self.threads) self.setA self.setB + + [] [] - member self.``Intersection via tree traversal``() = - AVLSet.intersectionTraversal self.setA self.setB + member self.SequentialIntersection() = AVLSet.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 + member self.ParallelIntersectionWithThreads() = + ParallelAVLSet.intersection (Some self.threads) 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.SequentialDifference() = AVLSet.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 + member self.ParallelDifferenceWithThreads() = + ParallelAVLSet.difference (Some self.threads) self.setA self.setB [] [] - member self.``Sequential symmetrical difference``() = + member self.SequentialSymmetricalDifference() = 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 + member self.ParallelSymmetricalDifferenceWithThreads() = + ParallelAVLSet.symmDifference (Some self.threads) self.setA self.setB diff --git a/benchmarks/AVLSet.Benchmarks/Program.fs b/benchmarks/AVLSet.Benchmarks/Program.fs index 2c180ba..0407414 100644 --- a/benchmarks/AVLSet.Benchmarks/Program.fs +++ b/benchmarks/AVLSet.Benchmarks/Program.fs @@ -1,7 +1,12 @@ open BenchmarkDotNet.Running -open AVLSet.Benchmarks [] -let main args = - BenchmarkRunner.Run() |> ignore +let main argv = + let benchmarks = + BenchmarkSwitcher + [| typeof + typeof + typeof |] + + benchmarks.Run argv |> ignore 0 diff --git a/src/AVLSet.Library/AVLSet.Library.fsproj b/src/AVLSet.Library/AVLSet.Library.fsproj index 1ae3ffe..a0b9ab0 100644 --- a/src/AVLSet.Library/AVLSet.Library.fsproj +++ b/src/AVLSet.Library/AVLSet.Library.fsproj @@ -1,4 +1,4 @@ - + net10.0 @@ -7,6 +7,7 @@ + diff --git a/src/AVLSet.Library/Library.fs b/src/AVLSet.Library/Library.fs index d4e36fa..80acd89 100644 --- a/src/AVLSet.Library/Library.fs +++ b/src/AVLSet.Library/Library.fs @@ -1,103 +1,92 @@ namespace AVLSet.Library -open System.Threading.Tasks - -type AVLTree<'Value> = +type AVLSet<'Value> = | Empty - | Node of int * 'Value * AVLTree<'Value> * AVLTree<'Value> + | Node of int * 'Value * AVLSet<'Value> * AVLSet<'Value> -module 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" - | 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 + match n1, n2 with + | Empty, _ -> n2, n1 + | _, Empty -> n1, n2 + | Node(h1, _, _, _), Node(h2, _, _, _) -> if h1 >= h2 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) + 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" - | 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 @@ -105,18 +94,18 @@ module 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 @@ -125,12 +114,11 @@ module 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) -> @@ -144,20 +132,21 @@ module 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 "Unreacheable message 1" + | 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 "Unreacheable message 2" + | 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 @@ -167,19 +156,20 @@ module 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 @@ -195,7 +185,7 @@ module 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 @@ -207,7 +197,7 @@ module 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 @@ -237,7 +227,7 @@ module 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,119 +242,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 = Tree.maxMinNodesByHeights set1 set2 + let unSet = Tree.copy maxSet + Tree.traverse Tree.insert unSet minSet + + let intersection set1 set2 = + let maxSet, minSet = Tree.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 = Tree.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/src/AVLSet.Library/LibraryParallel.fs b/src/AVLSet.Library/LibraryParallel.fs new file mode 100644 index 0000000..6657bc6 --- /dev/null +++ b/src/AVLSet.Library/LibraryParallel.fs @@ -0,0 +1,119 @@ +namespace AVLSet.Library.Parallel + +open AVLSet.Library + +/// +/// 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 = Tree.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 = Tree.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 = Tree.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 diff --git a/tests/AVLSet.PropertyTests/AVLSet.PropertyTests.fsproj b/tests/AVLSet.PropertyTests/AVLSet.PropertyTests.fsproj new file mode 100644 index 0000000..c1b1597 --- /dev/null +++ b/tests/AVLSet.PropertyTests/AVLSet.PropertyTests.fsproj @@ -0,0 +1,25 @@ + + + + net10.0 + false + + + + + + + + + + + + + + + + + + + + diff --git a/tests/AVLSet.PropertyTests/Tests.fs b/tests/AVLSet.PropertyTests/Tests.fs new file mode 100644 index 0000000..6e57f60 --- /dev/null +++ b/tests/AVLSet.PropertyTests/Tests.fs @@ -0,0 +1,252 @@ +namespace AVLSet.PropertyTests + +open FsUnit.Xunit +open FsCheck.Xunit +open AVLSet.Library +open AVLSet.Library.Parallel + +module SetPropertyTests = + 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 = Tree.height ln + let rnHeight = Tree.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 ``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 ``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 ``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: 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 + + isSetValid unionSet None None |> should be True + + (advancedContains (fun v x -> x) setA unionSet + && advancedContains (fun v x -> x) setB unionSet) + |> should be True + + let unionSetSwapped = AVLSet.union setB setA + + (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 + + 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 + + (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 + + advancedContains (fun v x -> if AVLSet.contains v setB then not x else x) setA differenceSet + |> should be True + + [] + 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 + + (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 + + let symmDiffSetSwapped = AVLSet.symmDifference setB setA + + (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 + + (advancedContains (fun v x -> x) setA unionSet + && advancedContains (fun v x -> x) setB unionSet) + |> should be True + + let unionSetSwapped = AVLSet.union setB setA + + (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 + + let intersectionSetSwapped = AVLSet.intersection setB setA + + (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`` (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) setA symmDiffSet + && 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 + + (advancedContains (fun v x -> x) symmDiffSet symmDiffSetSwapped + && advancedContains (fun v x -> x) symmDiffSetSwapped symmDiffSet) + |> should be True + + [] + 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 + + (advancedContains (fun v x -> x) setA unionSet + && advancedContains (fun v x -> x) setB unionSet) + |> should be True + + let unionSetSwapped = AVLSet.union setB setA + + (advancedContains (fun v x -> x) unionSet unionSetSwapped + && advancedContains (fun v x -> x) unionSetSwapped unionSet) + |> should be True + + [] + 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 + + let intersectionSetSwapped = AVLSet.intersection setB setA + + (advancedContains (fun v x -> x) intersectionSet intersectionSetSwapped + && advancedContains (fun v x -> x) intersectionSetSwapped intersectionSet) + |> should be True + + [] + 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 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 + + (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 + + 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/tests/AVLSet.UnitTests/AVLSet.UnitTests.fsproj b/tests/AVLSet.UnitTests/AVLSet.UnitTests.fsproj index 5fead54..5d5524b 100644 --- a/tests/AVLSet.UnitTests/AVLSet.UnitTests.fsproj +++ b/tests/AVLSet.UnitTests/AVLSet.UnitTests.fsproj @@ -11,8 +11,7 @@ - - + diff --git a/tests/AVLSet.UnitTests/Tests.fs b/tests/AVLSet.UnitTests/Tests.fs index 54982a7..faf3ae5 100644 --- a/tests/AVLSet.UnitTests/Tests.fs +++ b/tests/AVLSet.UnitTests/Tests.fs @@ -1,11 +1,10 @@ namespace AVLSet.UnitTests -open System.Threading.Tasks open Xunit open FsUnit.Xunit open AVLSet.Library -module SetTests = +module SetUnitTests = let rec isSetValid n mn mx = match n with | Empty -> true @@ -13,8 +12,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) @@ -111,7 +110,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 @@ -217,200 +216,3 @@ module SetTests = ) 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