diff -r c5232e6fb10b -r 3fb16bed5d6c src/HOL/Data_Structures/AA_Set.thy --- a/src/HOL/Data_Structures/AA_Set.thy Tue Sep 24 17:36:14 2019 +0200 +++ b/src/HOL/Data_Structures/AA_Set.thy Wed Sep 25 17:22:57 2019 +0200 @@ -10,67 +10,67 @@ Cmp begin -type_synonym 'a aa_tree = "('a,nat) tree" +type_synonym 'a aa_tree = "('a*nat) tree" definition empty :: "'a aa_tree" where "empty = Leaf" fun lvl :: "'a aa_tree \ nat" where "lvl Leaf = 0" | -"lvl (Node _ _ lv _) = lv" +"lvl (Node _ (_, lv) _) = lv" fun invar :: "'a aa_tree \ bool" where "invar Leaf = True" | -"invar (Node l a h r) = +"invar (Node l (a, h) r) = (invar l \ invar r \ - h = lvl l + 1 \ (h = lvl r + 1 \ (\lr b rr. r = Node lr b h rr \ h = lvl rr + 1)))" + h = lvl l + 1 \ (h = lvl r + 1 \ (\lr b rr. r = Node lr (b,h) rr \ h = lvl rr + 1)))" fun skew :: "'a aa_tree \ 'a aa_tree" where -"skew (Node (Node t1 b lvb t2) a lva t3) = - (if lva = lvb then Node t1 b lvb (Node t2 a lva t3) else Node (Node t1 b lvb t2) a lva t3)" | +"skew (Node (Node t1 (b, lvb) t2) (a, lva) t3) = + (if lva = lvb then Node t1 (b, lvb) (Node t2 (a, lva) t3) else Node (Node t1 (b, lvb) t2) (a, lva) t3)" | "skew t = t" fun split :: "'a aa_tree \ 'a aa_tree" where -"split (Node t1 a lva (Node t2 b lvb (Node t3 c lvc t4))) = +"split (Node t1 (a, lva) (Node t2 (b, lvb) (Node t3 (c, lvc) t4))) = (if lva = lvb \ lvb = lvc \ \\lva = lvc\ suffices\ - then Node (Node t1 a lva t2) b (lva+1) (Node t3 c lva t4) - else Node t1 a lva (Node t2 b lvb (Node t3 c lvc t4)))" | + then Node (Node t1 (a,lva) t2) (b,lva+1) (Node t3 (c, lva) t4) + else Node t1 (a,lva) (Node t2 (b,lvb) (Node t3 (c,lvc) t4)))" | "split t = t" hide_const (open) insert fun insert :: "'a::linorder \ 'a aa_tree \ 'a aa_tree" where -"insert x Leaf = Node Leaf x 1 Leaf" | -"insert x (Node t1 a lv t2) = +"insert x Leaf = Node Leaf (x, 1) Leaf" | +"insert x (Node t1 (a,lv) t2) = (case cmp x a of - LT \ split (skew (Node (insert x t1) a lv t2)) | - GT \ split (skew (Node t1 a lv (insert x t2))) | - EQ \ Node t1 x lv t2)" + LT \ split (skew (Node (insert x t1) (a,lv) t2)) | + GT \ split (skew (Node t1 (a,lv) (insert x t2))) | + EQ \ Node t1 (x, lv) t2)" fun sngl :: "'a aa_tree \ bool" where "sngl Leaf = False" | -"sngl (Node _ _ _ Leaf) = True" | -"sngl (Node _ _ lva (Node _ _ lvb _)) = (lva > lvb)" +"sngl (Node _ _ Leaf) = True" | +"sngl (Node _ (_, lva) (Node _ (_, lvb) _)) = (lva > lvb)" definition adjust :: "'a aa_tree \ 'a aa_tree" where "adjust t = (case t of - Node l x lv r \ + Node l (x,lv) r \ (if lvl l >= lv-1 \ lvl r >= lv-1 then t else - if lvl r < lv-1 \ sngl l then skew (Node l x (lv-1) r) else + if lvl r < lv-1 \ sngl l then skew (Node l (x,lv-1) r) else if lvl r < lv-1 then case l of - Node t1 a lva (Node t2 b lvb t3) - \ Node (Node t1 a lva t2) b (lvb+1) (Node t3 x (lv-1) r) + Node t1 (a,lva) (Node t2 (b,lvb) t3) + \ Node (Node t1 (a,lva) t2) (b,lvb+1) (Node t3 (x,lv-1) r) else - if lvl r < lv then split (Node l x (lv-1) r) + if lvl r < lv then split (Node l (x,lv-1) r) else case r of - Node t1 b lvb t4 \ + Node t1 (b,lvb) t4 \ (case t1 of - Node t2 a lva t3 - \ Node (Node l x (lv-1) t2) a (lva+1) - (split (Node t3 b (if sngl t1 then lva else lva+1) t4)))))" + Node t2 (a,lva) t3 + \ Node (Node l (x,lv-1) t2) (a,lva+1) + (split (Node t3 (b, if sngl t1 then lva else lva+1) t4)))))" text\In the paper, the last case of \<^const>\adjust\ is expressed with the help of an incorrect auxiliary function \texttt{nlvl}. @@ -81,20 +81,20 @@ is not restored.\ fun split_max :: "'a aa_tree \ 'a aa_tree * 'a" where -"split_max (Node l a lv Leaf) = (l,a)" | -"split_max (Node l a lv r) = (let (r',b) = split_max r in (adjust(Node l a lv r'), b))" +"split_max (Node l (a,lv) Leaf) = (l,a)" | +"split_max (Node l (a,lv) r) = (let (r',b) = split_max r in (adjust(Node l (a,lv) r'), b))" fun delete :: "'a::linorder \ 'a aa_tree \ 'a aa_tree" where "delete _ Leaf = Leaf" | -"delete x (Node l a lv r) = +"delete x (Node l (a,lv) r) = (case cmp x a of - LT \ adjust (Node (delete x l) a lv r) | - GT \ adjust (Node l a lv (delete x r)) | + LT \ adjust (Node (delete x l) (a,lv) r) | + GT \ adjust (Node l (a,lv) (delete x r)) | EQ \ (if l = Leaf then r - else let (l',b) = split_max l in adjust (Node l' b lv r)))" + else let (l',b) = split_max l in adjust (Node l' (b,lv) r)))" fun pre_adjust where -"pre_adjust (Node l a lv r) = (invar l \ invar r \ +"pre_adjust (Node l (a,lv) r) = (invar l \ invar r \ ((lv = lvl l + 1 \ (lv = lvl r + 1 \ lv = lvl r + 2 \ lv = lvl r \ sngl r)) \ (lv = lvl l + 2 \ (lv = lvl r + 1 \ lv = lvl r \ sngl r))))" @@ -103,23 +103,23 @@ subsection "Auxiliary Proofs" lemma split_case: "split t = (case t of - Node t1 x lvx (Node t2 y lvy (Node t3 z lvz t4)) \ + Node t1 (x,lvx) (Node t2 (y,lvy) (Node t3 (z,lvz) t4)) \ (if lvx = lvy \ lvy = lvz - then Node (Node t1 x lvx t2) y (lvx+1) (Node t3 z lvx t4) + then Node (Node t1 (x,lvx) t2) (y,lvx+1) (Node t3 (z,lvx) t4) else t) | t \ t)" by(auto split: tree.split) lemma skew_case: "skew t = (case t of - Node (Node t1 y lvy t2) x lvx t3 \ - (if lvx = lvy then Node t1 y lvx (Node t2 x lvx t3) else t) + Node (Node t1 (y,lvy) t2) (x,lvx) t3 \ + (if lvx = lvy then Node t1 (y, lvx) (Node t2 (x,lvx) t3) else t) | t \ t)" by(auto split: tree.split) lemma lvl_0_iff: "invar t \ lvl t = 0 \ t = Leaf" by(cases t) auto -lemma lvl_Suc_iff: "lvl t = Suc n \ (\ l a r. t = Node l a (Suc n) r)" +lemma lvl_Suc_iff: "lvl t = Suc n \ (\ l a r. t = Node l (a,Suc n) r)" by(cases t) auto lemma lvl_skew: "lvl (skew t) = lvl t" @@ -128,16 +128,16 @@ lemma lvl_split: "lvl (split t) = lvl t \ lvl (split t) = lvl t + 1 \ sngl (split t)" by(cases t rule: split.cases) auto -lemma invar_2Nodes:"invar (Node l x lv (Node rl rx rlv rr)) = - (invar l \ invar \rl, rx, rlv, rr\ \ lv = Suc (lvl l) \ +lemma invar_2Nodes:"invar (Node l (x,lv) (Node rl (rx, rlv) rr)) = + (invar l \ invar \rl, (rx, rlv), rr\ \ lv = Suc (lvl l) \ (lv = Suc rlv \ rlv = lv \ lv = Suc (lvl rr)))" by simp lemma invar_NodeLeaf[simp]: - "invar (Node l x lv Leaf) = (invar l \ lv = Suc (lvl l) \ lv = Suc 0)" + "invar (Node l (x,lv) Leaf) = (invar l \ lv = Suc (lvl l) \ lv = Suc 0)" by simp -lemma sngl_if_invar: "invar (Node l a n r) \ n = lvl r \ sngl r" +lemma sngl_if_invar: "invar (Node l (a, n) r) \ n = lvl r \ sngl r" by(cases r rule: sngl.cases) clarsimp+ @@ -167,7 +167,8 @@ thus ?thesis using 2 by (auto simp add: skew_case split_case split: tree.splits) next case GT - thus ?thesis using 2 proof (cases t1) + thus ?thesis using 2 + proof (cases t1 rule: tree2_cases) case Node thus ?thesis using 2 GT apply (auto simp add: skew_case split_case split: tree.splits) @@ -183,32 +184,32 @@ by(cases t rule: split.cases) clarsimp+ lemma invar_NodeL: - "\ invar(Node l x n r); invar l'; lvl l' = lvl l \ \ invar(Node l' x n r)" + "\ invar(Node l (x, n) r); invar l'; lvl l' = lvl l \ \ invar(Node l' (x, n) r)" by(auto) lemma invar_NodeR: - "\ invar(Node l x n r); n = lvl r + 1; invar r'; lvl r' = lvl r \ \ invar(Node l x n r')" + "\ invar(Node l (x, n) r); n = lvl r + 1; invar r'; lvl r' = lvl r \ \ invar(Node l (x, n) r')" by(auto) lemma invar_NodeR2: - "\ invar(Node l x n r); sngl r'; n = lvl r + 1; invar r'; lvl r' = n \ \ invar(Node l x n r')" + "\ invar(Node l (x, n) r); sngl r'; n = lvl r + 1; invar r'; lvl r' = n \ \ invar(Node l (x, n) r')" by(cases r' rule: sngl.cases) clarsimp+ lemma lvl_insert_incr_iff: "(lvl(insert a t) = lvl t + 1) \ - (\l x r. insert a t = Node l x (lvl t + 1) r \ lvl l = lvl r)" -apply(cases t) + (\l x r. insert a t = Node l (x, lvl t + 1) r \ lvl l = lvl r)" +apply(cases t rule: tree2_cases) apply(auto simp add: skew_case split_case split: if_splits) apply(auto split: tree.splits if_splits) done lemma invar_insert: "invar t \ invar(insert a t)" -proof(induction t) +proof(induction t rule: tree2_induct) case N: (Node l x n r) hence il: "invar l" and ir: "invar r" by auto note iil = N.IH(1)[OF il] note iir = N.IH(2)[OF ir] - let ?t = "Node l x n r" + let ?t = "Node l (x, n) r" have "a < x \ a = x \ x < a" by auto moreover have ?case if "a < x" @@ -218,16 +219,16 @@ by (simp add: skew_invar split_invar del: invar.simps) next case (Incr) - then obtain t1 w t2 where ial[simp]: "insert a l = Node t1 w n t2" + then obtain t1 w t2 where ial[simp]: "insert a l = Node t1 (w, n) t2" using N.prems by (auto simp: lvl_Suc_iff) have l12: "lvl t1 = lvl t2" by (metis Incr(1) ial lvl_insert_incr_iff tree.inject) - have "insert a ?t = split(skew(Node (insert a l) x n r))" + have "insert a ?t = split(skew(Node (insert a l) (x,n) r))" by(simp add: \a) - also have "skew(Node (insert a l) x n r) = Node t1 w n (Node t2 x n r)" + also have "skew(Node (insert a l) (x,n) r) = Node t1 (w,n) (Node t2 (x,n) r)" by(simp) also have "invar(split \)" - proof (cases r) + proof (cases r rule: tree2_cases) case Leaf hence "l = Leaf" using N.prems by(auto simp: lvl_0_iff) thus ?thesis using Leaf ial by simp @@ -249,14 +250,14 @@ thus ?case proof assume 0: "n = lvl r" - have "insert a ?t = split(skew(Node l x n (insert a r)))" + have "insert a ?t = split(skew(Node l (x, n) (insert a r)))" using \a>x\ by(auto) - also have "skew(Node l x n (insert a r)) = Node l x n (insert a r)" + also have "skew(Node l (x,n) (insert a r)) = Node l (x,n) (insert a r)" using N.prems by(simp add: skew_case split: tree.split) also have "invar(split \)" proof - from lvl_insert_sngl[OF ir sngl_if_invar[OF \invar ?t\ 0], of a] - obtain t1 y t2 where iar: "insert a r = Node t1 y n t2" + obtain t1 y t2 where iar: "insert a r = Node t1 (y,n) t2" using N.prems 0 by (auto simp: lvl_Suc_iff) from N.prems iar 0 iir show ?thesis by (auto simp: split_case split: tree.splits) @@ -285,21 +286,21 @@ subsubsection "Proofs for delete" -lemma invarL: "ASSUMPTION(invar \l, a, lv, r\) \ invar l" +lemma invarL: "ASSUMPTION(invar \l, (a, lv), r\) \ invar l" by(simp add: ASSUMPTION_def) -lemma invarR: "ASSUMPTION(invar \lv, l, a, r\) \ invar r" +lemma invarR: "ASSUMPTION(invar \l, (a,lv), r\) \ invar r" by(simp add: ASSUMPTION_def) lemma sngl_NodeI: - "sngl (Node l a lv r) \ sngl (Node l' a' lv r)" -by(cases r) (simp_all) + "sngl (Node l (a,lv) r) \ sngl (Node l' (a', lv) r)" +by(cases r rule: tree2_cases) (simp_all) declare invarL[simp] invarR[simp] lemma pre_cases: -assumes "pre_adjust (Node l x lv r)" +assumes "pre_adjust (Node l (x,lv) r)" obtains (tSngl) "invar l \ invar r \ lv = Suc (lvl r) \ lvl l = lvl r" | @@ -317,38 +318,39 @@ declare invar.simps(2)[simp del] invar_2Nodes[simp add] lemma invar_adjust: - assumes pre: "pre_adjust (Node l a lv r)" - shows "invar(adjust (Node l a lv r))" + assumes pre: "pre_adjust (Node l (a,lv) r)" + shows "invar(adjust (Node l (a,lv) r))" using pre proof (cases rule: pre_cases) case (tDouble) thus ?thesis unfolding adjust_def by (cases r) (auto simp: invar.simps(2)) next case (rDown) - from rDown obtain llv ll la lr where l: "l = Node ll la llv lr" by (cases l) auto + from rDown obtain llv ll la lr where l: "l = Node ll (la, llv) lr" by (cases l) auto from rDown show ?thesis unfolding adjust_def by (auto simp: l invar.simps(2) split: tree.splits) next case (lDown_tDouble) - from lDown_tDouble obtain rlv rr ra rl where r: "r = Node rl ra rlv rr" by (cases r) auto + from lDown_tDouble obtain rlv rr ra rl where r: "r = Node rl (ra, rlv) rr" by (cases r) auto from lDown_tDouble and r obtain rrlv rrr rra rrl where - rr :"rr = Node rrr rra rrlv rrl" by (cases rr) auto + rr :"rr = Node rrr (rra, rrlv) rrl" by (cases rr) auto from lDown_tDouble show ?thesis unfolding adjust_def r rr - apply (cases rl) apply (auto simp add: invar.simps(2) split!: if_split) + apply (cases rl rule: tree2_cases) apply (auto simp add: invar.simps(2) split!: if_split) using lDown_tDouble by (auto simp: split_case lvl_0_iff elim:lvl.elims split: tree.split) qed (auto simp: split_case invar.simps(2) adjust_def split: tree.splits) lemma lvl_adjust: - assumes "pre_adjust (Node l a lv r)" - shows "lv = lvl (adjust(Node l a lv r)) \ lv = lvl (adjust(Node l a lv r)) + 1" -using assms(1) proof(cases rule: pre_cases) + assumes "pre_adjust (Node l (a,lv) r)" + shows "lv = lvl (adjust(Node l (a,lv) r)) \ lv = lvl (adjust(Node l (a,lv) r)) + 1" +using assms(1) +proof(cases rule: pre_cases) case lDown_tSngl thus ?thesis - using lvl_split[of "\l, a, lvl r, r\"] by (auto simp: adjust_def) + using lvl_split[of "\l, (a, lvl r), r\"] by (auto simp: adjust_def) next case lDown_tDouble thus ?thesis by (auto simp: adjust_def invar.simps(2) split: tree.split) qed (auto simp: adjust_def split: tree.splits) -lemma sngl_adjust: assumes "pre_adjust (Node l a lv r)" - "sngl \l, a, lv, r\" "lv = lvl (adjust \l, a, lv, r\)" - shows "sngl (adjust \l, a, lv, r\)" +lemma sngl_adjust: assumes "pre_adjust (Node l (a,lv) r)" + "sngl \l, (a, lv), r\" "lv = lvl (adjust \l, (a, lv), r\)" + shows "sngl (adjust \l, (a, lv), r\)" using assms proof (cases rule: pre_cases) case rDown thus ?thesis using assms(2,3) unfolding adjust_def @@ -361,38 +363,38 @@ (lvl t' = lvl t \ sngl t \ sngl t')" lemma pre_adj_if_postR: - "invar\lv, l, a, r\ \ post_del r r' \ pre_adjust \lv, l, a, r'\" + "invar\lv, (l, a), r\ \ post_del r r' \ pre_adjust \lv, (l, a), r'\" by(cases "sngl r") (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims) lemma pre_adj_if_postL: - "invar\l, a, lv, r\ \ post_del l l' \ pre_adjust \l', b, lv, r\" + "invar\l, (a, lv), r\ \ post_del l l' \ pre_adjust \l', (b, lv), r\" by(cases "sngl r") (auto simp: pre_adjust.simps post_del_def invar.simps(2) elim: sngl.elims) lemma post_del_adjL: - "\ invar\l, a, lv, r\; pre_adjust \l', b, lv, r\ \ - \ post_del \l, a, lv, r\ (adjust \l', b, lv, r\)" + "\ invar\l, (a, lv), r\; pre_adjust \l', (b, lv), r\ \ + \ post_del \l, (a, lv), r\ (adjust \l', (b, lv), r\)" unfolding post_del_def by (metis invar_adjust lvl_adjust sngl_NodeI sngl_adjust lvl.simps(2)) lemma post_del_adjR: -assumes "invar\lv, l, a, r\" "pre_adjust \lv, l, a, r'\" "post_del r r'" -shows "post_del \lv, l, a, r\ (adjust \lv, l, a, r'\)" +assumes "invar\l, (a,lv), r\" "pre_adjust \l, (a,lv), r'\" "post_del r r'" +shows "post_del \l, (a,lv), r\ (adjust \l, (a,lv), r'\)" proof(unfold post_del_def, safe del: disjCI) - let ?t = "\lv, l, a, r\" - let ?t' = "adjust \lv, l, a, r'\" + let ?t = "\l, (a,lv), r\" + let ?t' = "adjust \l, (a,lv), r'\" show "invar ?t'" by(rule invar_adjust[OF assms(2)]) show "lvl ?t' = lvl ?t \ lvl ?t' + 1 = lvl ?t" using lvl_adjust[OF assms(2)] by auto show "sngl ?t'" if as: "lvl ?t' = lvl ?t" "sngl ?t" proof - - have s: "sngl \lv, l, a, r'\" - proof(cases r') + have s: "sngl \l, (a,lv), r'\" + proof(cases r' rule: tree2_cases) case Leaf thus ?thesis by simp next case Node thus ?thesis using as(2) assms(1,3) - by (cases r) (auto simp: post_del_def) + by (cases r rule: tree2_cases) (auto simp: post_del_def) qed show ?thesis using as(1) sngl_adjust[OF assms(2) s] by simp qed @@ -403,22 +405,22 @@ theorem post_split_max: "\ invar t; (t', x) = split_max t; t \ Leaf \ \ post_del t t'" proof (induction t arbitrary: t' rule: split_max.induct) - case (2 lv l a lvr rl ra rr) - let ?r = "\lvr, rl, ra, rr\" - let ?t = "\lv, l, a, ?r\" + case (2 l a lv rl bl rr) + let ?r = "\rl, bl, rr\" + let ?t = "\l, (a, lv), ?r\" from "2.prems"(2) obtain r' where r': "(r', x) = split_max ?r" - and [simp]: "t' = adjust \lv, l, a, r'\" by auto + and [simp]: "t' = adjust \l, (a, lv), r'\" by auto from "2.IH"[OF _ r'] \invar ?t\ have post: "post_del ?r r'" by simp note preR = pre_adj_if_postR[OF \invar ?t\ post] show ?case by (simp add: post_del_adjR[OF "2.prems"(1) preR post]) qed (auto simp: post_del_def) theorem post_delete: "invar t \ post_del t (delete x t)" -proof (induction t) +proof (induction t rule: tree2_induct) case (Node l a lv r) let ?l' = "delete x l" and ?r' = "delete x r" - let ?t = "Node l a lv r" let ?t' = "delete x ?t" + let ?t = "Node l (a,lv) r" let ?t' = "delete x ?t" from Node.prems have inv_l: "invar l" and inv_r: "invar r" by (auto)