65 EQ \<Rightarrow> Node l (a, b) r | |
65 EQ \<Rightarrow> Node l (a, b) r | |
66 LT \<Rightarrow> let l' = insert x l in if incr l l' then balL l' a b r else Node l' (a,b) r | |
66 LT \<Rightarrow> let l' = insert x l in if incr l l' then balL l' a b r else Node l' (a,b) r | |
67 GT \<Rightarrow> let r' = insert x r in if incr r r' then balR l a b r' else Node l (a,b) r')" |
67 GT \<Rightarrow> let r' = insert x r in if incr r r' then balR l a b r' else Node l (a,b) r')" |
68 |
68 |
69 fun decr where |
69 fun decr where |
70 "decr t t' = (t \<noteq> Leaf \<and> (t' = Leaf \<or> \<not> is_bal t \<and> is_bal t'))" |
70 "decr t t' = (t \<noteq> Leaf \<and> incr t' t)" |
71 |
71 |
72 fun split_max :: "'a tree_bal \<Rightarrow> 'a tree_bal * 'a" where |
72 fun split_max :: "'a tree_bal \<Rightarrow> 'a tree_bal * 'a" where |
73 "split_max (Node l (a, ba) r) = |
73 "split_max (Node l (a, ba) r) = |
74 (if r = Leaf then (l,a) |
74 (if r = Leaf then (l,a) |
75 else let (r',a') = split_max r; |
75 else let (r',a') = split_max r; |
76 t' = if decr r r' then balL l a ba r' else Node l (a,ba) r' |
76 t' = if incr r' r then balL l a ba r' else Node l (a,ba) r' |
77 in (t', a'))" |
77 in (t', a'))" |
78 |
78 |
79 fun delete :: "'a::linorder \<Rightarrow> 'a tree_bal \<Rightarrow> 'a tree_bal" where |
79 fun delete :: "'a::linorder \<Rightarrow> 'a tree_bal \<Rightarrow> 'a tree_bal" where |
80 "delete _ Leaf = Leaf" | |
80 "delete _ Leaf = Leaf" | |
81 "delete x (Node l (a, ba) r) = |
81 "delete x (Node l (a, ba) r) = |
82 (case cmp x a of |
82 (case cmp x a of |
83 EQ \<Rightarrow> if l = Leaf then r |
83 EQ \<Rightarrow> if l = Leaf then r |
84 else let (l', a') = split_max l in |
84 else let (l', a') = split_max l in |
85 if decr l l' then balR l' a' ba r else Node l' (a',ba) r | |
85 if incr l' l then balR l' a' ba r else Node l' (a',ba) r | |
86 LT \<Rightarrow> let l' = delete x l in if decr l l' then balR l' a ba r else Node l' (a,ba) r | |
86 LT \<Rightarrow> let l' = delete x l in if decr l l' then balR l' a ba r else Node l' (a,ba) r | |
87 GT \<Rightarrow> let r' = delete x r in if decr r r' then balL l a ba r' else Node l (a,ba) r')" |
87 GT \<Rightarrow> let r' = delete x r in if decr r r' then balL l a ba r' else Node l (a,ba) r')" |
88 |
88 |
89 |
89 |
90 subsection \<open>Proofs\<close> |
90 subsection \<open>Proofs\<close> |
134 lemma height_1_iff: "avl t \<Longrightarrow> height t = Suc 0 \<longleftrightarrow> (\<exists>x. t = Node Leaf (x,Bal) Leaf)" |
134 lemma height_1_iff: "avl t \<Longrightarrow> height t = Suc 0 \<longleftrightarrow> (\<exists>x. t = Node Leaf (x,Bal) Leaf)" |
135 by(cases t) (auto split: splits prod.splits) |
135 by(cases t) (auto split: splits prod.splits) |
136 |
136 |
137 lemma avl_split_max: |
137 lemma avl_split_max: |
138 "\<lbrakk> split_max t = (t',a); avl t; t \<noteq> Leaf \<rbrakk> \<Longrightarrow> |
138 "\<lbrakk> split_max t = (t',a); avl t; t \<noteq> Leaf \<rbrakk> \<Longrightarrow> |
139 avl t' \<and> height t = height t' + (if decr t t' then 1 else 0)" |
139 avl t' \<and> height t = height t' + (if incr t' t then 1 else 0)" |
140 apply(induction t arbitrary: t' a rule: split_max_induct) |
140 apply(induction t arbitrary: t' a rule: split_max_induct) |
141 apply(auto simp: max_absorb1 max_absorb2 height_1_iff split!: splits prod.splits) |
141 apply(auto simp: max_absorb1 max_absorb2 height_1_iff split!: splits prod.splits) |
142 done |
142 done |
143 |
143 |
144 lemma avl_delete: "avl t \<Longrightarrow> |
144 lemma avl_delete: "avl t \<Longrightarrow> |