diff --git a/src/BTree.mo b/src/BTree.mo new file mode 100644 index 00000000..eaef074a --- /dev/null +++ b/src/BTree.mo @@ -0,0 +1,163 @@ +/// Imperative sequences as B-Trees. + +import A "Array"; +import I "Iter"; +import List "List"; +import Text "Text"; +import Option "Option"; +import Order "Order"; +import P "Prelude"; +import Debug "Debug"; +import Prim "mo:⛔"; + +module { + + /// Constants we use to shape the tree. + /// See https://en.wikipedia.org/wiki/B-tree#Definition + module Constants { + let MAX_CHILDREN = 4; + }; + + public type Compare = { + show : K -> Text; + compare : (K, K) -> Order.Order + }; + + public type Data = [(K, V)]; + + public type Internal = { + data : Data; + trees : [Tree]; + }; + + public type Tree = { + #internal : Internal; + #leaf : Data; + }; + + func find_data(data : Data, find_k : K, c : (K, K) -> Order.Order) : ?V { + for ((k, v) in data.vals()) { + if (c(k, find_k) == #equal) { return ?v }; + }; + return null + }; + + public func find(t : Tree, k : K, c : (K, K) -> Order.Order) : ?V { + switch t { + case (#leaf(d)) { return find_data(d, k, c) }; + case (#internal(i)) { + for (j in I.range(0, i.data.size() - 1)) { + switch (c(k, i.data[j].0)) { + case (#equal) { return ?i.data[j].1 }; + case (#less) { return find(i.trees[j], k, c) }; + case _ { } + } + }; + find(i.trees[i.data.size()], k, c) + }; + }; + }; + + public module Insert { + + + + }; + + // Assert that the given B-Tree instance observes all relevant invariants. + // Used for unit tests. Show function helps debug failing tests. + // + // Note: These checks-as-assertions can be refactored into value-producing checks, + // if that seems useful. Then, they can be individual matchers tests. Again, if useful. + public func assertIsValid( + t : Tree, + compare : (K, K) -> Order.Order, + show : K -> Text) + { + Check.root({compare; show}, t) + }; + + public func assertIsValidTextKeys(t : Tree){ + Check.root({compare=Text.compare; show=func (t:Text) : Text { t }}, t) + }; + + /// Check that a B-Tree instance observes invariants of B-Trees. + /// Invariants ensure performance is what we expect. + /// For testing and debugging. + /// + /// Future refactoring --- Eventually, we can return Result or + /// Option so that both valid and invalid inputs can be inspected in + /// test cases. Doing assertions directly here is easier, for now. + module Check { + + type Inf = {#infmax; #infmin; #finite : K}; + + type InfCompare = { + compare : (Inf, Inf) -> Order.Order; + show : Inf -> Text + }; + + func infCompare(c : Compare) : InfCompare = { + show = func (k : Inf) : Text { + switch k { + case (#infmax) "#infmax"; + case (#infmin) "#infmin"; + case (#finite k) "#finite(" # c.show k # ")"; + } + }; + compare = func (k1 : Inf, k2 : Inf) : Order.Order { + switch (k1, k2) { + case (#infmin, _) #less; + case (_, #infmin) { /* nonsense case. */ assert false; loop { } }; + case (_, #infmax) #less; + case (#infmax, _) { /* nonsense case. */ assert false; loop { } }; + case (#finite(k1), #finite(k2)) c.compare(k1, k2); + } + } + }; + + public func root(compare : Compare, t : Tree) { + switch t { + case (#leaf _) { rec(#infmin, infCompare(compare), t, #infmax) }; + case (#internal i) { + if (i.data.size() == 0) { assert i.trees.size() == 0; return }; + if (i.trees.size() < 2) { assert false }; + rec(#infmin, infCompare(compare), t, #infmax) + }; + } + }; + + func rec(lower : Inf, c : InfCompare, t : Tree, upper : Inf) { + switch t { + case (#leaf(d)) { data(lower, c, d, upper) }; + case (#internal(i)) { internal(lower, c, i, upper) }; + } + }; + + func data(lower : Inf, c : InfCompare, d : Data, upper : Inf) { + var prev_k : Inf = #infmin; + for ((k, _) in d.vals()) { + if false { + Debug.print (c.show (#finite k)); + }; + assert (c.compare(prev_k, #finite k) == #less); + assert (c.compare(lower, #finite k) == #less); + assert (c.compare(#finite k, upper) == #less); + prev_k := #finite k; + }; + }; + + func internal(lower : Inf, c : InfCompare, i : Internal, upper : Inf) { + // counts make sense when there is one tree between each pair of + // consecutive key-value pairs; no key-value pairs on the end. + assert (i.trees.size() == i.data.size() + 1); + for (j in I.range(0, i.trees.size() - 1)) { + let lower_ = if (j == 0) { lower } else { #finite(i.data[j - 1].0) }; + let upper_ = if (j + 1 == i.trees.size()) { upper } else { #finite((i.data[j]).0) + }; + rec(lower_, c, i.trees[j], upper_) + } + }; + }; + +} diff --git a/test/BTreeTest.mo b/test/BTreeTest.mo new file mode 100644 index 00000000..41974dbc --- /dev/null +++ b/test/BTreeTest.mo @@ -0,0 +1,74 @@ +import Debug "mo:base/Debug"; +import BT "mo:base/BTree"; +import Nat "mo:base/Nat"; +import Text "mo:base/Text"; + +import Suite "mo:matchers/Suite"; +import M "mo:matchers/Matchers"; +import T "mo:matchers/Testable"; + +Debug.print "BTree tests: Begin."; + +let empty1 = #internal({data=[]; trees=[]}); +let empty2 = #leaf([]); +let leaf_of_one = #leaf([("oak", 1)]); +let leaf_of_two = #leaf([("ash", 1), ("oak", 2)]); +let leaf_of_three_a_c = #leaf([("apple", 1), ("ash", 4), ("crab apple", 3)]); +let leaf_of_three_s_w = #leaf([("salix", 11), ("sallows", 44), ("willow", 33)]); +let binary_internal = #internal( + { + data=[("pine", 42)]; + trees=[leaf_of_three_a_c, leaf_of_three_s_w] + }); + +/* +let _ = Suite.suite( + "constructions and checks.", + [ // These checks-as-assertions can be refactored into value-producing checks, + // if that seems useful. Then, they can be individual matchers tests. Again, if useful. + Suite.test("assertions.", try { +*/ + Debug.print "empty1."; + BT.assertIsValidTextKeys(empty1); + + Debug.print "empty2."; + BT.assertIsValidTextKeys(empty2); + + Debug.print "leaf of one."; + BT.assertIsValidTextKeys(leaf_of_one); + + Debug.print "leaf of two."; + BT.assertIsValidTextKeys(leaf_of_two); + + Debug.print "leaf of three. A-C"; + BT.assertIsValidTextKeys(leaf_of_three_a_c); + + Debug.print "leaf of three. S-W"; + BT.assertIsValidTextKeys(leaf_of_three_s_w); + + Debug.print "binary internal."; + BT.assertIsValidTextKeys(binary_internal); + +/* + true + } catch _ { false }, + M.equals(T.bool(true)) + )]); +*/ + +let _ = Suite.suite("find", [ + Suite.test("pine", + BT.find(binary_internal, "pine", Text.compare), + M.equals(T.optional(T.natTestable, ?42)) + ), + Suite.test("apple", + BT.find(binary_internal, "apple", Text.compare), + M.equals(T.optional(T.natTestable, ?1)) + ), + Suite.test("willow", + BT.find(binary_internal, "willow", Text.compare), + M.equals(T.optional(T.natTestable, ?33)) + ), +]); + +Debug.print "BTree tests: End.";