diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 18495e4f..2655c85e 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -3,7 +3,7 @@ "isRoot": true, "tools": { "fake-cli": { - "version": "5.23.0", + "version": "5.23.1", "commands": [ "fake" ] diff --git a/src/FSharpx.Collections.Experimental/AaTree.fs b/src/FSharpx.Collections.Experimental/AaTree.fs new file mode 100644 index 00000000..e4ff7f9d --- /dev/null +++ b/src/FSharpx.Collections.Experimental/AaTree.fs @@ -0,0 +1,209 @@ +namespace rec FSharpx.Collections.Experimental + +open System.Collections +open FSharpx.Collections +open System.Collections.Generic + +(* Implementation guided by following paper: https://arxiv.org/pdf/1412.4882.pdf *) + +/// A balanced binary tree similar to a red-black tree which may have less predictable performance. +type AaTree<'T when 'T: comparison> = + | E + | T of length: int * leftSubtree: AaTree<'T> * value: 'T * rightSubtree: AaTree<'T> + + member x.ToArray() = + AaTree.toArray x + + member x.ToList() = + AaTree.toList x + + member x.ToSeq() = + AaTree.toSeq x + + interface IEnumerable<'T> with + member x.GetEnumerator() = + (x.ToSeq() :> _ seq).GetEnumerator() + + interface System.Collections.IEnumerable with + member x.GetEnumerator() = + (x.ToSeq() :> _ seq).GetEnumerator() + +[] +module AaTree = + /// O(1): Returns a boolean if tree is empty. + let isEmpty = + function + | E -> true + | _ -> false + + let private sngl = + function + | E -> false + | T(_, _, _, E) -> true + | T(lvx, _, _, T(lvy, _, _, _)) -> lvx > lvy + + /// O(1): Returns an empty AaTree. + let empty = E + + let private lvl = + function + | E -> 0 + | T(lvt, _, _, _) -> lvt + + let private skew = + function + | T(lvx, T(lvy, a, ky, b), kx, c) when lvx = lvy -> T(lvx, a, ky, T(lvx, b, kx, c)) + | t -> t + + let private split = + function + | T(lvx, a, kx, T(lvy, b, ky, T(lvz, c, kz, d))) when lvx = lvy && lvy = lvz -> T(lvx + 1, T(lvx, a, kx, b), ky, T(lvx, c, kz, d)) + | t -> t + + /// O(log n): Returns a new AaTree with the parameter inserted. + let rec insert item = + function + | E -> T(1, E, item, E) + | T(h, l, v, r) as node -> + if item < v then + split <| (skew <| T(h, insert item l, v, r)) + elif item > v then + split <| (skew <| T(h, l, v, insert item r)) + else + node + + (* nlvl function fixed according to Isabelle HOL proof below: *) + (* https://isabelle.in.tum.de/library/HOL/HOL-Data_Structures/AA_Set.html#:~:text=text%E2%80%B9In%20the%20paper%2C%20the%20last%20case%20of%20%5C%3C%5Econst%3E%E2%80%B9adjust%E2%80%BA%20is%20expressed%20with%20the%20help%20of%20an%0Aincorrect%20auxiliary%20function%20%5Ctexttt%7Bnlvl%7D. *) + let private nlvl = + function + | T(lvt, _, _, _) as t -> if sngl t then lvt else lvt + 1 + | _ -> failwith "unexpected nlvl case" + + let private adjust = + function + | T(lvt, lt, kt, rt) as t when lvl lt >= lvt - 1 && lvl rt >= (lvt - 1) -> t + | T(lvt, lt, kt, rt) when lvl rt < lvt - 1 && sngl lt -> skew <| T(lvt - 1, lt, kt, rt) + | T(lvt, T(lv1, a, kl, T(lvb, lb, kb, rb)), kt, rt) when lvl rt < lvt - 1 -> T(lvb + 1, T(lv1, a, kl, lb), kb, T(lvt - 1, rb, kt, rt)) + | T(lvt, lt, kt, rt) when lvl rt < lvt -> split <| T(lvt - 1, lt, kt, rt) + | T(lvt, lt, kt, T(lvr, T(lva, c, ka, d), kr, b)) -> + let a = T(lva, c, ka, d) + T(lva + 1, T(lvt - 1, lt, kt, c), ka, (split(T(nlvl a, d, kr, b)))) + | _ -> failwith "unexpected adjust case" + + (* splitMax fixed as in Isabelle HOL proof below: *) + (* https://isabelle.in.tum.de/library/HOL/HOL-Data_Structures/AA_Set.html#:~:text=Function%20%E2%80%B9split_max%E2%80%BA%20below%20is%20called%20%5Ctexttt%7Bdellrg%7D%20in%20the%20paper.%0AThe%20latter%20is%20incorrect%20for%20two%20reasons%3A%20%5Ctexttt%7Bdellrg%7D%20is%20meant%20to%20delete%20the%20largest%0Aelement%20but%20recurses%20on%20the%20left%20instead%20of%20the%20right%20subtree%3B%20the%20invariant%0Ais%20not%20restored.%E2%80%BA *) + let rec private splitMax = + function + | T(_, l, v, E) -> (l, v) + | T(h, l, v, r) as node -> let (r', b) = splitMax r in adjust <| T(h, l, v, r'), b + | _ -> failwith "unexpected dellrg case" + + /// O(log n): Returns an AaTree with the parameter removed. + let rec delete item = + function + | E -> E + | T(_, E, v, rt) when item = v -> rt + | T(_, lt, v, E) when item = v -> lt + | T(h, l, v, r) as node -> + if item < v then + adjust <| T(h, delete item l, v, r) + elif item > v then + adjust <| T(h, l, v, delete item r) + elif isEmpty l then + r + else + let (newLeft, newVal) = splitMax l + adjust <| T(h, newLeft, newVal, r) + + /// O(log n): Returns true if the given item exists in the tree. + let rec exists item = + function + | E -> false + | T(_, l, v, r) -> + if v = item then true + elif item < v then exists item l + else exists item r + + /// O(log n): Returns true if the given item does not exist in the tree. + let rec notExists item tree = + not <| exists item tree + + /// O(log n): Returns Some item if it was found in the tree; else, returns None. + let rec tryFind item = + function + | E -> None + | T(_, l, v, r) -> + if v = item then Some v + elif item < v then tryFind item l + else tryFind item r + + /// O(log n): Returns an item if it was found in the tree; else, throws error. + let rec find item tree = + match tryFind item tree with + | None -> failwith <| sprintf "Item %A was not found in the tree." item + | Some x -> x + + let rec private foldOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) x t = + match t with + | E -> x + | T(_, l, v, r) -> + let x = foldOpt f x l + let x = f.Invoke(x, v) + foldOpt f x r + + /// Executes a function on each element in order (for example: 1, 2, 3 or a, b, c). + let fold f x t = + foldOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt (f)) x t + + let rec private foldBackOpt (f: OptimizedClosures.FSharpFunc<_, _, _>) x t = + match t with + | E -> x + | T(_, l, v, r) -> + let x = foldBackOpt f x r + let x = f.Invoke(x, v) + foldBackOpt f x l + + /// Executes a function on each element in reverse order (for example: 3, 2, 1 or c, b, a). + let foldBack f x t = + foldBackOpt (OptimizedClosures.FSharpFunc<_, _, _>.Adapt (f)) x t + + /// O(n): Returns a list containing the elements in the tree. + let toList(tree: AaTree<'T>) = + foldBack (fun a e -> e :: a) [] tree + + let toSeq(tree: AaTree<'T>) = + tree |> toList |> List.toSeq + + let toArray(tree: AaTree<'T>) = + tree |> toList |> List.toArray + + /// O(n log n): Builds an AaTree from the elements in the given list. + let ofList collection = + List.fold (fun acc item -> insert item acc) empty collection + + let ofSeq collection = + Seq.fold (fun acc item -> insert item acc) empty collection + + let ofArray collection = + Array.fold (fun acc item -> insert item acc) empty collection + + type AaTree<'T when 'T: comparison> with + + member x.Insert(y) = + insert y x + + member x.Delete(y) = + delete y x + + member x.Fold(folder, initialState) = + fold folder initialState x + + member x.FoldBack(folder, initialState) = + foldBack folder initialState x + + member x.Find(y) = find y x + + member x.TryFind(y) = + tryFind y x + + member x.IsEmpty() = isEmpty x diff --git a/src/FSharpx.Collections.Experimental/FSharpx.Collections.Experimental.fsproj b/src/FSharpx.Collections.Experimental/FSharpx.Collections.Experimental.fsproj index 332e70a5..dfad6374 100644 --- a/src/FSharpx.Collections.Experimental/FSharpx.Collections.Experimental.fsproj +++ b/src/FSharpx.Collections.Experimental/FSharpx.Collections.Experimental.fsproj @@ -1,4 +1,4 @@ - + Library @@ -16,6 +16,7 @@ + diff --git a/tests/FSharpx.Collections.Experimental.Tests/AaTreeTest.fs b/tests/FSharpx.Collections.Experimental.Tests/AaTreeTest.fs new file mode 100644 index 00000000..a6902f4a --- /dev/null +++ b/tests/FSharpx.Collections.Experimental.Tests/AaTreeTest.fs @@ -0,0 +1,219 @@ +namespace FSharpx.Collections.Experimental.Tests + +open FSharpx.Collections +open FSharpx.Collections.Experimental +open Expecto + +module AaTreeTest = + [] + let testAaTree = + testList "AaTree" [ + + (* Existence tests. *) + test "test isEmpty returns true for an empty AaTree" { + let tree = AaTree.empty + Expect.isTrue <| AaTree.isEmpty tree <| "expect isEmpty returns true" + } + + test "test isEmpty returns false for an AaTree with at least one value" { + let tree = AaTree.ofList [ 9 ] + + Expect.isFalse + <| AaTree.isEmpty tree + <| "expect isEmpty returns false" + } + + test "test isEmpty returns true when we delete an AaTree's last element " { + let tree = AaTree.ofList [ 1 ] + let tree = AaTree.delete 1 tree + Expect.isTrue <| AaTree.isEmpty tree <| "expect isEmpty returns true" + } + + test "test exists returns true when item exists in AaTree" { + let tree = AaTree.ofList [ 9 ] + Expect.isTrue <| AaTree.exists 9 tree <| "expect exists returns true" + } + + test "test exists returns false when item does not exist in AaTree" { + let tree = AaTree.ofList [ 9 ] + + Expect.isFalse + <| AaTree.exists 10 tree + <| "expect exists returns false" + } + + test "test notExists returns true when item does not exist in AaTree" { + let tree = AaTree.ofList [ 9 ] + + Expect.isTrue + <| AaTree.notExists 10 tree + <| "expect notExists returns true" + } + + test "test notExists returns false when item exists in AaTree" { + let tree = AaTree.ofList [ 9 ] + + Expect.isFalse + <| AaTree.notExists 9 tree + <| "expect notExists returns false" + } + + test "test tryFind returns Some Item when Item exists in AaTree" { + let tree = AaTree.ofList [ "hello"; "bye" ] + + Expect.equal(Some("hello")) + <| AaTree.tryFind "hello" tree + <| "expect tryFind returns Some Item" + } + + test "test tryFind returns None when Item does not exist in AaTree" { + let tree = AaTree.ofList [ "hello"; "bye" ] + + Expect.isNone + <| AaTree.tryFind "goodbye" tree + <| "expect tryFind returns None" + } + + test "test find returns Item when Item exists in AaTree" { + let tree = AaTree.ofList [ "hello"; "bye" ] + + Expect.equal "hello" + <| AaTree.find "hello" tree + <| "expect find returns item" + } + + test "test find throws error when Item does not exist in AaTree" { + let tree = AaTree.ofList [ "hello"; "bye" ] + Expect.throws (fun () -> AaTree.find "goodbye" tree |> ignore) "expect find throws error" + } + + (* Conversion from tests. *) + test "test ofList returns AaTree where all elements in list exist" { + let list = [ 'a'; 'b'; 'c'; 'd'; 'e' ] + let tree = AaTree.ofList list + let returnList = AaTree.toList tree + + for i in list do + Expect.isTrue + <| AaTree.exists i tree + <| "expect AaTee.exists returns true on each item" + } + + test "test ofArray returns AaTree where all elements in array exist" { + let array = [| 1; 2; 3; 4; 5 |] + let tree = AaTree.ofArray array + + for i in array do + Expect.isTrue + <| AaTree.exists i tree + <| "expect AaTee.exists returns true on each item" + } + + test "test ofSeq returns AaTree where all elements in seq exist" { + let seq = Seq.ofList [ "hello"; "yellow"; "bye"; "try" ] + let tree = AaTree.ofSeq seq + + for i in seq do + Expect.isTrue + <| AaTree.exists i tree + <| "expect AaTee.exists returns true on each item" + } + + (* Conversion to tests. *) + test "test toList returns list equal to input list" { + let inputList = [ 0; 1; 2; 3 ] + let tree = AaTree.ofList inputList + let outputList = AaTree.toList tree + Expect.equal outputList inputList "expect lists are equal" + } + + test "test toArray returns array equal to input array" { + let inputArray = [| 0; 1; 2; 3 |] + let tree = AaTree.ofArray inputArray + let outputArray = AaTree.toArray tree + Expect.equal outputArray inputArray "expect arrays are equal" + } + + test "test toSeq returns seq equal to input seq" { + let inputSeq = Seq.ofList [ "hi"; "why"; "try" ] + let tree = AaTree.ofSeq inputSeq + let outputSeq = AaTree.toSeq tree + Expect.containsAll outputSeq inputSeq "expect seqs are equal" + } + + (* Fold and foldback tests. + * We will try building two lists using fold/foldback, + * because that is an operation where order matters. *) + test "test fold operates on values in sorted order" { + let inputList = [ 1; 2; 3 ] + let expectList = List.rev inputList + let tree = AaTree.ofList inputList + // List :: cons operator used in folder puts the new value + // at the start of the list, so it should be in reverse order. + // For example, initial list: [1] + // 2 :: [1] = [2;1] and finally 3 :: [2;1] = [3;2;1] + // We start operating with the first element in sorted order. + let foldBackResult = AaTree.fold (fun a e -> e :: a) [] tree + Expect.equal foldBackResult expectList "expect result is equal to reverse of input" + } + + test "test foldBack operates on values in reverse order" { + let inputList = [ 1; 2; 3 ] + let tree = AaTree.ofList inputList + // Exact same logic and folder in fold test abovem + // but expecting reverse . + // 3 :: [] = 3 -> 2 :: [3] = [2;3] -> 1 :: [2;3] = [1;2;3] + let foldResult = AaTree.foldBack (fun a e -> e :: a) [] tree + Expect.equal foldResult inputList "expect result is equal to input" + } + + (* Insert and delete tests. *) + test "test inserted elements exist in AaTree" { + let numsToInsert = [ 1; 2; 3; 4; 5 ] + // Insert items into tree from list via AaTree.Insert in lambda. + let tree = + List.fold (fun tree el -> AaTree.insert el tree) AaTree.empty numsToInsert + + // Test that each item in the list is in the tree. + for i in numsToInsert do + Expect.isTrue + <| AaTree.exists i tree + <| "expect existence of inserted elements is true" + } + + test "test deleted elements do not exist in AaTree" { + // We have to insert items into a tree before we can delete them. + let numsToInsert = [ 1; 2; 3; 4; 5 ] + + let tree = + List.fold (fun tree el -> AaTree.insert el tree) AaTree.empty numsToInsert + + // Define numbers to delete and use List.fold to perform AaTree.delete on all + let numsToDelete = [ 1; 2; 4; 5 ] + let tree = List.fold (fun tree el -> AaTree.delete el tree) tree numsToDelete + + // Test that none of the deleted items exist + for i in numsToDelete do + Expect.isFalse + <| AaTree.exists i tree + <| "expect existence of delete elements is false" + } + + test "test element we did not delete exists in AaTree when we delete all others" { + // We have to insert items into a tree before we can delete them. + let numsToInsert = [ 1; 2; 3; 4; 5 ] + + let tree = + List.fold (fun tree el -> AaTree.insert el tree) AaTree.empty numsToInsert + + // Define numbers to delete and use List.fold to perform AaTree.delete on all + let numsToDelete = [ 1; 2; 4; 5 ] + let tree = List.fold (fun tree el -> AaTree.delete el tree) tree numsToDelete + + // Test that the one element we did not delete still exists in the tree. + Expect.isTrue + <| AaTree.exists 3 tree + <| "expect existence of element we did not delete is still true" + + } + ] diff --git a/tests/FSharpx.Collections.Experimental.Tests/FSharpx.Collections.Experimental.Tests.fsproj b/tests/FSharpx.Collections.Experimental.Tests/FSharpx.Collections.Experimental.Tests.fsproj index 622dd9b6..ce39a985 100644 --- a/tests/FSharpx.Collections.Experimental.Tests/FSharpx.Collections.Experimental.Tests.fsproj +++ b/tests/FSharpx.Collections.Experimental.Tests/FSharpx.Collections.Experimental.Tests.fsproj @@ -1,4 +1,4 @@ - + Exe @@ -10,6 +10,7 @@ +