theory BPlusTree imports Main "HOL-Data_Structures.Sorted_Less""HOL-Data_Structures.Cmp""HOL-Library.Multiset" begin
(* some setup to cover up the redefinition of sorted in Sorted_Less
but keep the lemmas *)
hide_const (open) Sorted_Less.sorted abbreviation"sorted_less ≡ Sorted_Less.sorted"
section"Definition of the B-Plus-Tree"
subsection"Datatype definition"
text"B-Plus-Trees are basically B-Trees, that don't have empty Leafs but Leafs that contain the relevant data. "
text"The order of a B-tree is defined just as in the original paper by Bayer."
(* alt1: following knuths definition to allow for any
natural number as order and resolve ambiguity *) (* alt2: use range [k,2*k] allowing for valid bplustrees
from k=1 onwards NOTE this is what I ended up implementing *)
fun order:: "nat ==> 'a bplustree ==> bool"where "order k (Leaf ks) = ((length ks ≥ k) ∧ (length ks ≤ 2*k))" | "order k (Node ts t) = ( (length ts ≥ k) ∧ (length ts ≤ 2*k) ∧ (∀sub ∈ set (subtrees ts). order k sub) ∧ order k t )"
text‹The special condition for the root is called \textit{root\_order}›
(* the invariant for the root of the bplustree *) fun root_order:: "nat ==> 'a bplustree ==> bool"where "root_order k (Leaf ks) = (length ks ≤ 2*k)" | "root_order k (Node ts t) = ( (length ts > 0) ∧ (length ts ≤ 2*k) ∧ (∀s ∈ set (subtrees ts). order k s) ∧ order k t )"
subsection"Auxiliary Lemmas"
(* auxiliary lemmas when handling sets *) lemma separators_split: "set (separators (l@(a,b)#r)) = set (separators l) ∪ set (separators r) ∪ {b}" by simp
lemma subtrees_split: "set (subtrees (l@(a,b)#r)) = set (subtrees l) ∪ set (subtrees r) ∪ {a}" by simp
(* height and set lemmas *)
lemma finite_set_ins_swap: assumes"finite A" shows"max a (Max (Set.insert b A)) = max b (Max (Set.insert a A))" using Max_insert assms max.commute max.left_commute by fastforce
lemma finite_set_in_idem: assumes"finite A" shows"max a (Max (Set.insert a A)) = Max (Set.insert a A)" using Max_insert assms max.commute max.left_commute by fastforce
lemma height_Leaf: "height t = 0 ⟷ (∃ks. t = (Leaf ks))" by (induction t) (auto)
corollary sorted_inorder_subtrees: "sorted_less (inorder (Node ts t)) ==>∀ sub ∈set (subtrees ts). sorted_less (inorder sub)" using sorted_inorder_list_subtrees sorted_wrt_append by auto
corollary sorted_leaves_subtrees: "sorted_less (leaves (Node ts t)) ==>∀ sub ∈ set (subtrees ts). sorted_less (leaves sub)" using sorted_leaves_list_subtrees sorted_wrt_append by auto
text"Additional lemmas on the sortedness of the whole tree, which is correct alignment of navigation structure and leave data"
fun inbetween where "inbetween f l Nil t u = f l t u" | "inbetween f l ((sub,sep)#xs) t u = (f l sub sep ∧ inbetween f sep xs t u)"
thm fold_cong
lemma cong_inbetween[fundef_cong]: " \<lbrakk>a = b; xs = ys; ∧l' u' sub sep. (sub,sep) ∈ set ys ==> f l' sub u' = g l' sub u'; ∧l' u'. f l' a u' = g l' b u'] ==> inbetween f l xs a u = inbetween g l ys b u" apply(induction ys arbitrary: l a b u xs) apply auto apply fastforce+ done
(* adding l < u makes sorted_less inorder not necessary anymore *) fun aligned :: "'a ::linorder ==> _"where "aligned l (Leaf ks) u = (l < u ∧ (∀x ∈ set ks. l < x ∧ x ≤ u))" | "aligned l (Node ts t) u = (inbetween aligned l ts t u)"
lemma sorted_less_merge: "sorted_less (as@[a]) ==> sorted_less (a#bs) ==> sorted_less (as@a#bs)" using sorted_mid_iff by blast
thm aligned.simps
lemma leaves_cases: "x ∈ set (leaves (Node ts t)) ==> (∃(sub,sep) ∈ set ts. x ∈ set (leaves sub)) ∨ x ∈ set (leaves t)" apply (induction ts) apply auto done
lemma align_sub: "aligned l (Node ts t) u ==> (sub,sep) ∈ set ts ==>∃l' ∈ set (separators ts) ∪ {l}. aligned l' sub sep" apply(induction ts arbitrary: l) apply auto done
lemma align_last: "aligned l (Node (ts@[(sub,sep)]) t) u ==> aligned sep t u" apply(induction ts arbitrary: l) apply auto done
lemma align_last': "aligned l (Node ts t) u ==>∃l' ∈ set (separators ts) ∪ {l}. aligned l' t u" apply(induction ts arbitrary: l) apply auto done
lemma aligned_sorted_inorder: "aligned l t u ==> sorted_less (l#(inorder t)@[u])" proof(induction l t u rule: aligned.induct) case (2 l ts t u) thenshow ?case proof(cases ts) case Nil thenshow ?thesis using2by auto next case Cons thenobtain ts' sub sep where ts_split: "ts = ts'@[(sub,sep)]" by (metis list.distinct(1) rev_exhaust surj_pair) moreoverfrom2have"sorted_less (l#(inorder_list ts))" proof (induction ts arbitrary: l) case (Cons a ts') thenshow ?case proof (cases a) case (Pair sub sep) thenhave"aligned l sub sep""inbetween aligned sep ts' t u" using"Cons.prems"by simp+ thenhave"aligned sep (Node ts' t) u" by simp thenhave"sorted_less (sep#inorder_list ts')" using Cons by (metis insert_iff list.set(2)) moreoverhave"sorted_less (l#inorder sub@[sep])" using Cons by (metis Pair ‹aligned l sub sep› list.set_intros(1)) ultimatelyshow ?thesis using Pair sorted_less_merge[of "l#inorder sub" sep "inorder_list ts'"] by simp qed qed simp moreoverhave"sorted_less (sep#inorder t@[u])" proof - from2have"aligned sep t u" using align_last ts_split by blast thenshow ?thesis using"2.IH"by blast qed ultimatelyshow ?thesis using sorted_less_merge[of "l#inorder_list ts'@inorder sub" sep "inorder t@[u]"] by simp qed qed simp
lemma separators_in_inorder_list: "set (separators ts) ⊆ set (inorder_list ts)" apply (induction ts) apply auto done
lemma separators_in_inorder: "set (separators ts) ⊆ set (inorder (Node ts t))" by fastforce
lemma aligned_sorted_separators: "aligned l (Node ts t) u ==> sorted_less (l#(separators ts)@[u])" by (smt (verit, ccfv_threshold) aligned_sorted_inorder separators_in_inorder sorted_inorder_separators sorted_lems(2) sorted_wrt.simps(2) sorted_wrt_append subset_eq)
lemma aligned_leaves_inbetween: "aligned l t u ==>∀x ∈ set (leaves t). l < x ∧ x ≤ u" proof (induction l t u rule: aligned.induct) case (1 l ks u) thenshow ?caseby auto next case (2 l ts t u) have *: "sorted_less (l#inorder (Node ts t)@[u])" using"2.prems" aligned_sorted_inorder by blast show ?case proof fix x assume"x ∈ set (leaves (Node ts t))" then consider (sub) "∃(sub,sep) ∈ set ts. x ∈ set (leaves sub)" | (last) "x ∈ set (leaves t)" by fastforce thenshow"l < x ∧ x ≤ u" proof (cases) case sub thenobtain sub sep where"(sub,sep) ∈ set ts""x ∈ set (leaves sub)"by auto thenobtain l' where"aligned l' sub sep""l' ∈ set (separators ts) ∪ {l}" using"2.prems"(1) ‹(sub, sep) ∈ set ts› align_sub by blast thenhave"∀x ∈ set (leaves sub). l' < x ∧ x ≤ sep" using"2.IH"(1) ‹(sub,sep) ∈ set ts›by auto moreoverfrom * have"l ≤ l'" by (metis Un_insert_right ‹l' ∈ set (separators ts) ∪ {l}› append_Cons boolean_algebra_cancel.sup0 dual_order.eq_iff insert_iff less_imp_le separators_in_inorder sorted_snoc sorted_wrt.simps(2) subset_eq) moreoverfrom * have"sep ≤ u" by (metis ‹(sub, sep) ∈ set ts› less_imp_le list.set_intros(1) separators_in_inorder some_child_sub(2) sorted_mid_iff2 sorted_wrt_append subset_eq) ultimatelyshow ?thesis by (meson ‹x ∈ set (leaves sub)› order.strict_trans1 order.trans) next case last thenobtain l' where"aligned l' t u""l' ∈ set (separators ts) ∪ {l}" using align_last' "2.prems"by blast thenhave"∀x ∈ set (leaves t). l' < x ∧ x ≤ u" using"2.IH"(2) by auto moreoverfrom * have"l ≤ l'" by (metis Un_insert_right ‹l' ∈ set (separators ts) ∪ {l}› append_Cons boolean_algebra_cancel.sup0 dual_order.eq_iff insert_iff less_imp_le separators_in_inorder sorted_snoc sorted_wrt.simps(2) subset_eq) ultimatelyshow ?thesis by (meson ‹x ∈ set (leaves t)› order.strict_trans1 order.trans) qed qed qed
lemma aligned_leaves_list_inbetween: "aligned l (Node ts t) u ==>∀x ∈ set (leaves_list ts). l < x ∧ x ≤ u" by (metis Un_iff aligned_leaves_inbetween leaves.simps(2) set_append)
lemma aligned_split_left: "aligned l (Node (ls@(sub,sep)#rs) t) u ==> aligned l (Node ls sub) sep" apply(induction ls arbitrary: l) apply auto done
lemma aligned_split_right: "aligned l (Node (ls@(sub,sep)#rs) t) u ==> aligned sep (Node rs t) u" apply(induction ls arbitrary: l) apply auto done
lemma aligned_subst: "aligned l (Node (ls@(sub', subl)#(sub,subsep)#rs) t) u ==> aligned subl subsub subsep ==> aligned l (Node (ls@(sub',subl)#(subsub,subsep)#rs) t) u" apply (induction ls arbitrary: l) apply auto done
lemma aligned_subst_emptyls: "aligned l (Node ((sub,subsep)#rs) t) u ==> aligned l subsub subsep ==> aligned l (Node ((subsub,subsep)#rs) t) u" by auto
lemma aligned_subst_last: "aligned l (Node (ts'@[(sub', sep')]) t) u ==> aligned sep' t' u ==> aligned l (Node (ts'@[(sub', sep')]) t') u" apply (induction ts' arbitrary: l) apply auto done
fun Laligned :: "'a ::linorder bplustree ==> _"where "Laligned (Leaf ks) u = (∀x ∈ set ks. x ≤ u)" | "Laligned (Node ts t) u = (case ts of [] ==> (Laligned t u) | (sub,sep)#ts' ==> ((Laligned sub sep) ∧ inbetween aligned sep ts' t u))"
lemma Laligned_nonempty_Node: "Laligned (Node ((sub,sep)#ts') t) u = ((Laligned sub sep) ∧ inbetween aligned sep ts' t u)" by simp
lemma aligned_imp_Laligned: "aligned l t u ==> Laligned t u" apply (induction l t u rule: aligned.induct) apply simp
subgoal for l ts t u apply(cases ts) apply auto apply blast done done
lemma Lalign_sub: "Laligned (Node ((a,b)#ts) t) u ==> (sub,sep) ∈ set ts ==>∃l' ∈ set (separators ts) ∪ {b}. aligned l' sub sep" apply(induction ts arbitrary: a b) apply (auto dest!: aligned_imp_Laligned) done
lemma Lalign_last: "Laligned (Node (ts@[(sub,sep)]) t) u ==> aligned sep t u" by (cases ts) (auto simp add: align_last)
lemma Lalign_last': "Laligned (Node ((a,b)#ts) t) u ==>∃l' ∈ set (separators ts) ∪ {b}. aligned l' t u" apply(induction ts arbitrary: a b) apply (auto dest!: aligned_imp_Laligned) done
lemma Lalign_Llast: "Laligned (Node ts t) u ==> Laligned t u" apply(cases ts) apply auto using aligned_imp_Laligned Lalign_last' Laligned_nonempty_Node by metis
lemma Laligned_sorted_inorder: "Laligned t u ==> sorted_less ((inorder t)@[u])" proof(induction t u rule: Laligned.induct) case (1 ks u) thenshow ?caseby auto next case (2 ts t u) thenshow ?case apply (cases ts) apply auto by (metis aligned.simps(2) aligned_sorted_inorder append_assoc inorder.simps(2) sorted_less_merge) qed
lemma Laligned_sorted_separators: "Laligned (Node ts t) u ==> sorted_less ((separators ts)@[u])" by (smt (verit, del_insts) Laligned_sorted_inorder separators_in_inorder sorted_inorder_separators sorted_wrt_append subset_eq)
lemma Laligned_leaves_inbetween: "Laligned t u ==>∀x ∈ set (leaves t). x ≤ u" proof (induction t u rule: Laligned.induct) case (1 ks u) thenshow ?caseby auto next case (2 ts t u) have *: "sorted_less (inorder (Node ts t)@[u])" using"2.prems" Laligned_sorted_inorder by blast show ?case proof (cases ts) case Nil show ?thesis proof fix x assume"x ∈ set (leaves (Node ts t))" thenhave"x ∈ set (leaves t)" using Nil by auto moreoverhave"Laligned t u" using"2.prems" Nil by auto ultimatelyshow"x ≤ u" using"2.IH"(1) Nil by simp qed next case (Cons h ts') thenobtain a b where h_split: "h = (a,b)" by (cases h) show ?thesis proof fix x assume"x ∈ set (leaves (Node ts t))" then consider (first) "x ∈ set (leaves a)" | (sub) "∃(sub,sep) ∈ set ts'. x ∈ set (leaves sub)" | (last) "x ∈ set (leaves t)" using Cons h_split by fastforce thenshow"x ≤ u" proof (cases) case first moreoverhave"Laligned a b" using"2.prems" Cons h_split by auto moreoverhave"b ≤ u" by (metis "*" h_split less_imp_le list.set_intros(1) local.Cons separators_in_inorder some_child_sub(2) sorted_wrt_append subsetD) ultimatelyshow ?thesis using"2.IH"(2)[OF Cons sym[OF h_split]] by auto next case sub thenobtain sub sep where"(sub,sep) ∈ set ts'""x ∈ set (leaves sub)"by auto thenobtain l' where"aligned l' sub sep""l' ∈ set (separators ts') ∪ {b}" using"2.prems" Lalign_sub h_split local.Cons by blast thenhave"∀x ∈ set (leaves sub). l' < x ∧ x ≤ sep" by (meson aligned_leaves_inbetween) moreoverfrom * have"sep ≤ u" by (metis "2.prems" Laligned_sorted_separators ‹(sub, sep) ∈ set ts'› insert_iff less_imp_le list.set(2) local.Cons some_child_sub(2) sorted_wrt_append) ultimatelyshow ?thesis by (meson ‹x ∈ set (leaves sub)› order.strict_trans1 order.trans) next case last thenobtain l' where"aligned l' t u""l' ∈ set (separators ts') ∪ {b}" using"2.prems" Lalign_last' h_split local.Cons by blast thenhave"∀x ∈ set (leaves t). l' < x ∧ x ≤ u" by (meson aligned_leaves_inbetween) thenshow ?thesis by (meson ‹x ∈ set (leaves t)› order.strict_trans1 order.trans) qed qed qed qed
lemma Laligned_leaves_list_inbetween: "Laligned (Node ts t) u ==>∀x ∈ set (leaves_list ts). x ≤ u" by (metis Un_iff Laligned_leaves_inbetween leaves.simps(2) set_append)
lemma Laligned_subst_last: "Laligned (Node (ts'@[(sub', sep')]) t) u ==> aligned sep' t' u ==> Laligned (Node (ts'@[(sub', sep')]) t') u" apply (cases ts') apply (auto) by (meson aligned.simps(2) aligned_subst_last)
lemma concat_leaf_nodes_leaves: "(concat (map leaves (leaf_nodes t))) = leaves t" apply(induction t rule: leaf_nodes.induct)
subgoal by auto
subgoal for ts t apply(induction ts) apply simp apply auto done done
lemma leaf_nodes_not_empty: "leaf_nodes t ≠ []" by (induction t) auto
end
Messung V0.5 in Prozent
¤ Dauer der Verarbeitung: 0.4 Sekunden
(vorverarbeitet am 2026-06-10)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.