diff -r 11382acb0fc4 -r 161286c9d426 src/HOL/Data_Structures/Tree23_Set.thy --- a/src/HOL/Data_Structures/Tree23_Set.thy Mon Jul 29 16:22:12 2024 +0100 +++ b/src/HOL/Data_Structures/Tree23_Set.thy Wed Jul 31 10:36:28 2024 +0200 @@ -31,97 +31,97 @@ EQ \ True | GT \ isin r x))" -datatype 'a upI = TI "'a tree23" | OF "'a tree23" 'a "'a tree23" +datatype 'a up\<^sub>i = Eq\<^sub>i "'a tree23" | Of "'a tree23" 'a "'a tree23" -fun treeI :: "'a upI \ 'a tree23" where -"treeI (TI t) = t" | -"treeI (OF l a r) = Node2 l a r" +fun tree\<^sub>i :: "'a up\<^sub>i \ 'a tree23" where +"tree\<^sub>i (Eq\<^sub>i t) = t" | +"tree\<^sub>i (Of l a r) = Node2 l a r" -fun ins :: "'a::linorder \ 'a tree23 \ 'a upI" where -"ins x Leaf = OF Leaf x Leaf" | +fun ins :: "'a::linorder \ 'a tree23 \ 'a up\<^sub>i" where +"ins x Leaf = Of Leaf x Leaf" | "ins x (Node2 l a r) = (case cmp x a of LT \ (case ins x l of - TI l' => TI (Node2 l' a r) | - OF l1 b l2 => TI (Node3 l1 b l2 a r)) | - EQ \ TI (Node2 l a r) | + Eq\<^sub>i l' => Eq\<^sub>i (Node2 l' a r) | + Of l1 b l2 => Eq\<^sub>i (Node3 l1 b l2 a r)) | + EQ \ Eq\<^sub>i (Node2 l a r) | GT \ (case ins x r of - TI r' => TI (Node2 l a r') | - OF r1 b r2 => TI (Node3 l a r1 b r2)))" | + Eq\<^sub>i r' => Eq\<^sub>i (Node2 l a r') | + Of r1 b r2 => Eq\<^sub>i (Node3 l a r1 b r2)))" | "ins x (Node3 l a m b r) = (case cmp x a of LT \ (case ins x l of - TI l' => TI (Node3 l' a m b r) | - OF l1 c l2 => OF (Node2 l1 c l2) a (Node2 m b r)) | - EQ \ TI (Node3 l a m b r) | + Eq\<^sub>i l' => Eq\<^sub>i (Node3 l' a m b r) | + Of l1 c l2 => Of (Node2 l1 c l2) a (Node2 m b r)) | + EQ \ Eq\<^sub>i (Node3 l a m b r) | GT \ (case cmp x b of GT \ (case ins x r of - TI r' => TI (Node3 l a m b r') | - OF r1 c r2 => OF (Node2 l a m) b (Node2 r1 c r2)) | - EQ \ TI (Node3 l a m b r) | + Eq\<^sub>i r' => Eq\<^sub>i (Node3 l a m b r') | + Of r1 c r2 => Of (Node2 l a m) b (Node2 r1 c r2)) | + EQ \ Eq\<^sub>i (Node3 l a m b r) | LT \ (case ins x m of - TI m' => TI (Node3 l a m' b r) | - OF m1 c m2 => OF (Node2 l a m1) c (Node2 m2 b r))))" + Eq\<^sub>i m' => Eq\<^sub>i (Node3 l a m' b r) | + Of m1 c m2 => Of (Node2 l a m1) c (Node2 m2 b r))))" hide_const insert definition insert :: "'a::linorder \ 'a tree23 \ 'a tree23" where -"insert x t = treeI(ins x t)" +"insert x t = tree\<^sub>i(ins x t)" -datatype 'a upD = TD "'a tree23" | UF "'a tree23" +datatype 'a up\<^sub>d = Eq\<^sub>d "'a tree23" | Uf "'a tree23" -fun treeD :: "'a upD \ 'a tree23" where -"treeD (TD t) = t" | -"treeD (UF t) = t" +fun tree\<^sub>d :: "'a up\<^sub>d \ 'a tree23" where +"tree\<^sub>d (Eq\<^sub>d t) = t" | +"tree\<^sub>d (Uf t) = t" (* Variation: return None to signal no-change *) -fun node21 :: "'a upD \ 'a \ 'a tree23 \ 'a upD" where -"node21 (TD t1) a t2 = TD(Node2 t1 a t2)" | -"node21 (UF t1) a (Node2 t2 b t3) = UF(Node3 t1 a t2 b t3)" | -"node21 (UF t1) a (Node3 t2 b t3 c t4) = TD(Node2 (Node2 t1 a t2) b (Node2 t3 c t4))" +fun node21 :: "'a up\<^sub>d \ 'a \ 'a tree23 \ 'a up\<^sub>d" where +"node21 (Eq\<^sub>d t1) a t2 = Eq\<^sub>d(Node2 t1 a t2)" | +"node21 (Uf t1) a (Node2 t2 b t3) = Uf(Node3 t1 a t2 b t3)" | +"node21 (Uf t1) a (Node3 t2 b t3 c t4) = Eq\<^sub>d(Node2 (Node2 t1 a t2) b (Node2 t3 c t4))" -fun node22 :: "'a tree23 \ 'a \ 'a upD \ 'a upD" where -"node22 t1 a (TD t2) = TD(Node2 t1 a t2)" | -"node22 (Node2 t1 b t2) a (UF t3) = UF(Node3 t1 b t2 a t3)" | -"node22 (Node3 t1 b t2 c t3) a (UF t4) = TD(Node2 (Node2 t1 b t2) c (Node2 t3 a t4))" +fun node22 :: "'a tree23 \ 'a \ 'a up\<^sub>d \ 'a up\<^sub>d" where +"node22 t1 a (Eq\<^sub>d t2) = Eq\<^sub>d(Node2 t1 a t2)" | +"node22 (Node2 t1 b t2) a (Uf t3) = Uf(Node3 t1 b t2 a t3)" | +"node22 (Node3 t1 b t2 c t3) a (Uf t4) = Eq\<^sub>d(Node2 (Node2 t1 b t2) c (Node2 t3 a t4))" -fun node31 :: "'a upD \ 'a \ 'a tree23 \ 'a \ 'a tree23 \ 'a upD" where -"node31 (TD t1) a t2 b t3 = TD(Node3 t1 a t2 b t3)" | -"node31 (UF t1) a (Node2 t2 b t3) c t4 = TD(Node2 (Node3 t1 a t2 b t3) c t4)" | -"node31 (UF t1) a (Node3 t2 b t3 c t4) d t5 = TD(Node3 (Node2 t1 a t2) b (Node2 t3 c t4) d t5)" +fun node31 :: "'a up\<^sub>d \ 'a \ 'a tree23 \ 'a \ 'a tree23 \ 'a up\<^sub>d" where +"node31 (Eq\<^sub>d t1) a t2 b t3 = Eq\<^sub>d(Node3 t1 a t2 b t3)" | +"node31 (Uf t1) a (Node2 t2 b t3) c t4 = Eq\<^sub>d(Node2 (Node3 t1 a t2 b t3) c t4)" | +"node31 (Uf t1) a (Node3 t2 b t3 c t4) d t5 = Eq\<^sub>d(Node3 (Node2 t1 a t2) b (Node2 t3 c t4) d t5)" -fun node32 :: "'a tree23 \ 'a \ 'a upD \ 'a \ 'a tree23 \ 'a upD" where -"node32 t1 a (TD t2) b t3 = TD(Node3 t1 a t2 b t3)" | -"node32 t1 a (UF t2) b (Node2 t3 c t4) = TD(Node2 t1 a (Node3 t2 b t3 c t4))" | -"node32 t1 a (UF t2) b (Node3 t3 c t4 d t5) = TD(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" +fun node32 :: "'a tree23 \ 'a \ 'a up\<^sub>d \ 'a \ 'a tree23 \ 'a up\<^sub>d" where +"node32 t1 a (Eq\<^sub>d t2) b t3 = Eq\<^sub>d(Node3 t1 a t2 b t3)" | +"node32 t1 a (Uf t2) b (Node2 t3 c t4) = Eq\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" | +"node32 t1 a (Uf t2) b (Node3 t3 c t4 d t5) = Eq\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" -fun node33 :: "'a tree23 \ 'a \ 'a tree23 \ 'a \ 'a upD \ 'a upD" where -"node33 t1 a t2 b (TD t3) = TD(Node3 t1 a t2 b t3)" | -"node33 t1 a (Node2 t2 b t3) c (UF t4) = TD(Node2 t1 a (Node3 t2 b t3 c t4))" | -"node33 t1 a (Node3 t2 b t3 c t4) d (UF t5) = TD(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" +fun node33 :: "'a tree23 \ 'a \ 'a tree23 \ 'a \ 'a up\<^sub>d \ 'a up\<^sub>d" where +"node33 t1 a t2 b (Eq\<^sub>d t3) = Eq\<^sub>d(Node3 t1 a t2 b t3)" | +"node33 t1 a (Node2 t2 b t3) c (Uf t4) = Eq\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" | +"node33 t1 a (Node3 t2 b t3 c t4) d (Uf t5) = Eq\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" -fun split_min :: "'a tree23 \ 'a * 'a upD" where -"split_min (Node2 Leaf a Leaf) = (a, UF Leaf)" | -"split_min (Node3 Leaf a Leaf b Leaf) = (a, TD(Node2 Leaf b Leaf))" | +fun split_min :: "'a tree23 \ 'a * 'a up\<^sub>d" where +"split_min (Node2 Leaf a Leaf) = (a, Uf Leaf)" | +"split_min (Node3 Leaf a Leaf b Leaf) = (a, Eq\<^sub>d(Node2 Leaf b Leaf))" | "split_min (Node2 l a r) = (let (x,l') = split_min l in (x, node21 l' a r))" | "split_min (Node3 l a m b r) = (let (x,l') = split_min l in (x, node31 l' a m b r))" text \In the base cases of \split_min\ and \del\ it is enough to check if one subtree is a \Leaf\, in which case completeness implies that so are the others. Exercise.\ -fun del :: "'a::linorder \ 'a tree23 \ 'a upD" where -"del x Leaf = TD Leaf" | +fun del :: "'a::linorder \ 'a tree23 \ 'a up\<^sub>d" where +"del x Leaf = Eq\<^sub>d Leaf" | "del x (Node2 Leaf a Leaf) = - (if x = a then UF Leaf else TD(Node2 Leaf a Leaf))" | + (if x = a then Uf Leaf else Eq\<^sub>d(Node2 Leaf a Leaf))" | "del x (Node3 Leaf a Leaf b Leaf) = - TD(if x = a then Node2 Leaf b Leaf else + Eq\<^sub>d(if x = a then Node2 Leaf b Leaf else if x = b then Node2 Leaf a Leaf else Node3 Leaf a Leaf b Leaf)" | "del x (Node2 l a r) = @@ -140,7 +140,7 @@ GT \ node33 l a m b (del x r)))" definition delete :: "'a::linorder \ 'a tree23 \ 'a tree23" where -"delete x t = treeD(del x t)" +"delete x t = tree\<^sub>d(del x t)" subsection "Functional Correctness" @@ -154,8 +154,8 @@ subsubsection "Proofs for insert" lemma inorder_ins: - "sorted(inorder t) \ inorder(treeI(ins x t)) = ins_list x (inorder t)" -by(induction t) (auto simp: ins_list_simps split: upI.splits) + "sorted(inorder t) \ inorder(tree\<^sub>i(ins x t)) = ins_list x (inorder t)" +by(induction t) (auto simp: ins_list_simps split: up\<^sub>i.splits) lemma inorder_insert: "sorted(inorder t) \ inorder(insert a t) = ins_list a (inorder t)" @@ -165,23 +165,23 @@ subsubsection "Proofs for delete" lemma inorder_node21: "height r > 0 \ - inorder (treeD (node21 l' a r)) = inorder (treeD l') @ a # inorder r" + inorder (tree\<^sub>d (node21 l' a r)) = inorder (tree\<^sub>d l') @ a # inorder r" by(induct l' a r rule: node21.induct) auto lemma inorder_node22: "height l > 0 \ - inorder (treeD (node22 l a r')) = inorder l @ a # inorder (treeD r')" + inorder (tree\<^sub>d (node22 l a r')) = inorder l @ a # inorder (tree\<^sub>d r')" by(induct l a r' rule: node22.induct) auto lemma inorder_node31: "height m > 0 \ - inorder (treeD (node31 l' a m b r)) = inorder (treeD l') @ a # inorder m @ b # inorder r" + inorder (tree\<^sub>d (node31 l' a m b r)) = inorder (tree\<^sub>d l') @ a # inorder m @ b # inorder r" by(induct l' a m b r rule: node31.induct) auto lemma inorder_node32: "height r > 0 \ - inorder (treeD (node32 l a m' b r)) = inorder l @ a # inorder (treeD m') @ b # inorder r" + inorder (tree\<^sub>d (node32 l a m' b r)) = inorder l @ a # inorder (tree\<^sub>d m') @ b # inorder r" by(induct l a m' b r rule: node32.induct) auto lemma inorder_node33: "height m > 0 \ - inorder (treeD (node33 l a m b r')) = inorder l @ a # inorder m @ b # inorder (treeD r')" + inorder (tree\<^sub>d (node33 l a m b r')) = inorder l @ a # inorder m @ b # inorder (tree\<^sub>d r')" by(induct l a m b r' rule: node33.induct) auto lemmas inorder_nodes = inorder_node21 inorder_node22 @@ -189,12 +189,12 @@ lemma split_minD: "split_min t = (x,t') \ complete t \ height t > 0 \ - x # inorder(treeD t') = inorder t" + x # inorder(tree\<^sub>d t') = inorder t" by(induction t arbitrary: t' rule: split_min.induct) (auto simp: inorder_nodes split: prod.splits) lemma inorder_del: "\ complete t ; sorted(inorder t) \ \ - inorder(treeD (del x t)) = del_list x (inorder t)" + inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)" by(induction t rule: del.induct) (auto simp: del_list_simps inorder_nodes split_minD split!: if_split prod.splits) @@ -210,12 +210,12 @@ text\First a standard proof that \<^const>\ins\ preserves \<^const>\complete\.\ -fun hI :: "'a upI \ nat" where -"hI (TI t) = height t" | -"hI (OF l a r) = height l" +fun h\<^sub>i :: "'a up\<^sub>i \ nat" where +"h\<^sub>i (Eq\<^sub>i t) = height t" | +"h\<^sub>i (Of l a r) = height l" -lemma complete_ins: "complete t \ complete (treeI(ins a t)) \ hI(ins a t) = height t" -by (induct t) (auto split!: if_split upI.split) (* 15 secs in 2015 *) +lemma complete_ins: "complete t \ complete (tree\<^sub>i(ins a t)) \ h\<^sub>i(ins a t) = height t" +by (induct t) (auto split!: if_split up\<^sub>i.split) (* 15 secs in 2015 *) text\Now an alternative proof (by Brian Huffman) that runs faster because two properties (completeness and height) are combined in one predicate.\ @@ -260,15 +260,15 @@ by (auto elim!: complete_imp_full full_imp_complete) text \The \<^const>\insert\ function either preserves the height of the -tree, or increases it by one. The constructor returned by the \<^term>\insert\ function determines which: A return value of the form \<^term>\TI t\ indicates that the height will be the same. A value of the -form \<^term>\OF l p r\ indicates an increase in height.\ +tree, or increases it by one. The constructor returned by the \<^term>\insert\ function determines which: A return value of the form \<^term>\Eq\<^sub>i t\ indicates that the height will be the same. A value of the +form \<^term>\Of l p r\ indicates an increase in height.\ -fun full\<^sub>i :: "nat \ 'a upI \ bool" where -"full\<^sub>i n (TI t) \ full n t" | -"full\<^sub>i n (OF l p r) \ full n l \ full n r" +fun full\<^sub>i :: "nat \ 'a up\<^sub>i \ bool" where +"full\<^sub>i n (Eq\<^sub>i t) \ full n t" | +"full\<^sub>i n (Of l p r) \ full n l \ full n r" lemma full\<^sub>i_ins: "full n t \ full\<^sub>i n (ins a t)" -by (induct rule: full.induct) (auto split: upI.split) +by (induct rule: full.induct) (auto split: up\<^sub>i.split) text \The \<^const>\insert\ operation preserves completeance.\ @@ -283,82 +283,82 @@ subsection "Proofs for delete" -fun hD :: "'a upD \ nat" where -"hD (TD t) = height t" | -"hD (UF t) = height t + 1" +fun h\<^sub>d :: "'a up\<^sub>d \ nat" where +"h\<^sub>d (Eq\<^sub>d t) = height t" | +"h\<^sub>d (Uf t) = height t + 1" -lemma complete_treeD_node21: - "\complete r; complete (treeD l'); height r = hD l' \ \ complete (treeD (node21 l' a r))" +lemma complete_tree\<^sub>d_node21: + "\complete r; complete (tree\<^sub>d l'); height r = h\<^sub>d l' \ \ complete (tree\<^sub>d (node21 l' a r))" by(induct l' a r rule: node21.induct) auto -lemma complete_treeD_node22: - "\complete(treeD r'); complete l; hD r' = height l \ \ complete (treeD (node22 l a r'))" +lemma complete_tree\<^sub>d_node22: + "\complete(tree\<^sub>d r'); complete l; h\<^sub>d r' = height l \ \ complete (tree\<^sub>d (node22 l a r'))" by(induct l a r' rule: node22.induct) auto -lemma complete_treeD_node31: - "\ complete (treeD l'); complete m; complete r; hD l' = height r; height m = height r \ - \ complete (treeD (node31 l' a m b r))" +lemma complete_tree\<^sub>d_node31: + "\ complete (tree\<^sub>d l'); complete m; complete r; h\<^sub>d l' = height r; height m = height r \ + \ complete (tree\<^sub>d (node31 l' a m b r))" by(induct l' a m b r rule: node31.induct) auto -lemma complete_treeD_node32: - "\ complete l; complete (treeD m'); complete r; height l = height r; hD m' = height r \ - \ complete (treeD (node32 l a m' b r))" +lemma complete_tree\<^sub>d_node32: + "\ complete l; complete (tree\<^sub>d m'); complete r; height l = height r; h\<^sub>d m' = height r \ + \ complete (tree\<^sub>d (node32 l a m' b r))" by(induct l a m' b r rule: node32.induct) auto -lemma complete_treeD_node33: - "\ complete l; complete m; complete(treeD r'); height l = hD r'; height m = hD r' \ - \ complete (treeD (node33 l a m b r'))" +lemma complete_tree\<^sub>d_node33: + "\ complete l; complete m; complete(tree\<^sub>d r'); height l = h\<^sub>d r'; height m = h\<^sub>d r' \ + \ complete (tree\<^sub>d (node33 l a m b r'))" by(induct l a m b r' rule: node33.induct) auto -lemmas completes = complete_treeD_node21 complete_treeD_node22 - complete_treeD_node31 complete_treeD_node32 complete_treeD_node33 +lemmas completes = complete_tree\<^sub>d_node21 complete_tree\<^sub>d_node22 + complete_tree\<^sub>d_node31 complete_tree\<^sub>d_node32 complete_tree\<^sub>d_node33 lemma height'_node21: - "height r > 0 \ hD(node21 l' a r) = max (hD l') (height r) + 1" + "height r > 0 \ h\<^sub>d(node21 l' a r) = max (h\<^sub>d l') (height r) + 1" by(induct l' a r rule: node21.induct)(simp_all) lemma height'_node22: - "height l > 0 \ hD(node22 l a r') = max (height l) (hD r') + 1" + "height l > 0 \ h\<^sub>d(node22 l a r') = max (height l) (h\<^sub>d r') + 1" by(induct l a r' rule: node22.induct)(simp_all) lemma height'_node31: - "height m > 0 \ hD(node31 l a m b r) = - max (hD l) (max (height m) (height r)) + 1" + "height m > 0 \ h\<^sub>d(node31 l a m b r) = + max (h\<^sub>d l) (max (height m) (height r)) + 1" by(induct l a m b r rule: node31.induct)(simp_all add: max_def) lemma height'_node32: - "height r > 0 \ hD(node32 l a m b r) = - max (height l) (max (hD m) (height r)) + 1" + "height r > 0 \ h\<^sub>d(node32 l a m b r) = + max (height l) (max (h\<^sub>d m) (height r)) + 1" by(induct l a m b r rule: node32.induct)(simp_all add: max_def) lemma height'_node33: - "height m > 0 \ hD(node33 l a m b r) = - max (height l) (max (height m) (hD r)) + 1" + "height m > 0 \ h\<^sub>d(node33 l a m b r) = + max (height l) (max (height m) (h\<^sub>d r)) + 1" by(induct l a m b r rule: node33.induct)(simp_all add: max_def) lemmas heights = height'_node21 height'_node22 height'_node31 height'_node32 height'_node33 lemma height_split_min: - "split_min t = (x, t') \ height t > 0 \ complete t \ hD t' = height t" + "split_min t = (x, t') \ height t > 0 \ complete t \ h\<^sub>d t' = height t" by(induct t arbitrary: x t' rule: split_min.induct) (auto simp: heights split: prod.splits) -lemma height_del: "complete t \ hD(del x t) = height t" +lemma height_del: "complete t \ h\<^sub>d(del x t) = height t" by(induction x t rule: del.induct) (auto simp: heights max_def height_split_min split: prod.splits) lemma complete_split_min: - "\ split_min t = (x, t'); complete t; height t > 0 \ \ complete (treeD t')" + "\ split_min t = (x, t'); complete t; height t > 0 \ \ complete (tree\<^sub>d t')" by(induct t arbitrary: x t' rule: split_min.induct) (auto simp: heights height_split_min completes split: prod.splits) -lemma complete_treeD_del: "complete t \ complete(treeD(del x t))" +lemma complete_tree\<^sub>d_del: "complete t \ complete(tree\<^sub>d(del x t))" by(induction x t rule: del.induct) (auto simp: completes complete_split_min height_del height_split_min split: prod.splits) corollary complete_delete: "complete t \ complete(delete x t)" -by(simp add: delete_def complete_treeD_del) +by(simp add: delete_def complete_tree\<^sub>d_del) subsection \Overall Correctness\