diff -r fb788bd799d9 -r cd0b0717c4e4 src/HOL/Data_Structures/RBT_Set.thy --- a/src/HOL/Data_Structures/RBT_Set.thy Sat Dec 28 23:44:26 2019 +0100 +++ b/src/HOL/Data_Structures/RBT_Set.thy Tue Jan 07 06:43:09 2020 +0100 @@ -96,6 +96,9 @@ subsection \Structural invariants\ +lemma neq_Black[simp]: "(c \ Black) = (c = Red)" +by (cases c) auto + text\The proofs are due to Markus Reiter and Alexander Krauss.\ fun bheight :: "'a rbt \ nat" where @@ -176,7 +179,7 @@ theorem rbt_insert: "rbt t \ rbt (insert x t)" by (simp add: invc_ins invh_ins color_paint_Black invh_paint rbt_def insert_def) -text \All in one variant:\ +text \All in one:\ lemma inv_ins: "\ invc t; invh t \ \ invc2 (ins x t) \ (color t = Black \ invc (ins x t)) \ @@ -234,34 +237,41 @@ by (induct l r rule: combine.induct) (auto simp: invc_baldL invc2I split: tree.splits color.splits) +text \All in one:\ + +lemma inv_baldL: + "\ invh l; invh r; bheight l + 1 = bheight r; invc2 l; invc r \ + \ invh (baldL l a r) \ bheight (baldL l a r) = bheight r + \ invc2 (baldL l a r) \ (color r = Black \ invc (baldL l a r))" +by (induct l a r rule: baldL.induct) + (auto simp: inv_baliR invh_paint bheight_baliR bheight_paint_Red paint2 invc2I) + +lemma inv_baldR: + "\ invh l; invh r; bheight l = bheight r + 1; invc l; invc2 r \ + \ invh (baldR l a r) \ bheight (baldR l a r) = bheight l + \ invc2 (baldR l a r) \ (color l = Black \ invc (baldR l a r))" +by (induct l a r rule: baldR.induct) + (auto simp: inv_baliL invh_paint bheight_baliL bheight_paint_Red paint2 invc2I) + +lemma inv_combine: + "\ invh l; invh r; bheight l = bheight r; invc l; invc r \ + \ invh (combine l r) \ bheight (combine l r) = bheight l + \ invc2 (combine l r) \ (color l = Black \ color r = Black \ invc (combine l r))" +by (induct l r rule: combine.induct) + (auto simp: invh_baldL_Black inv_baldL invc2I split: tree.splits color.splits) + lemma neq_LeafD: "t \ Leaf \ \l x c r. t = Node l (x,c) r" by(cases t rule: tree2_cases) auto -lemma del_invc_invh: "invh t \ invc t \ invh (del x t) \ +lemma inv_del: "\ invh t; invc t \ \ + invh (del x t) \ (color t = Red \ bheight (del x t) = bheight t \ invc (del x t) \ color t = Black \ bheight (del x t) = bheight t - 1 \ invc2 (del x t))" -proof (induct x t rule: del.induct) -case (2 x _ y c) - have "x = y \ x < y \ x > y" by auto - thus ?case proof (elim disjE) - assume "x = y" - with 2 show ?thesis - by (cases c) (simp_all add: invh_combine invc_combine) - next - assume "x < y" - with 2 show ?thesis - by(cases c) - (auto simp: invh_baldL_invc invc_baldL invc2_baldL dest: neq_LeafD) - next - assume "y < x" - with 2 show ?thesis - by(cases c) - (auto simp: invh_baldR_invc invc_baldR invc2_baldR dest: neq_LeafD) - qed -qed auto +by(induct x t rule: del.induct) + (auto simp: inv_baldL inv_baldR inv_combine dest!: neq_LeafD) theorem rbt_delete: "rbt t \ rbt (delete x t)" -by (metis delete_def rbt_def color_paint_Black del_invc_invh invc2I invh_paint) +by (metis delete_def rbt_def color_paint_Black inv_del invc2I invh_paint) text \Overall correctness:\ @@ -287,9 +297,6 @@ subsection \Height-Size Relation\ -lemma neq_Black[simp]: "(c \ Black) = (c = Red)" -by (cases c) auto - lemma rbt_height_bheight_if: "invc t \ invh t \ height t \ 2 * bheight t + (if color t = Black then 0 else 1)" by(induction t) (auto split: if_split_asm)