no CRLF
authornipkow
Wed Nov 11 18:32:26 2015 +0100 (2015-11-11)
changeset 6164044c9198f210c
parent 61638 7ffc9c4f1f74
child 61641 34460a266346
no CRLF
src/HOL/Data_Structures/AList_Upd_Del.thy
src/HOL/Data_Structures/Cmp.thy
src/HOL/Data_Structures/Less_False.thy
src/HOL/Data_Structures/List_Ins_Del.thy
src/HOL/Data_Structures/Map_by_Ordered.thy
src/HOL/Data_Structures/Set_by_Ordered.thy
src/HOL/Data_Structures/Sorted_Less.thy
src/HOL/Data_Structures/Tree23.thy
src/HOL/Data_Structures/Tree234.thy
src/HOL/Data_Structures/Tree234_Map.thy
src/HOL/Data_Structures/Tree234_Set.thy
src/HOL/Data_Structures/Tree23_Map.thy
src/HOL/Data_Structures/Tree23_Set.thy
src/HOL/Data_Structures/Tree_Map.thy
src/HOL/Data_Structures/Tree_Set.thy
     1.1 --- a/src/HOL/Data_Structures/AList_Upd_Del.thy	Wed Nov 11 16:42:30 2015 +0100
     1.2 +++ b/src/HOL/Data_Structures/AList_Upd_Del.thy	Wed Nov 11 18:32:26 2015 +0100
     1.3 @@ -1,142 +1,142 @@
     1.4 -(* Author: Tobias Nipkow *)
     1.5 -
     1.6 -section {* Association List Update and Deletion *}
     1.7 -
     1.8 -theory AList_Upd_Del
     1.9 -imports Sorted_Less
    1.10 -begin
    1.11 -
    1.12 -abbreviation "sorted1 ps \<equiv> sorted(map fst ps)"
    1.13 -
    1.14 -text{* Define own @{text map_of} function to avoid pulling in an unknown
    1.15 -amount of lemmas implicitly (via the simpset). *}
    1.16 -
    1.17 -hide_const (open) map_of
    1.18 -
    1.19 -fun map_of :: "('a*'b)list \<Rightarrow> 'a \<Rightarrow> 'b option" where
    1.20 -"map_of [] = (\<lambda>x. None)" |
    1.21 -"map_of ((a,b)#ps) = (\<lambda>x. if x=a then Some b else map_of ps x)"
    1.22 -
    1.23 -text \<open>Updating an association list:\<close>
    1.24 -
    1.25 -fun upd_list :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) list \<Rightarrow> ('a*'b) list" where
    1.26 -"upd_list x y [] = [(x,y)]" |
    1.27 -"upd_list x y ((a,b)#ps) =
    1.28 -  (if x < a then (x,y)#(a,b)#ps else
    1.29 -  if x = a then (x,y)#ps else (a,b) # upd_list x y ps)"
    1.30 -
    1.31 -fun del_list :: "'a::linorder \<Rightarrow> ('a*'b)list \<Rightarrow> ('a*'b)list" where
    1.32 -"del_list x [] = []" |
    1.33 -"del_list x ((a,b)#ps) = (if x = a then ps else (a,b) # del_list x ps)"
    1.34 -
    1.35 -
    1.36 -subsection \<open>Lemmas for @{const map_of}\<close>
    1.37 -
    1.38 -lemma map_of_ins_list: "map_of (upd_list x y ps) = (map_of ps)(x := Some y)"
    1.39 -by(induction ps) auto
    1.40 -
    1.41 -lemma map_of_append: "map_of (ps @ qs) x =
    1.42 -  (case map_of ps x of None \<Rightarrow> map_of qs x | Some y \<Rightarrow> Some y)"
    1.43 -by(induction ps)(auto)
    1.44 -
    1.45 -lemma map_of_None: "sorted (x # map fst ps) \<Longrightarrow> map_of ps x = None"
    1.46 -by (induction ps) (auto simp: sorted_lems sorted_Cons_iff)
    1.47 -
    1.48 -lemma map_of_None2: "sorted (map fst ps @ [x]) \<Longrightarrow> map_of ps x = None"
    1.49 -by (induction ps) (auto simp: sorted_lems)
    1.50 -
    1.51 -lemma map_of_del_list: "sorted1 ps \<Longrightarrow>
    1.52 -  map_of(del_list x ps) = (map_of ps)(x := None)"
    1.53 -by(induction ps) (auto simp: map_of_None sorted_lems fun_eq_iff)
    1.54 -
    1.55 -lemma map_of_sorted_Cons: "sorted (a # map fst ps) \<Longrightarrow> x < a \<Longrightarrow>
    1.56 -   map_of ps x = None"
    1.57 -by (meson less_trans map_of_None sorted_Cons_iff)
    1.58 -
    1.59 -lemma map_of_sorted_snoc: "sorted (map fst ps @ [a]) \<Longrightarrow> a \<le> x \<Longrightarrow>
    1.60 -  map_of ps x = None"
    1.61 -by (meson le_less_trans map_of_None2 not_less sorted_snoc_iff)
    1.62 -
    1.63 -lemmas map_of_sorteds = map_of_sorted_Cons map_of_sorted_snoc
    1.64 -lemmas map_of_simps = sorted_lems map_of_append map_of_sorteds
    1.65 -
    1.66 -
    1.67 -subsection \<open>Lemmas for @{const upd_list}\<close>
    1.68 -
    1.69 -lemma sorted_upd_list: "sorted1 ps \<Longrightarrow> sorted1 (upd_list x y ps)"
    1.70 -apply(induction ps)
    1.71 - apply simp
    1.72 -apply(case_tac ps)
    1.73 - apply auto
    1.74 -done
    1.75 -
    1.76 -lemma upd_list_sorted1: "\<lbrakk> sorted (map fst ps @ [a]); x < a \<rbrakk> \<Longrightarrow>
    1.77 -  upd_list x y (ps @ (a,b) # qs) =  upd_list x y ps @ (a,b) # qs"
    1.78 -by(induction ps) (auto simp: sorted_lems)
    1.79 -
    1.80 -lemma upd_list_sorted2: "\<lbrakk> sorted (map fst ps @ [a]); a \<le> x \<rbrakk> \<Longrightarrow>
    1.81 -  upd_list x y (ps @ (a,b) # qs) = ps @ upd_list x y ((a,b) # qs)"
    1.82 -by(induction ps) (auto simp: sorted_lems)
    1.83 -
    1.84 -lemmas upd_list_simps = sorted_lems upd_list_sorted1 upd_list_sorted2
    1.85 -
    1.86 -(*
    1.87 -lemma set_ins_list[simp]: "set (ins_list x xs) = insert x (set xs)"
    1.88 -by(induction xs) auto
    1.89 -
    1.90 -lemma distinct_if_sorted: "sorted xs \<Longrightarrow> distinct xs"
    1.91 -apply(induction xs rule: sorted.induct)
    1.92 -apply auto
    1.93 -by (metis in_set_conv_decomp_first less_imp_not_less sorted_mid_iff2)
    1.94 -
    1.95 -lemma set_del_list_eq [simp]: "distinct xs ==> set(del_list x xs) = set xs - {x}"
    1.96 -apply(induct xs)
    1.97 - apply simp
    1.98 -apply simp
    1.99 -apply blast
   1.100 -done
   1.101 -*)
   1.102 -
   1.103 -
   1.104 -subsection \<open>Lemmas for @{const del_list}\<close>
   1.105 -
   1.106 -lemma sorted_del_list: "sorted1 ps \<Longrightarrow> sorted1 (del_list x ps)"
   1.107 -apply(induction ps)
   1.108 - apply simp
   1.109 -apply(case_tac ps)
   1.110 -apply auto
   1.111 -by (meson order.strict_trans sorted_Cons_iff)
   1.112 -
   1.113 -lemma del_list_idem: "x \<notin> set(map fst xs) \<Longrightarrow> del_list x xs = xs"
   1.114 -by (induct xs) auto
   1.115 -
   1.116 -lemma del_list_sorted1: "sorted1 (xs @ [(a,b)]) \<Longrightarrow> a \<le> x \<Longrightarrow>
   1.117 -  del_list x (xs @ (a,b) # ys) = xs @ del_list x ((a,b) # ys)"
   1.118 -by (induction xs) (auto simp: sorted_mid_iff2)
   1.119 -
   1.120 -lemma del_list_sorted2: "sorted1 (xs @ (a,b) # ys) \<Longrightarrow> x < a \<Longrightarrow>
   1.121 -  del_list x (xs @ (a,b) # ys) = del_list x xs @ (a,b) # ys"
   1.122 -by (induction xs) (fastforce simp: sorted_Cons_iff intro!: del_list_idem)+
   1.123 -
   1.124 -lemma del_list_sorted3:
   1.125 -  "sorted1 (xs @ (a,a') # ys @ (b,b') # zs) \<Longrightarrow> x < b \<Longrightarrow>
   1.126 -  del_list x (xs @ (a,a') # ys @ (b,b') # zs) = del_list x (xs @ (a,a') # ys) @ (b,b') # zs"
   1.127 -by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted2 ball_Un)
   1.128 -
   1.129 -lemma del_list_sorted4:
   1.130 -  "sorted1 (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us) \<Longrightarrow> x < c \<Longrightarrow>
   1.131 -  del_list x (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us) = del_list x (xs @ (a,a') # ys @ (b,b') # zs) @ (c,c') # us"
   1.132 -by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted3)
   1.133 -
   1.134 -lemma del_list_sorted5:
   1.135 -  "sorted1 (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us @ (d,d') # vs) \<Longrightarrow> x < d \<Longrightarrow>
   1.136 -   del_list x (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us @ (d,d') # vs) =
   1.137 -   del_list x (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us) @ (d,d') # vs" 
   1.138 -by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted4)
   1.139 -
   1.140 -lemmas del_list_sorted =
   1.141 -  del_list_sorted1 del_list_sorted2 del_list_sorted3 del_list_sorted4 del_list_sorted5
   1.142 -
   1.143 -lemmas del_list_simps = sorted_lems del_list_sorted
   1.144 -
   1.145 -end
   1.146 +(* Author: Tobias Nipkow *)
   1.147 +
   1.148 +section {* Association List Update and Deletion *}
   1.149 +
   1.150 +theory AList_Upd_Del
   1.151 +imports Sorted_Less
   1.152 +begin
   1.153 +
   1.154 +abbreviation "sorted1 ps \<equiv> sorted(map fst ps)"
   1.155 +
   1.156 +text{* Define own @{text map_of} function to avoid pulling in an unknown
   1.157 +amount of lemmas implicitly (via the simpset). *}
   1.158 +
   1.159 +hide_const (open) map_of
   1.160 +
   1.161 +fun map_of :: "('a*'b)list \<Rightarrow> 'a \<Rightarrow> 'b option" where
   1.162 +"map_of [] = (\<lambda>x. None)" |
   1.163 +"map_of ((a,b)#ps) = (\<lambda>x. if x=a then Some b else map_of ps x)"
   1.164 +
   1.165 +text \<open>Updating an association list:\<close>
   1.166 +
   1.167 +fun upd_list :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> ('a*'b) list \<Rightarrow> ('a*'b) list" where
   1.168 +"upd_list x y [] = [(x,y)]" |
   1.169 +"upd_list x y ((a,b)#ps) =
   1.170 +  (if x < a then (x,y)#(a,b)#ps else
   1.171 +  if x = a then (x,y)#ps else (a,b) # upd_list x y ps)"
   1.172 +
   1.173 +fun del_list :: "'a::linorder \<Rightarrow> ('a*'b)list \<Rightarrow> ('a*'b)list" where
   1.174 +"del_list x [] = []" |
   1.175 +"del_list x ((a,b)#ps) = (if x = a then ps else (a,b) # del_list x ps)"
   1.176 +
   1.177 +
   1.178 +subsection \<open>Lemmas for @{const map_of}\<close>
   1.179 +
   1.180 +lemma map_of_ins_list: "map_of (upd_list x y ps) = (map_of ps)(x := Some y)"
   1.181 +by(induction ps) auto
   1.182 +
   1.183 +lemma map_of_append: "map_of (ps @ qs) x =
   1.184 +  (case map_of ps x of None \<Rightarrow> map_of qs x | Some y \<Rightarrow> Some y)"
   1.185 +by(induction ps)(auto)
   1.186 +
   1.187 +lemma map_of_None: "sorted (x # map fst ps) \<Longrightarrow> map_of ps x = None"
   1.188 +by (induction ps) (auto simp: sorted_lems sorted_Cons_iff)
   1.189 +
   1.190 +lemma map_of_None2: "sorted (map fst ps @ [x]) \<Longrightarrow> map_of ps x = None"
   1.191 +by (induction ps) (auto simp: sorted_lems)
   1.192 +
   1.193 +lemma map_of_del_list: "sorted1 ps \<Longrightarrow>
   1.194 +  map_of(del_list x ps) = (map_of ps)(x := None)"
   1.195 +by(induction ps) (auto simp: map_of_None sorted_lems fun_eq_iff)
   1.196 +
   1.197 +lemma map_of_sorted_Cons: "sorted (a # map fst ps) \<Longrightarrow> x < a \<Longrightarrow>
   1.198 +   map_of ps x = None"
   1.199 +by (meson less_trans map_of_None sorted_Cons_iff)
   1.200 +
   1.201 +lemma map_of_sorted_snoc: "sorted (map fst ps @ [a]) \<Longrightarrow> a \<le> x \<Longrightarrow>
   1.202 +  map_of ps x = None"
   1.203 +by (meson le_less_trans map_of_None2 not_less sorted_snoc_iff)
   1.204 +
   1.205 +lemmas map_of_sorteds = map_of_sorted_Cons map_of_sorted_snoc
   1.206 +lemmas map_of_simps = sorted_lems map_of_append map_of_sorteds
   1.207 +
   1.208 +
   1.209 +subsection \<open>Lemmas for @{const upd_list}\<close>
   1.210 +
   1.211 +lemma sorted_upd_list: "sorted1 ps \<Longrightarrow> sorted1 (upd_list x y ps)"
   1.212 +apply(induction ps)
   1.213 + apply simp
   1.214 +apply(case_tac ps)
   1.215 + apply auto
   1.216 +done
   1.217 +
   1.218 +lemma upd_list_sorted1: "\<lbrakk> sorted (map fst ps @ [a]); x < a \<rbrakk> \<Longrightarrow>
   1.219 +  upd_list x y (ps @ (a,b) # qs) =  upd_list x y ps @ (a,b) # qs"
   1.220 +by(induction ps) (auto simp: sorted_lems)
   1.221 +
   1.222 +lemma upd_list_sorted2: "\<lbrakk> sorted (map fst ps @ [a]); a \<le> x \<rbrakk> \<Longrightarrow>
   1.223 +  upd_list x y (ps @ (a,b) # qs) = ps @ upd_list x y ((a,b) # qs)"
   1.224 +by(induction ps) (auto simp: sorted_lems)
   1.225 +
   1.226 +lemmas upd_list_simps = sorted_lems upd_list_sorted1 upd_list_sorted2
   1.227 +
   1.228 +(*
   1.229 +lemma set_ins_list[simp]: "set (ins_list x xs) = insert x (set xs)"
   1.230 +by(induction xs) auto
   1.231 +
   1.232 +lemma distinct_if_sorted: "sorted xs \<Longrightarrow> distinct xs"
   1.233 +apply(induction xs rule: sorted.induct)
   1.234 +apply auto
   1.235 +by (metis in_set_conv_decomp_first less_imp_not_less sorted_mid_iff2)
   1.236 +
   1.237 +lemma set_del_list_eq [simp]: "distinct xs ==> set(del_list x xs) = set xs - {x}"
   1.238 +apply(induct xs)
   1.239 + apply simp
   1.240 +apply simp
   1.241 +apply blast
   1.242 +done
   1.243 +*)
   1.244 +
   1.245 +
   1.246 +subsection \<open>Lemmas for @{const del_list}\<close>
   1.247 +
   1.248 +lemma sorted_del_list: "sorted1 ps \<Longrightarrow> sorted1 (del_list x ps)"
   1.249 +apply(induction ps)
   1.250 + apply simp
   1.251 +apply(case_tac ps)
   1.252 +apply auto
   1.253 +by (meson order.strict_trans sorted_Cons_iff)
   1.254 +
   1.255 +lemma del_list_idem: "x \<notin> set(map fst xs) \<Longrightarrow> del_list x xs = xs"
   1.256 +by (induct xs) auto
   1.257 +
   1.258 +lemma del_list_sorted1: "sorted1 (xs @ [(a,b)]) \<Longrightarrow> a \<le> x \<Longrightarrow>
   1.259 +  del_list x (xs @ (a,b) # ys) = xs @ del_list x ((a,b) # ys)"
   1.260 +by (induction xs) (auto simp: sorted_mid_iff2)
   1.261 +
   1.262 +lemma del_list_sorted2: "sorted1 (xs @ (a,b) # ys) \<Longrightarrow> x < a \<Longrightarrow>
   1.263 +  del_list x (xs @ (a,b) # ys) = del_list x xs @ (a,b) # ys"
   1.264 +by (induction xs) (fastforce simp: sorted_Cons_iff intro!: del_list_idem)+
   1.265 +
   1.266 +lemma del_list_sorted3:
   1.267 +  "sorted1 (xs @ (a,a') # ys @ (b,b') # zs) \<Longrightarrow> x < b \<Longrightarrow>
   1.268 +  del_list x (xs @ (a,a') # ys @ (b,b') # zs) = del_list x (xs @ (a,a') # ys) @ (b,b') # zs"
   1.269 +by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted2 ball_Un)
   1.270 +
   1.271 +lemma del_list_sorted4:
   1.272 +  "sorted1 (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us) \<Longrightarrow> x < c \<Longrightarrow>
   1.273 +  del_list x (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us) = del_list x (xs @ (a,a') # ys @ (b,b') # zs) @ (c,c') # us"
   1.274 +by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted3)
   1.275 +
   1.276 +lemma del_list_sorted5:
   1.277 +  "sorted1 (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us @ (d,d') # vs) \<Longrightarrow> x < d \<Longrightarrow>
   1.278 +   del_list x (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us @ (d,d') # vs) =
   1.279 +   del_list x (xs @ (a,a') # ys @ (b,b') # zs @ (c,c') # us) @ (d,d') # vs" 
   1.280 +by (induction xs) (auto simp: sorted_Cons_iff del_list_sorted4)
   1.281 +
   1.282 +lemmas del_list_sorted =
   1.283 +  del_list_sorted1 del_list_sorted2 del_list_sorted3 del_list_sorted4 del_list_sorted5
   1.284 +
   1.285 +lemmas del_list_simps = sorted_lems del_list_sorted
   1.286 +
   1.287 +end
     2.1 --- a/src/HOL/Data_Structures/Cmp.thy	Wed Nov 11 16:42:30 2015 +0100
     2.2 +++ b/src/HOL/Data_Structures/Cmp.thy	Wed Nov 11 18:32:26 2015 +0100
     2.3 @@ -1,21 +1,21 @@
     2.4 -(* Author: Tobias Nipkow *)
     2.5 -
     2.6 -section {* Three-Way Comparison *}
     2.7 -
     2.8 -theory Cmp
     2.9 -imports Main
    2.10 -begin
    2.11 -
    2.12 -datatype cmp = LT | EQ | GT
    2.13 -
    2.14 -class cmp = linorder +
    2.15 -fixes cmp :: "'a \<Rightarrow> 'a \<Rightarrow> cmp"
    2.16 -assumes LT[simp]: "cmp x y = LT \<longleftrightarrow> x < y"
    2.17 -assumes EQ[simp]: "cmp x y = EQ \<longleftrightarrow> x = y"
    2.18 -assumes GT[simp]: "cmp x y = GT \<longleftrightarrow> x > y"
    2.19 -
    2.20 -lemma case_cmp_if[simp]: "(case c of EQ \<Rightarrow> e | LT \<Rightarrow> l | GT \<Rightarrow> g) =
    2.21 -  (if c = LT then l else if c = GT then g else e)"
    2.22 -by(simp split: cmp.split)
    2.23 -
    2.24 -end
    2.25 +(* Author: Tobias Nipkow *)
    2.26 +
    2.27 +section {* Three-Way Comparison *}
    2.28 +
    2.29 +theory Cmp
    2.30 +imports Main
    2.31 +begin
    2.32 +
    2.33 +datatype cmp = LT | EQ | GT
    2.34 +
    2.35 +class cmp = linorder +
    2.36 +fixes cmp :: "'a \<Rightarrow> 'a \<Rightarrow> cmp"
    2.37 +assumes LT[simp]: "cmp x y = LT \<longleftrightarrow> x < y"
    2.38 +assumes EQ[simp]: "cmp x y = EQ \<longleftrightarrow> x = y"
    2.39 +assumes GT[simp]: "cmp x y = GT \<longleftrightarrow> x > y"
    2.40 +
    2.41 +lemma case_cmp_if[simp]: "(case c of EQ \<Rightarrow> e | LT \<Rightarrow> l | GT \<Rightarrow> g) =
    2.42 +  (if c = LT then l else if c = GT then g else e)"
    2.43 +by(simp split: cmp.split)
    2.44 +
    2.45 +end
     3.1 --- a/src/HOL/Data_Structures/Less_False.thy	Wed Nov 11 16:42:30 2015 +0100
     3.2 +++ b/src/HOL/Data_Structures/Less_False.thy	Wed Nov 11 18:32:26 2015 +0100
     3.3 @@ -1,31 +1,31 @@
     3.4 -(* Author: Tobias Nipkow *)
     3.5 -
     3.6 -section {* Improved Simproc for $<$ *}
     3.7 -
     3.8 -theory Less_False
     3.9 -imports Main
    3.10 -begin
    3.11 -
    3.12 -simproc_setup less_False ("(x::'a::order) < y") = {* fn _ => fn ctxt => fn ct =>
    3.13 -  let
    3.14 -    fun prp t thm = Thm.full_prop_of thm aconv t;
    3.15 -
    3.16 -    val eq_False_if_not = @{thm eq_False} RS iffD2
    3.17 -
    3.18 -    fun prove_less_False ((less as Const(_,T)) $ r $ s) =
    3.19 -      let val prems = Simplifier.prems_of ctxt;
    3.20 -          val le = Const (@{const_name less_eq}, T);
    3.21 -          val t = HOLogic.mk_Trueprop(le $ s $ r);
    3.22 -      in case find_first (prp t) prems of
    3.23 -           NONE =>
    3.24 -             let val t = HOLogic.mk_Trueprop(less $ s $ r)
    3.25 -             in case find_first (prp t) prems of
    3.26 -                  NONE => NONE
    3.27 -                | SOME thm => SOME(mk_meta_eq((thm RS @{thm less_not_sym}) RS eq_False_if_not))
    3.28 -             end
    3.29 -         | SOME thm => NONE
    3.30 -      end;
    3.31 -  in prove_less_False (Thm.term_of ct) end
    3.32 -*}
    3.33 -
    3.34 -end
    3.35 +(* Author: Tobias Nipkow *)
    3.36 +
    3.37 +section {* Improved Simproc for $<$ *}
    3.38 +
    3.39 +theory Less_False
    3.40 +imports Main
    3.41 +begin
    3.42 +
    3.43 +simproc_setup less_False ("(x::'a::order) < y") = {* fn _ => fn ctxt => fn ct =>
    3.44 +  let
    3.45 +    fun prp t thm = Thm.full_prop_of thm aconv t;
    3.46 +
    3.47 +    val eq_False_if_not = @{thm eq_False} RS iffD2
    3.48 +
    3.49 +    fun prove_less_False ((less as Const(_,T)) $ r $ s) =
    3.50 +      let val prems = Simplifier.prems_of ctxt;
    3.51 +          val le = Const (@{const_name less_eq}, T);
    3.52 +          val t = HOLogic.mk_Trueprop(le $ s $ r);
    3.53 +      in case find_first (prp t) prems of
    3.54 +           NONE =>
    3.55 +             let val t = HOLogic.mk_Trueprop(less $ s $ r)
    3.56 +             in case find_first (prp t) prems of
    3.57 +                  NONE => NONE
    3.58 +                | SOME thm => SOME(mk_meta_eq((thm RS @{thm less_not_sym}) RS eq_False_if_not))
    3.59 +             end
    3.60 +         | SOME thm => NONE
    3.61 +      end;
    3.62 +  in prove_less_False (Thm.term_of ct) end
    3.63 +*}
    3.64 +
    3.65 +end
     4.1 --- a/src/HOL/Data_Structures/List_Ins_Del.thy	Wed Nov 11 16:42:30 2015 +0100
     4.2 +++ b/src/HOL/Data_Structures/List_Ins_Del.thy	Wed Nov 11 18:32:26 2015 +0100
     4.3 @@ -1,149 +1,149 @@
     4.4 -(* Author: Tobias Nipkow *)
     4.5 -
     4.6 -section {* List Insertion and Deletion *}
     4.7 -
     4.8 -theory List_Ins_Del
     4.9 -imports Sorted_Less
    4.10 -begin
    4.11 -
    4.12 -subsection \<open>Elements in a list\<close>
    4.13 -
    4.14 -fun elems :: "'a list \<Rightarrow> 'a set" where
    4.15 -"elems [] = {}" |
    4.16 -"elems (x#xs) = Set.insert x (elems xs)"
    4.17 -
    4.18 -lemma elems_app: "elems (xs @ ys) = (elems xs \<union> elems ys)"
    4.19 -by (induction xs) auto
    4.20 -
    4.21 -lemma elems_eq_set: "elems xs = set xs"
    4.22 -by (induction xs) auto
    4.23 -
    4.24 -lemma sorted_Cons_iff:
    4.25 -  "sorted(x # xs) = (sorted xs \<and> (\<forall>y \<in> elems xs. x < y))"
    4.26 -by(simp add: elems_eq_set Sorted_Less.sorted_Cons_iff)
    4.27 -
    4.28 -lemma sorted_snoc_iff:
    4.29 -  "sorted(xs @ [x]) = (sorted xs \<and> (\<forall>y \<in> elems xs. y < x))"
    4.30 -by(simp add: elems_eq_set Sorted_Less.sorted_snoc_iff)
    4.31 -
    4.32 -text{* The above two rules introduce quantifiers. It turns out
    4.33 -that in practice this is not a problem because of the simplicity of
    4.34 -the "isin" functions that implement @{const elems}. Nevertheless
    4.35 -it is possible to avoid the quantifiers with the help of some rewrite rules: *}
    4.36 -
    4.37 -lemma sorted_ConsD: "sorted (y # xs) \<Longrightarrow> x \<in> elems xs \<Longrightarrow> y < x"
    4.38 -by (simp add: sorted_Cons_iff)
    4.39 -
    4.40 -lemma sorted_snocD: "sorted (xs @ [y]) \<Longrightarrow> x \<in> elems xs \<Longrightarrow> x < y"
    4.41 -by (simp add: sorted_snoc_iff)
    4.42 -
    4.43 -lemma sorted_ConsD2: "sorted (y # xs) \<Longrightarrow> x \<le> y \<Longrightarrow> x \<notin> elems xs"
    4.44 -using leD sorted_ConsD by blast
    4.45 -
    4.46 -lemma sorted_snocD2: "sorted (xs @ [y]) \<Longrightarrow> y \<le> x \<Longrightarrow> x \<notin> elems xs"
    4.47 -using leD sorted_snocD by blast
    4.48 -
    4.49 -lemmas elems_simps = sorted_lems elems_app
    4.50 -lemmas elems_simps1 = elems_simps sorted_Cons_iff sorted_snoc_iff
    4.51 -lemmas elems_simps2 = elems_simps sorted_ConsD sorted_snocD sorted_ConsD2 sorted_snocD2
    4.52 -
    4.53 -
    4.54 -subsection \<open>Inserting into an ordered list without duplicates:\<close>
    4.55 -
    4.56 -fun ins_list :: "'a::linorder \<Rightarrow> 'a list \<Rightarrow> 'a list" where
    4.57 -"ins_list x [] = [x]" |
    4.58 -"ins_list x (a#xs) =
    4.59 -  (if x < a then x#a#xs else if x=a then a#xs else a # ins_list x xs)"
    4.60 -
    4.61 -lemma set_ins_list: "elems (ins_list x xs) = insert x (elems xs)"
    4.62 -by(induction xs) auto
    4.63 -
    4.64 -lemma distinct_if_sorted: "sorted xs \<Longrightarrow> distinct xs"
    4.65 -apply(induction xs rule: sorted.induct)
    4.66 -apply auto
    4.67 -by (metis in_set_conv_decomp_first less_imp_not_less sorted_mid_iff2)
    4.68 -
    4.69 -lemma sorted_ins_list: "sorted xs \<Longrightarrow> sorted(ins_list x xs)"
    4.70 -by(induction xs rule: sorted.induct) auto
    4.71 -
    4.72 -lemma ins_list_sorted: "sorted (xs @ [a]) \<Longrightarrow>
    4.73 -  ins_list x (xs @ a # ys) =
    4.74 -  (if a \<le> x then xs @ ins_list x (a#ys) else ins_list x xs @ (a#ys))"
    4.75 -by(induction xs) (auto simp: sorted_lems)
    4.76 -
    4.77 -text\<open>In principle, @{thm ins_list_sorted} suffices, but the following two
    4.78 -corollaries speed up proofs.\<close>
    4.79 -
    4.80 -corollary ins_list_sorted1: "sorted (xs @ [a]) \<Longrightarrow> a \<le> x \<Longrightarrow>
    4.81 -  ins_list x (xs @ a # ys) = xs @ ins_list x (a#ys)"
    4.82 -by(simp add: ins_list_sorted)
    4.83 -
    4.84 -corollary ins_list_sorted2: "sorted (xs @ [a]) \<Longrightarrow> x < a \<Longrightarrow>
    4.85 -  ins_list x (xs @ a # ys) = ins_list x xs @ (a#ys)"
    4.86 -by(auto simp: ins_list_sorted)
    4.87 -
    4.88 -lemmas ins_list_simps = sorted_lems ins_list_sorted1 ins_list_sorted2
    4.89 -
    4.90 -
    4.91 -subsection \<open>Delete one occurrence of an element from a list:\<close>
    4.92 -
    4.93 -fun del_list :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
    4.94 -"del_list x [] = []" |
    4.95 -"del_list x (a#xs) = (if x=a then xs else a # del_list x xs)"
    4.96 -
    4.97 -lemma del_list_idem: "x \<notin> elems xs \<Longrightarrow> del_list x xs = xs"
    4.98 -by (induct xs) simp_all
    4.99 -
   4.100 -lemma elems_del_list_eq:
   4.101 -  "distinct xs \<Longrightarrow> elems (del_list x xs) = elems xs - {x}"
   4.102 -apply(induct xs)
   4.103 - apply simp
   4.104 -apply (simp add: elems_eq_set)
   4.105 -apply blast
   4.106 -done
   4.107 -
   4.108 -lemma sorted_del_list: "sorted xs \<Longrightarrow> sorted(del_list x xs)"
   4.109 -apply(induction xs rule: sorted.induct)
   4.110 -apply auto
   4.111 -by (meson order.strict_trans sorted_Cons_iff)
   4.112 -
   4.113 -lemma del_list_sorted: "sorted (xs @ a # ys) \<Longrightarrow>
   4.114 -  del_list x (xs @ a # ys) = (if x < a then del_list x xs @ a # ys else xs @ del_list x (a # ys))"
   4.115 -by(induction xs)
   4.116 -  (fastforce simp: sorted_lems sorted_Cons_iff elems_eq_set intro!: del_list_idem)+
   4.117 -
   4.118 -text\<open>In principle, @{thm del_list_sorted} suffices, but the following
   4.119 -corollaries speed up proofs.\<close>
   4.120 -
   4.121 -corollary del_list_sorted1: "sorted (xs @ a # ys) \<Longrightarrow> a \<le> x \<Longrightarrow>
   4.122 -  del_list x (xs @ a # ys) = xs @ del_list x (a # ys)"
   4.123 -by (auto simp: del_list_sorted)
   4.124 -
   4.125 -corollary del_list_sorted2: "sorted (xs @ a # ys) \<Longrightarrow> x < a \<Longrightarrow>
   4.126 -  del_list x (xs @ a # ys) = del_list x xs @ a # ys"
   4.127 -by (auto simp: del_list_sorted)
   4.128 -
   4.129 -corollary del_list_sorted3:
   4.130 -  "sorted (xs @ a # ys @ b # zs) \<Longrightarrow> x < b \<Longrightarrow>
   4.131 -  del_list x (xs @ a # ys @ b # zs) = del_list x (xs @ a # ys) @ b # zs"
   4.132 -by (auto simp: del_list_sorted sorted_lems)
   4.133 -
   4.134 -corollary del_list_sorted4:
   4.135 -  "sorted (xs @ a # ys @ b # zs @ c # us) \<Longrightarrow> x < c \<Longrightarrow>
   4.136 -  del_list x (xs @ a # ys @ b # zs @ c # us) = del_list x (xs @ a # ys @ b # zs) @ c # us"
   4.137 -by (auto simp: del_list_sorted sorted_lems)
   4.138 -
   4.139 -corollary del_list_sorted5:
   4.140 -  "sorted (xs @ a # ys @ b # zs @ c # us @ d # vs) \<Longrightarrow> x < d \<Longrightarrow>
   4.141 -   del_list x (xs @ a # ys @ b # zs @ c # us @ d # vs) =
   4.142 -   del_list x (xs @ a # ys @ b # zs @ c # us) @ d # vs" 
   4.143 -by (auto simp: del_list_sorted sorted_lems)
   4.144 -
   4.145 -lemmas del_list_simps = sorted_lems
   4.146 -  del_list_sorted1
   4.147 -  del_list_sorted2
   4.148 -  del_list_sorted3
   4.149 -  del_list_sorted4
   4.150 -  del_list_sorted5
   4.151 -
   4.152 -end
   4.153 +(* Author: Tobias Nipkow *)
   4.154 +
   4.155 +section {* List Insertion and Deletion *}
   4.156 +
   4.157 +theory List_Ins_Del
   4.158 +imports Sorted_Less
   4.159 +begin
   4.160 +
   4.161 +subsection \<open>Elements in a list\<close>
   4.162 +
   4.163 +fun elems :: "'a list \<Rightarrow> 'a set" where
   4.164 +"elems [] = {}" |
   4.165 +"elems (x#xs) = Set.insert x (elems xs)"
   4.166 +
   4.167 +lemma elems_app: "elems (xs @ ys) = (elems xs \<union> elems ys)"
   4.168 +by (induction xs) auto
   4.169 +
   4.170 +lemma elems_eq_set: "elems xs = set xs"
   4.171 +by (induction xs) auto
   4.172 +
   4.173 +lemma sorted_Cons_iff:
   4.174 +  "sorted(x # xs) = (sorted xs \<and> (\<forall>y \<in> elems xs. x < y))"
   4.175 +by(simp add: elems_eq_set Sorted_Less.sorted_Cons_iff)
   4.176 +
   4.177 +lemma sorted_snoc_iff:
   4.178 +  "sorted(xs @ [x]) = (sorted xs \<and> (\<forall>y \<in> elems xs. y < x))"
   4.179 +by(simp add: elems_eq_set Sorted_Less.sorted_snoc_iff)
   4.180 +
   4.181 +text{* The above two rules introduce quantifiers. It turns out
   4.182 +that in practice this is not a problem because of the simplicity of
   4.183 +the "isin" functions that implement @{const elems}. Nevertheless
   4.184 +it is possible to avoid the quantifiers with the help of some rewrite rules: *}
   4.185 +
   4.186 +lemma sorted_ConsD: "sorted (y # xs) \<Longrightarrow> x \<in> elems xs \<Longrightarrow> y < x"
   4.187 +by (simp add: sorted_Cons_iff)
   4.188 +
   4.189 +lemma sorted_snocD: "sorted (xs @ [y]) \<Longrightarrow> x \<in> elems xs \<Longrightarrow> x < y"
   4.190 +by (simp add: sorted_snoc_iff)
   4.191 +
   4.192 +lemma sorted_ConsD2: "sorted (y # xs) \<Longrightarrow> x \<le> y \<Longrightarrow> x \<notin> elems xs"
   4.193 +using leD sorted_ConsD by blast
   4.194 +
   4.195 +lemma sorted_snocD2: "sorted (xs @ [y]) \<Longrightarrow> y \<le> x \<Longrightarrow> x \<notin> elems xs"
   4.196 +using leD sorted_snocD by blast
   4.197 +
   4.198 +lemmas elems_simps = sorted_lems elems_app
   4.199 +lemmas elems_simps1 = elems_simps sorted_Cons_iff sorted_snoc_iff
   4.200 +lemmas elems_simps2 = elems_simps sorted_ConsD sorted_snocD sorted_ConsD2 sorted_snocD2
   4.201 +
   4.202 +
   4.203 +subsection \<open>Inserting into an ordered list without duplicates:\<close>
   4.204 +
   4.205 +fun ins_list :: "'a::linorder \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   4.206 +"ins_list x [] = [x]" |
   4.207 +"ins_list x (a#xs) =
   4.208 +  (if x < a then x#a#xs else if x=a then a#xs else a # ins_list x xs)"
   4.209 +
   4.210 +lemma set_ins_list: "elems (ins_list x xs) = insert x (elems xs)"
   4.211 +by(induction xs) auto
   4.212 +
   4.213 +lemma distinct_if_sorted: "sorted xs \<Longrightarrow> distinct xs"
   4.214 +apply(induction xs rule: sorted.induct)
   4.215 +apply auto
   4.216 +by (metis in_set_conv_decomp_first less_imp_not_less sorted_mid_iff2)
   4.217 +
   4.218 +lemma sorted_ins_list: "sorted xs \<Longrightarrow> sorted(ins_list x xs)"
   4.219 +by(induction xs rule: sorted.induct) auto
   4.220 +
   4.221 +lemma ins_list_sorted: "sorted (xs @ [a]) \<Longrightarrow>
   4.222 +  ins_list x (xs @ a # ys) =
   4.223 +  (if a \<le> x then xs @ ins_list x (a#ys) else ins_list x xs @ (a#ys))"
   4.224 +by(induction xs) (auto simp: sorted_lems)
   4.225 +
   4.226 +text\<open>In principle, @{thm ins_list_sorted} suffices, but the following two
   4.227 +corollaries speed up proofs.\<close>
   4.228 +
   4.229 +corollary ins_list_sorted1: "sorted (xs @ [a]) \<Longrightarrow> a \<le> x \<Longrightarrow>
   4.230 +  ins_list x (xs @ a # ys) = xs @ ins_list x (a#ys)"
   4.231 +by(simp add: ins_list_sorted)
   4.232 +
   4.233 +corollary ins_list_sorted2: "sorted (xs @ [a]) \<Longrightarrow> x < a \<Longrightarrow>
   4.234 +  ins_list x (xs @ a # ys) = ins_list x xs @ (a#ys)"
   4.235 +by(auto simp: ins_list_sorted)
   4.236 +
   4.237 +lemmas ins_list_simps = sorted_lems ins_list_sorted1 ins_list_sorted2
   4.238 +
   4.239 +
   4.240 +subsection \<open>Delete one occurrence of an element from a list:\<close>
   4.241 +
   4.242 +fun del_list :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   4.243 +"del_list x [] = []" |
   4.244 +"del_list x (a#xs) = (if x=a then xs else a # del_list x xs)"
   4.245 +
   4.246 +lemma del_list_idem: "x \<notin> elems xs \<Longrightarrow> del_list x xs = xs"
   4.247 +by (induct xs) simp_all
   4.248 +
   4.249 +lemma elems_del_list_eq:
   4.250 +  "distinct xs \<Longrightarrow> elems (del_list x xs) = elems xs - {x}"
   4.251 +apply(induct xs)
   4.252 + apply simp
   4.253 +apply (simp add: elems_eq_set)
   4.254 +apply blast
   4.255 +done
   4.256 +
   4.257 +lemma sorted_del_list: "sorted xs \<Longrightarrow> sorted(del_list x xs)"
   4.258 +apply(induction xs rule: sorted.induct)
   4.259 +apply auto
   4.260 +by (meson order.strict_trans sorted_Cons_iff)
   4.261 +
   4.262 +lemma del_list_sorted: "sorted (xs @ a # ys) \<Longrightarrow>
   4.263 +  del_list x (xs @ a # ys) = (if x < a then del_list x xs @ a # ys else xs @ del_list x (a # ys))"
   4.264 +by(induction xs)
   4.265 +  (fastforce simp: sorted_lems sorted_Cons_iff elems_eq_set intro!: del_list_idem)+
   4.266 +
   4.267 +text\<open>In principle, @{thm del_list_sorted} suffices, but the following
   4.268 +corollaries speed up proofs.\<close>
   4.269 +
   4.270 +corollary del_list_sorted1: "sorted (xs @ a # ys) \<Longrightarrow> a \<le> x \<Longrightarrow>
   4.271 +  del_list x (xs @ a # ys) = xs @ del_list x (a # ys)"
   4.272 +by (auto simp: del_list_sorted)
   4.273 +
   4.274 +corollary del_list_sorted2: "sorted (xs @ a # ys) \<Longrightarrow> x < a \<Longrightarrow>
   4.275 +  del_list x (xs @ a # ys) = del_list x xs @ a # ys"
   4.276 +by (auto simp: del_list_sorted)
   4.277 +
   4.278 +corollary del_list_sorted3:
   4.279 +  "sorted (xs @ a # ys @ b # zs) \<Longrightarrow> x < b \<Longrightarrow>
   4.280 +  del_list x (xs @ a # ys @ b # zs) = del_list x (xs @ a # ys) @ b # zs"
   4.281 +by (auto simp: del_list_sorted sorted_lems)
   4.282 +
   4.283 +corollary del_list_sorted4:
   4.284 +  "sorted (xs @ a # ys @ b # zs @ c # us) \<Longrightarrow> x < c \<Longrightarrow>
   4.285 +  del_list x (xs @ a # ys @ b # zs @ c # us) = del_list x (xs @ a # ys @ b # zs) @ c # us"
   4.286 +by (auto simp: del_list_sorted sorted_lems)
   4.287 +
   4.288 +corollary del_list_sorted5:
   4.289 +  "sorted (xs @ a # ys @ b # zs @ c # us @ d # vs) \<Longrightarrow> x < d \<Longrightarrow>
   4.290 +   del_list x (xs @ a # ys @ b # zs @ c # us @ d # vs) =
   4.291 +   del_list x (xs @ a # ys @ b # zs @ c # us) @ d # vs" 
   4.292 +by (auto simp: del_list_sorted sorted_lems)
   4.293 +
   4.294 +lemmas del_list_simps = sorted_lems
   4.295 +  del_list_sorted1
   4.296 +  del_list_sorted2
   4.297 +  del_list_sorted3
   4.298 +  del_list_sorted4
   4.299 +  del_list_sorted5
   4.300 +
   4.301 +end
     5.1 --- a/src/HOL/Data_Structures/Map_by_Ordered.thy	Wed Nov 11 16:42:30 2015 +0100
     5.2 +++ b/src/HOL/Data_Structures/Map_by_Ordered.thy	Wed Nov 11 18:32:26 2015 +0100
     5.3 @@ -1,59 +1,59 @@
     5.4 -(* Author: Tobias Nipkow *)
     5.5 -
     5.6 -section {* Implementing Ordered Maps *}
     5.7 -
     5.8 -theory Map_by_Ordered
     5.9 -imports AList_Upd_Del
    5.10 -begin
    5.11 -
    5.12 -locale Map =
    5.13 -fixes empty :: "'m"
    5.14 -fixes update :: "'a \<Rightarrow> 'b \<Rightarrow> 'm \<Rightarrow> 'm"
    5.15 -fixes delete :: "'a \<Rightarrow> 'm \<Rightarrow> 'm"
    5.16 -fixes map_of :: "'m \<Rightarrow> 'a \<Rightarrow> 'b option"
    5.17 -fixes invar :: "'m \<Rightarrow> bool"
    5.18 -assumes "map_of empty = (\<lambda>_. None)"
    5.19 -assumes "invar m \<Longrightarrow> map_of(update a b m) = (map_of m)(a := Some b)"
    5.20 -assumes "invar m \<Longrightarrow> map_of(delete a m) = (map_of m)(a := None)"
    5.21 -assumes "invar empty"
    5.22 -assumes "invar m \<Longrightarrow> invar(update a b m)"
    5.23 -assumes "invar m \<Longrightarrow> invar(delete a m)"
    5.24 -
    5.25 -locale Map_by_Ordered =
    5.26 -fixes empty :: "'t"
    5.27 -fixes update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> 't \<Rightarrow> 't"
    5.28 -fixes delete :: "'a \<Rightarrow> 't \<Rightarrow> 't"
    5.29 -fixes lookup :: "'t \<Rightarrow> 'a \<Rightarrow> 'b option"
    5.30 -fixes inorder :: "'t \<Rightarrow> ('a * 'b) list"
    5.31 -fixes wf :: "'t \<Rightarrow> bool"
    5.32 -assumes empty: "inorder empty = []"
    5.33 -assumes lookup: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
    5.34 -  lookup t a = map_of (inorder t) a"
    5.35 -assumes update: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
    5.36 -  inorder(update a b t) = upd_list a b (inorder t)"
    5.37 -assumes delete: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
    5.38 -  inorder(delete a t) = del_list a (inorder t)"
    5.39 -assumes wf_empty:  "wf empty"
    5.40 -assumes wf_insert: "wf t \<and> sorted1 (inorder t) \<Longrightarrow> wf(update a b t)"
    5.41 -assumes wf_delete: "wf t \<and> sorted1 (inorder t) \<Longrightarrow> wf(delete a t)"
    5.42 -begin
    5.43 -
    5.44 -sublocale Map
    5.45 -  empty update delete "map_of o inorder" "\<lambda>t. wf t \<and> sorted1 (inorder t)"
    5.46 -proof(standard, goal_cases)
    5.47 -  case 1 show ?case by (auto simp: empty)
    5.48 -next
    5.49 -  case 2 thus ?case by(simp add: update map_of_ins_list)
    5.50 -next
    5.51 -  case 3 thus ?case by(simp add: delete map_of_del_list)
    5.52 -next
    5.53 -  case 4 thus ?case by(simp add: empty wf_empty)
    5.54 -next
    5.55 -  case 5 thus ?case by(simp add: update wf_insert sorted_upd_list)
    5.56 -next
    5.57 -  case 6 thus ?case by (auto simp: delete wf_delete sorted_del_list)
    5.58 -qed
    5.59 -
    5.60 -end
    5.61 -
    5.62 -end
    5.63 +(* Author: Tobias Nipkow *)
    5.64 +
    5.65 +section {* Implementing Ordered Maps *}
    5.66 +
    5.67 +theory Map_by_Ordered
    5.68 +imports AList_Upd_Del
    5.69 +begin
    5.70 +
    5.71 +locale Map =
    5.72 +fixes empty :: "'m"
    5.73 +fixes update :: "'a \<Rightarrow> 'b \<Rightarrow> 'm \<Rightarrow> 'm"
    5.74 +fixes delete :: "'a \<Rightarrow> 'm \<Rightarrow> 'm"
    5.75 +fixes map_of :: "'m \<Rightarrow> 'a \<Rightarrow> 'b option"
    5.76 +fixes invar :: "'m \<Rightarrow> bool"
    5.77 +assumes "map_of empty = (\<lambda>_. None)"
    5.78 +assumes "invar m \<Longrightarrow> map_of(update a b m) = (map_of m)(a := Some b)"
    5.79 +assumes "invar m \<Longrightarrow> map_of(delete a m) = (map_of m)(a := None)"
    5.80 +assumes "invar empty"
    5.81 +assumes "invar m \<Longrightarrow> invar(update a b m)"
    5.82 +assumes "invar m \<Longrightarrow> invar(delete a m)"
    5.83 +
    5.84 +locale Map_by_Ordered =
    5.85 +fixes empty :: "'t"
    5.86 +fixes update :: "'a::linorder \<Rightarrow> 'b \<Rightarrow> 't \<Rightarrow> 't"
    5.87 +fixes delete :: "'a \<Rightarrow> 't \<Rightarrow> 't"
    5.88 +fixes lookup :: "'t \<Rightarrow> 'a \<Rightarrow> 'b option"
    5.89 +fixes inorder :: "'t \<Rightarrow> ('a * 'b) list"
    5.90 +fixes wf :: "'t \<Rightarrow> bool"
    5.91 +assumes empty: "inorder empty = []"
    5.92 +assumes lookup: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
    5.93 +  lookup t a = map_of (inorder t) a"
    5.94 +assumes update: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
    5.95 +  inorder(update a b t) = upd_list a b (inorder t)"
    5.96 +assumes delete: "wf t \<and> sorted1 (inorder t) \<Longrightarrow>
    5.97 +  inorder(delete a t) = del_list a (inorder t)"
    5.98 +assumes wf_empty:  "wf empty"
    5.99 +assumes wf_insert: "wf t \<and> sorted1 (inorder t) \<Longrightarrow> wf(update a b t)"
   5.100 +assumes wf_delete: "wf t \<and> sorted1 (inorder t) \<Longrightarrow> wf(delete a t)"
   5.101 +begin
   5.102 +
   5.103 +sublocale Map
   5.104 +  empty update delete "map_of o inorder" "\<lambda>t. wf t \<and> sorted1 (inorder t)"
   5.105 +proof(standard, goal_cases)
   5.106 +  case 1 show ?case by (auto simp: empty)
   5.107 +next
   5.108 +  case 2 thus ?case by(simp add: update map_of_ins_list)
   5.109 +next
   5.110 +  case 3 thus ?case by(simp add: delete map_of_del_list)
   5.111 +next
   5.112 +  case 4 thus ?case by(simp add: empty wf_empty)
   5.113 +next
   5.114 +  case 5 thus ?case by(simp add: update wf_insert sorted_upd_list)
   5.115 +next
   5.116 +  case 6 thus ?case by (auto simp: delete wf_delete sorted_del_list)
   5.117 +qed
   5.118 +
   5.119 +end
   5.120 +
   5.121 +end
     6.1 --- a/src/HOL/Data_Structures/Set_by_Ordered.thy	Wed Nov 11 16:42:30 2015 +0100
     6.2 +++ b/src/HOL/Data_Structures/Set_by_Ordered.thy	Wed Nov 11 18:32:26 2015 +0100
     6.3 @@ -1,64 +1,64 @@
     6.4 -(* Author: Tobias Nipkow *)
     6.5 -
     6.6 -section {* Implementing Ordered Sets *}
     6.7 -
     6.8 -theory Set_by_Ordered
     6.9 -imports List_Ins_Del
    6.10 -begin
    6.11 -
    6.12 -locale Set =
    6.13 -fixes empty :: "'s"
    6.14 -fixes insert :: "'a \<Rightarrow> 's \<Rightarrow> 's"
    6.15 -fixes delete :: "'a \<Rightarrow> 's \<Rightarrow> 's"
    6.16 -fixes isin :: "'s \<Rightarrow> 'a \<Rightarrow> bool"
    6.17 -fixes set :: "'s \<Rightarrow> 'a set"
    6.18 -fixes invar :: "'s \<Rightarrow> bool"
    6.19 -assumes set_empty:    "set empty = {}"
    6.20 -assumes set_isin:     "invar s \<Longrightarrow> isin s x = (x \<in> set s)"
    6.21 -assumes set_insert:   "invar s \<Longrightarrow> set(insert x s) = Set.insert x (set s)"
    6.22 -assumes set_delete:   "invar s \<Longrightarrow> set(delete x s) = set s - {x}"
    6.23 -assumes invar_empty:  "invar empty"
    6.24 -assumes invar_insert: "invar s \<Longrightarrow> invar(insert x s)"
    6.25 -assumes invar_delete: "invar s \<Longrightarrow> invar(delete x s)"
    6.26 -
    6.27 -locale Set_by_Ordered =
    6.28 -fixes empty :: "'t"
    6.29 -fixes insert :: "'a::linorder \<Rightarrow> 't \<Rightarrow> 't"
    6.30 -fixes delete :: "'a \<Rightarrow> 't \<Rightarrow> 't"
    6.31 -fixes isin :: "'t \<Rightarrow> 'a \<Rightarrow> bool"
    6.32 -fixes inorder :: "'t \<Rightarrow> 'a list"
    6.33 -fixes inv :: "'t \<Rightarrow> bool"
    6.34 -assumes empty: "inorder empty = []"
    6.35 -assumes isin: "inv t \<and> sorted(inorder t) \<Longrightarrow>
    6.36 -  isin t x = (x \<in> elems (inorder t))"
    6.37 -assumes insert: "inv t \<and> sorted(inorder t) \<Longrightarrow>
    6.38 -  inorder(insert x t) = ins_list x (inorder t)"
    6.39 -assumes delete: "inv t \<and> sorted(inorder t) \<Longrightarrow>
    6.40 -  inorder(delete x t) = del_list x (inorder t)"
    6.41 -assumes inv_empty:  "inv empty"
    6.42 -assumes inv_insert: "inv t \<and> sorted(inorder t) \<Longrightarrow> inv(insert x t)"
    6.43 -assumes inv_delete: "inv t \<and> sorted(inorder t) \<Longrightarrow> inv(delete x t)"
    6.44 -begin
    6.45 -
    6.46 -sublocale Set
    6.47 -  empty insert delete isin "elems o inorder" "\<lambda>t. inv t \<and> sorted(inorder t)"
    6.48 -proof(standard, goal_cases)
    6.49 -  case 1 show ?case by (auto simp: empty)
    6.50 -next
    6.51 -  case 2 thus ?case by(simp add: isin)
    6.52 -next
    6.53 -  case 3 thus ?case by(simp add: insert set_ins_list)
    6.54 -next
    6.55 -  case (4 s x) thus ?case
    6.56 -    using delete[OF 4, of x] by (auto simp: distinct_if_sorted elems_del_list_eq)
    6.57 -next
    6.58 -  case 5 thus ?case by(simp add: empty inv_empty)
    6.59 -next
    6.60 -  case 6 thus ?case by(simp add: insert inv_insert sorted_ins_list)
    6.61 -next
    6.62 -  case 7 thus ?case by (auto simp: delete inv_delete sorted_del_list)
    6.63 -qed
    6.64 -
    6.65 -end
    6.66 -
    6.67 -end
    6.68 +(* Author: Tobias Nipkow *)
    6.69 +
    6.70 +section {* Implementing Ordered Sets *}
    6.71 +
    6.72 +theory Set_by_Ordered
    6.73 +imports List_Ins_Del
    6.74 +begin
    6.75 +
    6.76 +locale Set =
    6.77 +fixes empty :: "'s"
    6.78 +fixes insert :: "'a \<Rightarrow> 's \<Rightarrow> 's"
    6.79 +fixes delete :: "'a \<Rightarrow> 's \<Rightarrow> 's"
    6.80 +fixes isin :: "'s \<Rightarrow> 'a \<Rightarrow> bool"
    6.81 +fixes set :: "'s \<Rightarrow> 'a set"
    6.82 +fixes invar :: "'s \<Rightarrow> bool"
    6.83 +assumes set_empty:    "set empty = {}"
    6.84 +assumes set_isin:     "invar s \<Longrightarrow> isin s x = (x \<in> set s)"
    6.85 +assumes set_insert:   "invar s \<Longrightarrow> set(insert x s) = Set.insert x (set s)"
    6.86 +assumes set_delete:   "invar s \<Longrightarrow> set(delete x s) = set s - {x}"
    6.87 +assumes invar_empty:  "invar empty"
    6.88 +assumes invar_insert: "invar s \<Longrightarrow> invar(insert x s)"
    6.89 +assumes invar_delete: "invar s \<Longrightarrow> invar(delete x s)"
    6.90 +
    6.91 +locale Set_by_Ordered =
    6.92 +fixes empty :: "'t"
    6.93 +fixes insert :: "'a::linorder \<Rightarrow> 't \<Rightarrow> 't"
    6.94 +fixes delete :: "'a \<Rightarrow> 't \<Rightarrow> 't"
    6.95 +fixes isin :: "'t \<Rightarrow> 'a \<Rightarrow> bool"
    6.96 +fixes inorder :: "'t \<Rightarrow> 'a list"
    6.97 +fixes inv :: "'t \<Rightarrow> bool"
    6.98 +assumes empty: "inorder empty = []"
    6.99 +assumes isin: "inv t \<and> sorted(inorder t) \<Longrightarrow>
   6.100 +  isin t x = (x \<in> elems (inorder t))"
   6.101 +assumes insert: "inv t \<and> sorted(inorder t) \<Longrightarrow>
   6.102 +  inorder(insert x t) = ins_list x (inorder t)"
   6.103 +assumes delete: "inv t \<and> sorted(inorder t) \<Longrightarrow>
   6.104 +  inorder(delete x t) = del_list x (inorder t)"
   6.105 +assumes inv_empty:  "inv empty"
   6.106 +assumes inv_insert: "inv t \<and> sorted(inorder t) \<Longrightarrow> inv(insert x t)"
   6.107 +assumes inv_delete: "inv t \<and> sorted(inorder t) \<Longrightarrow> inv(delete x t)"
   6.108 +begin
   6.109 +
   6.110 +sublocale Set
   6.111 +  empty insert delete isin "elems o inorder" "\<lambda>t. inv t \<and> sorted(inorder t)"
   6.112 +proof(standard, goal_cases)
   6.113 +  case 1 show ?case by (auto simp: empty)
   6.114 +next
   6.115 +  case 2 thus ?case by(simp add: isin)
   6.116 +next
   6.117 +  case 3 thus ?case by(simp add: insert set_ins_list)
   6.118 +next
   6.119 +  case (4 s x) thus ?case
   6.120 +    using delete[OF 4, of x] by (auto simp: distinct_if_sorted elems_del_list_eq)
   6.121 +next
   6.122 +  case 5 thus ?case by(simp add: empty inv_empty)
   6.123 +next
   6.124 +  case 6 thus ?case by(simp add: insert inv_insert sorted_ins_list)
   6.125 +next
   6.126 +  case 7 thus ?case by (auto simp: delete inv_delete sorted_del_list)
   6.127 +qed
   6.128 +
   6.129 +end
   6.130 +
   6.131 +end
     7.1 --- a/src/HOL/Data_Structures/Sorted_Less.thy	Wed Nov 11 16:42:30 2015 +0100
     7.2 +++ b/src/HOL/Data_Structures/Sorted_Less.thy	Wed Nov 11 18:32:26 2015 +0100
     7.3 @@ -1,54 +1,54 @@
     7.4 -(* Author: Tobias Nipkow *)
     7.5 -
     7.6 -section {* Lists Sorted wrt $<$ *}
     7.7 -
     7.8 -theory Sorted_Less
     7.9 -imports Less_False
    7.10 -begin
    7.11 -
    7.12 -hide_const sorted
    7.13 -
    7.14 -text \<open>Is a list sorted without duplicates, i.e., wrt @{text"<"}?
    7.15 -Could go into theory List under a name like @{term sorted_less}.\<close>
    7.16 -
    7.17 -fun sorted :: "'a::linorder list \<Rightarrow> bool" where
    7.18 -"sorted [] = True" |
    7.19 -"sorted [x] = True" |
    7.20 -"sorted (x#y#zs) = (x < y \<and> sorted(y#zs))"
    7.21 -
    7.22 -lemma sorted_Cons_iff:
    7.23 -  "sorted(x # xs) = (sorted xs \<and> (\<forall>y \<in> set xs. x < y))"
    7.24 -by(induction xs rule: sorted.induct) auto
    7.25 -
    7.26 -lemma sorted_snoc_iff:
    7.27 -  "sorted(xs @ [x]) = (sorted xs \<and> (\<forall>y \<in> set xs. y < x))"
    7.28 -by(induction xs rule: sorted.induct) auto
    7.29 -
    7.30 -lemma sorted_cons: "sorted (x#xs) \<Longrightarrow> sorted xs"
    7.31 -by(simp add: sorted_Cons_iff)
    7.32 -
    7.33 -lemma sorted_cons': "ASSUMPTION (sorted (x#xs)) \<Longrightarrow> sorted xs"
    7.34 -by(rule ASSUMPTION_D [THEN sorted_cons])
    7.35 -
    7.36 -lemma sorted_snoc: "sorted (xs @ [y]) \<Longrightarrow> sorted xs"
    7.37 -by(simp add: sorted_snoc_iff)
    7.38 -
    7.39 -lemma sorted_snoc': "ASSUMPTION (sorted (xs @ [y])) \<Longrightarrow> sorted xs"
    7.40 -by(rule ASSUMPTION_D [THEN sorted_snoc])
    7.41 -
    7.42 -lemma sorted_mid_iff:
    7.43 -  "sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
    7.44 -by(induction xs rule: sorted.induct) auto
    7.45 -
    7.46 -lemma sorted_mid_iff2:
    7.47 -  "sorted(x # xs @ y # ys) =
    7.48 -  (sorted(x # xs) \<and> x < y \<and> sorted(xs @ [y]) \<and> sorted(y # ys))"
    7.49 -by(induction xs rule: sorted.induct) auto
    7.50 -
    7.51 -lemma sorted_mid_iff': "NO_MATCH [] ys \<Longrightarrow>
    7.52 -  sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
    7.53 -by(rule sorted_mid_iff)
    7.54 -
    7.55 -lemmas sorted_lems = sorted_mid_iff' sorted_mid_iff2 sorted_cons' sorted_snoc'
    7.56 -
    7.57 -end
    7.58 +(* Author: Tobias Nipkow *)
    7.59 +
    7.60 +section {* Lists Sorted wrt $<$ *}
    7.61 +
    7.62 +theory Sorted_Less
    7.63 +imports Less_False
    7.64 +begin
    7.65 +
    7.66 +hide_const sorted
    7.67 +
    7.68 +text \<open>Is a list sorted without duplicates, i.e., wrt @{text"<"}?
    7.69 +Could go into theory List under a name like @{term sorted_less}.\<close>
    7.70 +
    7.71 +fun sorted :: "'a::linorder list \<Rightarrow> bool" where
    7.72 +"sorted [] = True" |
    7.73 +"sorted [x] = True" |
    7.74 +"sorted (x#y#zs) = (x < y \<and> sorted(y#zs))"
    7.75 +
    7.76 +lemma sorted_Cons_iff:
    7.77 +  "sorted(x # xs) = (sorted xs \<and> (\<forall>y \<in> set xs. x < y))"
    7.78 +by(induction xs rule: sorted.induct) auto
    7.79 +
    7.80 +lemma sorted_snoc_iff:
    7.81 +  "sorted(xs @ [x]) = (sorted xs \<and> (\<forall>y \<in> set xs. y < x))"
    7.82 +by(induction xs rule: sorted.induct) auto
    7.83 +
    7.84 +lemma sorted_cons: "sorted (x#xs) \<Longrightarrow> sorted xs"
    7.85 +by(simp add: sorted_Cons_iff)
    7.86 +
    7.87 +lemma sorted_cons': "ASSUMPTION (sorted (x#xs)) \<Longrightarrow> sorted xs"
    7.88 +by(rule ASSUMPTION_D [THEN sorted_cons])
    7.89 +
    7.90 +lemma sorted_snoc: "sorted (xs @ [y]) \<Longrightarrow> sorted xs"
    7.91 +by(simp add: sorted_snoc_iff)
    7.92 +
    7.93 +lemma sorted_snoc': "ASSUMPTION (sorted (xs @ [y])) \<Longrightarrow> sorted xs"
    7.94 +by(rule ASSUMPTION_D [THEN sorted_snoc])
    7.95 +
    7.96 +lemma sorted_mid_iff:
    7.97 +  "sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
    7.98 +by(induction xs rule: sorted.induct) auto
    7.99 +
   7.100 +lemma sorted_mid_iff2:
   7.101 +  "sorted(x # xs @ y # ys) =
   7.102 +  (sorted(x # xs) \<and> x < y \<and> sorted(xs @ [y]) \<and> sorted(y # ys))"
   7.103 +by(induction xs rule: sorted.induct) auto
   7.104 +
   7.105 +lemma sorted_mid_iff': "NO_MATCH [] ys \<Longrightarrow>
   7.106 +  sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
   7.107 +by(rule sorted_mid_iff)
   7.108 +
   7.109 +lemmas sorted_lems = sorted_mid_iff' sorted_mid_iff2 sorted_cons' sorted_snoc'
   7.110 +
   7.111 +end
     8.1 --- a/src/HOL/Data_Structures/Tree23.thy	Wed Nov 11 16:42:30 2015 +0100
     8.2 +++ b/src/HOL/Data_Structures/Tree23.thy	Wed Nov 11 18:32:26 2015 +0100
     8.3 @@ -1,43 +1,43 @@
     8.4 -(* Author: Tobias Nipkow *)
     8.5 -
     8.6 -section \<open>2-3 Trees\<close>
     8.7 -
     8.8 -theory Tree23
     8.9 -imports Main
    8.10 -begin
    8.11 -
    8.12 -class height =
    8.13 -fixes height :: "'a \<Rightarrow> nat"
    8.14 -
    8.15 -datatype 'a tree23 =
    8.16 -  Leaf |
    8.17 -  Node2 "'a tree23" 'a "'a tree23" |
    8.18 -  Node3 "'a tree23" 'a "'a tree23" 'a "'a tree23"
    8.19 -
    8.20 -fun inorder :: "'a tree23 \<Rightarrow> 'a list" where
    8.21 -"inorder Leaf = []" |
    8.22 -"inorder(Node2 l a r) = inorder l @ a # inorder r" |
    8.23 -"inorder(Node3 l a m b r) = inorder l @ a # inorder m @ b # inorder r"
    8.24 -
    8.25 -
    8.26 -instantiation tree23 :: (type)height
    8.27 -begin
    8.28 -
    8.29 -fun height_tree23 :: "'a tree23 \<Rightarrow> nat" where
    8.30 -"height Leaf = 0" |
    8.31 -"height (Node2 l _ r) = Suc(max (height l) (height r))" |
    8.32 -"height (Node3 l _ m _ r) = Suc(max (height l) (max (height m) (height r)))"
    8.33 -
    8.34 -instance ..
    8.35 -
    8.36 -end
    8.37 -
    8.38 -text \<open>Balanced:\<close>
    8.39 -
    8.40 -fun bal :: "'a tree23 \<Rightarrow> bool" where
    8.41 -"bal Leaf = True" |
    8.42 -"bal (Node2 l _ r) = (bal l & bal r & height l = height r)" |
    8.43 -"bal (Node3 l _ m _ r) =
    8.44 -  (bal l & bal m & bal r & height l = height m & height m = height r)"
    8.45 -
    8.46 -end
    8.47 +(* Author: Tobias Nipkow *)
    8.48 +
    8.49 +section \<open>2-3 Trees\<close>
    8.50 +
    8.51 +theory Tree23
    8.52 +imports Main
    8.53 +begin
    8.54 +
    8.55 +class height =
    8.56 +fixes height :: "'a \<Rightarrow> nat"
    8.57 +
    8.58 +datatype 'a tree23 =
    8.59 +  Leaf |
    8.60 +  Node2 "'a tree23" 'a "'a tree23" |
    8.61 +  Node3 "'a tree23" 'a "'a tree23" 'a "'a tree23"
    8.62 +
    8.63 +fun inorder :: "'a tree23 \<Rightarrow> 'a list" where
    8.64 +"inorder Leaf = []" |
    8.65 +"inorder(Node2 l a r) = inorder l @ a # inorder r" |
    8.66 +"inorder(Node3 l a m b r) = inorder l @ a # inorder m @ b # inorder r"
    8.67 +
    8.68 +
    8.69 +instantiation tree23 :: (type)height
    8.70 +begin
    8.71 +
    8.72 +fun height_tree23 :: "'a tree23 \<Rightarrow> nat" where
    8.73 +"height Leaf = 0" |
    8.74 +"height (Node2 l _ r) = Suc(max (height l) (height r))" |
    8.75 +"height (Node3 l _ m _ r) = Suc(max (height l) (max (height m) (height r)))"
    8.76 +
    8.77 +instance ..
    8.78 +
    8.79 +end
    8.80 +
    8.81 +text \<open>Balanced:\<close>
    8.82 +
    8.83 +fun bal :: "'a tree23 \<Rightarrow> bool" where
    8.84 +"bal Leaf = True" |
    8.85 +"bal (Node2 l _ r) = (bal l & bal r & height l = height r)" |
    8.86 +"bal (Node3 l _ m _ r) =
    8.87 +  (bal l & bal m & bal r & height l = height m & height m = height r)"
    8.88 +
    8.89 +end
     9.1 --- a/src/HOL/Data_Structures/Tree234.thy	Wed Nov 11 16:42:30 2015 +0100
     9.2 +++ b/src/HOL/Data_Structures/Tree234.thy	Wed Nov 11 18:32:26 2015 +0100
     9.3 @@ -1,45 +1,45 @@
     9.4 -(* Author: Tobias Nipkow *)
     9.5 -
     9.6 -section {* 2-3-4 Trees *}
     9.7 -
     9.8 -theory Tree234
     9.9 -imports Main
    9.10 -begin
    9.11 -
    9.12 -class height =
    9.13 -fixes height :: "'a \<Rightarrow> nat"
    9.14 -
    9.15 -datatype 'a tree234 =
    9.16 -  Leaf |
    9.17 -  Node2 "'a tree234" 'a "'a tree234" |
    9.18 -  Node3 "'a tree234" 'a "'a tree234" 'a "'a tree234" |
    9.19 -  Node4 "'a tree234" 'a "'a tree234" 'a "'a tree234" 'a "'a tree234"
    9.20 -
    9.21 -fun inorder :: "'a tree234 \<Rightarrow> 'a list" where
    9.22 -"inorder Leaf = []" |
    9.23 -"inorder(Node2 l a r) = inorder l @ a # inorder r" |
    9.24 -"inorder(Node3 l a m b r) = inorder l @ a # inorder m @ b # inorder r" |
    9.25 -"inorder(Node4 l a m b n c r) = inorder l @ a # inorder m @ b # inorder n @ c # inorder r"
    9.26 -
    9.27 -
    9.28 -instantiation tree234 :: (type)height
    9.29 -begin
    9.30 -
    9.31 -fun height_tree234 :: "'a tree234 \<Rightarrow> nat" where
    9.32 -"height Leaf = 0" |
    9.33 -"height (Node2 l _ r) = Suc(max (height l) (height r))" |
    9.34 -"height (Node3 l _ m _ r) = Suc(max (height l) (max (height m) (height r)))" |
    9.35 -"height (Node4 l _ m _ n _ r) = Suc(max (height l) (max (height m) (max (height n) (height r))))"
    9.36 -
    9.37 -instance ..
    9.38 -
    9.39 -end
    9.40 -
    9.41 -text{* Balanced: *}
    9.42 -fun bal :: "'a tree234 \<Rightarrow> bool" where
    9.43 -"bal Leaf = True" |
    9.44 -"bal (Node2 l _ r) = (bal l & bal r & height l = height r)" |
    9.45 -"bal (Node3 l _ m _ r) = (bal l & bal m & bal r & height l = height m & height m = height r)" |
    9.46 -"bal (Node4 l _ m _ n _ r) = (bal l & bal m & bal n & bal r & height l = height m & height m = height n & height n = height r)"
    9.47 -
    9.48 -end
    9.49 +(* Author: Tobias Nipkow *)
    9.50 +
    9.51 +section {* 2-3-4 Trees *}
    9.52 +
    9.53 +theory Tree234
    9.54 +imports Main
    9.55 +begin
    9.56 +
    9.57 +class height =
    9.58 +fixes height :: "'a \<Rightarrow> nat"
    9.59 +
    9.60 +datatype 'a tree234 =
    9.61 +  Leaf |
    9.62 +  Node2 "'a tree234" 'a "'a tree234" |
    9.63 +  Node3 "'a tree234" 'a "'a tree234" 'a "'a tree234" |
    9.64 +  Node4 "'a tree234" 'a "'a tree234" 'a "'a tree234" 'a "'a tree234"
    9.65 +
    9.66 +fun inorder :: "'a tree234 \<Rightarrow> 'a list" where
    9.67 +"inorder Leaf = []" |
    9.68 +"inorder(Node2 l a r) = inorder l @ a # inorder r" |
    9.69 +"inorder(Node3 l a m b r) = inorder l @ a # inorder m @ b # inorder r" |
    9.70 +"inorder(Node4 l a m b n c r) = inorder l @ a # inorder m @ b # inorder n @ c # inorder r"
    9.71 +
    9.72 +
    9.73 +instantiation tree234 :: (type)height
    9.74 +begin
    9.75 +
    9.76 +fun height_tree234 :: "'a tree234 \<Rightarrow> nat" where
    9.77 +"height Leaf = 0" |
    9.78 +"height (Node2 l _ r) = Suc(max (height l) (height r))" |
    9.79 +"height (Node3 l _ m _ r) = Suc(max (height l) (max (height m) (height r)))" |
    9.80 +"height (Node4 l _ m _ n _ r) = Suc(max (height l) (max (height m) (max (height n) (height r))))"
    9.81 +
    9.82 +instance ..
    9.83 +
    9.84 +end
    9.85 +
    9.86 +text{* Balanced: *}
    9.87 +fun bal :: "'a tree234 \<Rightarrow> bool" where
    9.88 +"bal Leaf = True" |
    9.89 +"bal (Node2 l _ r) = (bal l & bal r & height l = height r)" |
    9.90 +"bal (Node3 l _ m _ r) = (bal l & bal m & bal r & height l = height m & height m = height r)" |
    9.91 +"bal (Node4 l _ m _ n _ r) = (bal l & bal m & bal n & bal r & height l = height m & height m = height n & height n = height r)"
    9.92 +
    9.93 +end
    10.1 --- a/src/HOL/Data_Structures/Tree234_Map.thy	Wed Nov 11 16:42:30 2015 +0100
    10.2 +++ b/src/HOL/Data_Structures/Tree234_Map.thy	Wed Nov 11 18:32:26 2015 +0100
    10.3 @@ -1,181 +1,181 @@
    10.4 -(* Author: Tobias Nipkow *)
    10.5 -
    10.6 -section \<open>A 2-3-4 Tree Implementation of Maps\<close>
    10.7 -
    10.8 -theory Tree234_Map
    10.9 -imports
   10.10 -  Tree234_Set
   10.11 -  "../Data_Structures/Map_by_Ordered"
   10.12 -begin
   10.13 -
   10.14 -subsection \<open>Map operations on 2-3-4 trees\<close>
   10.15 -
   10.16 -fun lookup :: "('a::cmp * 'b) tree234 \<Rightarrow> 'a \<Rightarrow> 'b option" where
   10.17 -"lookup Leaf x = None" |
   10.18 -"lookup (Node2 l (a,b) r) x = (case cmp x a of
   10.19 -  LT \<Rightarrow> lookup l x |
   10.20 -  GT \<Rightarrow> lookup r x |
   10.21 -  EQ \<Rightarrow> Some b)" |
   10.22 -"lookup (Node3 l (a1,b1) m (a2,b2) r) x = (case cmp x a1 of
   10.23 -  LT \<Rightarrow> lookup l x |
   10.24 -  EQ \<Rightarrow> Some b1 |
   10.25 -  GT \<Rightarrow> (case cmp x a2 of
   10.26 -          LT \<Rightarrow> lookup m x |
   10.27 -          EQ \<Rightarrow> Some b2 |
   10.28 -          GT \<Rightarrow> lookup r x))" |
   10.29 -"lookup (Node4 t1 (a1,b1) t2 (a2,b2) t3 (a3,b3) t4) x = (case cmp x a2 of
   10.30 -  LT \<Rightarrow> (case cmp x a1 of
   10.31 -           LT \<Rightarrow> lookup t1 x | EQ \<Rightarrow> Some b1 | GT \<Rightarrow> lookup t2 x) |
   10.32 -  EQ \<Rightarrow> Some b2 |
   10.33 -  GT \<Rightarrow> (case cmp x a3 of
   10.34 -           LT \<Rightarrow> lookup t3 x | EQ \<Rightarrow> Some b3 | GT \<Rightarrow> lookup t4 x))"
   10.35 -
   10.36 -fun upd :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) up\<^sub>i" where
   10.37 -"upd x y Leaf = Up\<^sub>i Leaf (x,y) Leaf" |
   10.38 -"upd x y (Node2 l ab r) = (case cmp x (fst ab) of
   10.39 -   LT \<Rightarrow> (case upd x y l of
   10.40 -           T\<^sub>i l' => T\<^sub>i (Node2 l' ab r)
   10.41 -         | Up\<^sub>i l1 ab' l2 => T\<^sub>i (Node3 l1 ab' l2 ab r)) |
   10.42 -   EQ \<Rightarrow> T\<^sub>i (Node2 l (x,y) r) |
   10.43 -   GT \<Rightarrow> (case upd x y r of
   10.44 -           T\<^sub>i r' => T\<^sub>i (Node2 l ab r')
   10.45 -         | Up\<^sub>i r1 ab' r2 => T\<^sub>i (Node3 l ab r1 ab' r2)))" |
   10.46 -"upd x y (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
   10.47 -   LT \<Rightarrow> (case upd x y l of
   10.48 -           T\<^sub>i l' => T\<^sub>i (Node3 l' ab1 m ab2 r)
   10.49 -         | Up\<^sub>i l1 ab' l2 => Up\<^sub>i (Node2 l1 ab' l2) ab1 (Node2 m ab2 r)) |
   10.50 -   EQ \<Rightarrow> T\<^sub>i (Node3 l (x,y) m ab2 r) |
   10.51 -   GT \<Rightarrow> (case cmp x (fst ab2) of
   10.52 -           LT \<Rightarrow> (case upd x y m of
   10.53 -                   T\<^sub>i m' => T\<^sub>i (Node3 l ab1 m' ab2 r)
   10.54 -                 | Up\<^sub>i m1 ab' m2 => Up\<^sub>i (Node2 l ab1 m1) ab' (Node2 m2 ab2 r)) |
   10.55 -           EQ \<Rightarrow> T\<^sub>i (Node3 l ab1 m (x,y) r) |
   10.56 -           GT \<Rightarrow> (case upd x y r of
   10.57 -                   T\<^sub>i r' => T\<^sub>i (Node3 l ab1 m ab2 r')
   10.58 -                 | Up\<^sub>i r1 ab' r2 => Up\<^sub>i (Node2 l ab1 m) ab2 (Node2 r1 ab' r2))))" |
   10.59 -"upd x y (Node4 t1 ab1 t2 ab2 t3 ab3 t4) = (case cmp x (fst ab2) of
   10.60 -   LT \<Rightarrow> (case cmp x (fst ab1) of
   10.61 -            LT \<Rightarrow> (case upd x y t1 of
   10.62 -                     T\<^sub>i t1' => T\<^sub>i (Node4 t1' ab1 t2 ab2 t3 ab3 t4)
   10.63 -                  | Up\<^sub>i t11 q t12 => Up\<^sub>i (Node2 t11 q t12) ab1 (Node3 t2 ab2 t3 ab3 t4)) |
   10.64 -            EQ \<Rightarrow> T\<^sub>i (Node4 t1 (x,y) t2 ab2 t3 ab3 t4) |
   10.65 -            GT \<Rightarrow> (case upd x y t2 of
   10.66 -                    T\<^sub>i t2' => T\<^sub>i (Node4 t1 ab1 t2' ab2 t3 ab3 t4)
   10.67 -                  | Up\<^sub>i t21 q t22 => Up\<^sub>i (Node2 t1 ab1 t21) q (Node3 t22 ab2 t3 ab3 t4))) |
   10.68 -   EQ \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 (x,y) t3 ab3 t4) |
   10.69 -   GT \<Rightarrow> (case cmp x (fst ab3) of
   10.70 -            LT \<Rightarrow> (case upd x y t3 of
   10.71 -                    T\<^sub>i t3' \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 ab2 t3' ab3 t4)
   10.72 -                  | Up\<^sub>i t31 q t32 => Up\<^sub>i (Node2 t1 ab1 t2) ab2(*q*) (Node3 t31 q t32 ab3 t4)) |
   10.73 -            EQ \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 ab2 t3 (x,y) t4) |
   10.74 -            GT \<Rightarrow> (case upd x y t4 of
   10.75 -                    T\<^sub>i t4' => T\<^sub>i (Node4 t1 ab1 t2 ab2 t3 ab3 t4')
   10.76 -                  | Up\<^sub>i t41 q t42 => Up\<^sub>i (Node2 t1 ab1 t2) ab2 (Node3 t3 ab3 t41 q t42))))"
   10.77 -
   10.78 -definition update :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) tree234" where
   10.79 -"update x y t = tree\<^sub>i(upd x y t)"
   10.80 -
   10.81 -fun del :: "'a::cmp \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) up\<^sub>d" where
   10.82 -"del x Leaf = T\<^sub>d Leaf" |
   10.83 -"del x (Node2 Leaf ab1 Leaf) = (if x=fst ab1 then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf ab1 Leaf))" |
   10.84 -"del x (Node3 Leaf ab1 Leaf ab2 Leaf) = T\<^sub>d(if x=fst ab1 then Node2 Leaf ab2 Leaf
   10.85 -  else if x=fst ab2 then Node2 Leaf ab1 Leaf else Node3 Leaf ab1 Leaf ab2 Leaf)" |
   10.86 -"del x (Node4 Leaf ab1 Leaf ab2 Leaf ab3 Leaf) =
   10.87 -  T\<^sub>d(if x = fst ab1 then Node3 Leaf ab2 Leaf ab3 Leaf else
   10.88 -     if x = fst ab2 then Node3 Leaf ab1 Leaf ab3 Leaf else
   10.89 -     if x = fst ab3 then Node3 Leaf ab1 Leaf ab2 Leaf
   10.90 -     else Node4 Leaf ab1 Leaf ab2 Leaf ab3 Leaf)" |
   10.91 -"del x (Node2 l ab1 r) = (case cmp x (fst ab1) of
   10.92 -  LT \<Rightarrow> node21 (del x l) ab1 r |
   10.93 -  GT \<Rightarrow> node22 l ab1 (del x r) |
   10.94 -  EQ \<Rightarrow> let (ab1',t) = del_min r in node22 l ab1' t)" |
   10.95 -"del x (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
   10.96 -  LT \<Rightarrow> node31 (del x l) ab1 m ab2 r |
   10.97 -  EQ \<Rightarrow> let (ab1',m') = del_min m in node32 l ab1' m' ab2 r |
   10.98 -  GT \<Rightarrow> (case cmp x (fst ab2) of
   10.99 -           LT \<Rightarrow> node32 l ab1 (del x m) ab2 r |
  10.100 -           EQ \<Rightarrow> let (ab2',r') = del_min r in node33 l ab1 m ab2' r' |
  10.101 -           GT \<Rightarrow> node33 l ab1 m ab2 (del x r)))" |
  10.102 -"del x (Node4 t1 ab1 t2 ab2 t3 ab3 t4) = (case cmp x (fst ab2) of
  10.103 -  LT \<Rightarrow> (case cmp x (fst ab1) of
  10.104 -           LT \<Rightarrow> node41 (del x t1) ab1 t2 ab2 t3 ab3 t4 |
  10.105 -           EQ \<Rightarrow> let (ab',t2') = del_min t2 in node42 t1 ab' t2' ab2 t3 ab3 t4 |
  10.106 -           GT \<Rightarrow> node42 t1 ab1 (del x t2) ab2 t3 ab3 t4) |
  10.107 -  EQ \<Rightarrow> let (ab',t3') = del_min t3 in node43 t1 ab1 t2 ab' t3' ab3 t4 |
  10.108 -  GT \<Rightarrow> (case cmp x (fst ab3) of
  10.109 -          LT \<Rightarrow> node43 t1 ab1 t2 ab2 (del x t3) ab3 t4 |
  10.110 -          EQ \<Rightarrow> let (ab',t4') = del_min t4 in node44 t1 ab1 t2 ab2 t3 ab' t4' |
  10.111 -          GT \<Rightarrow> node44 t1 ab1 t2 ab2 t3 ab3 (del x t4)))"
  10.112 -
  10.113 -definition delete :: "'a::cmp \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) tree234" where
  10.114 -"delete x t = tree\<^sub>d(del x t)"
  10.115 -
  10.116 -
  10.117 -subsection "Functional correctness"
  10.118 -
  10.119 -lemma lookup: "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
  10.120 -by (induction t) (auto simp: map_of_simps split: option.split)
  10.121 -
  10.122 -
  10.123 -lemma inorder_upd:
  10.124 -  "sorted1(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(upd a b t)) = upd_list a b (inorder t)"
  10.125 -by(induction t)
  10.126 -  (auto simp: upd_list_simps, auto simp: upd_list_simps split: up\<^sub>i.splits)
  10.127 -
  10.128 -lemma inorder_update:
  10.129 -  "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
  10.130 -by(simp add: update_def inorder_upd)
  10.131 -
  10.132 -
  10.133 -lemma inorder_del: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  10.134 -  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
  10.135 -by(induction t rule: del.induct)
  10.136 -  ((auto simp: del_list_simps inorder_nodes del_minD split: prod.splits)[1])+
  10.137 -(* 200 secs (2015) *)
  10.138 -
  10.139 -lemma inorder_delete: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  10.140 -  inorder(delete x t) = del_list x (inorder t)"
  10.141 -by(simp add: delete_def inorder_del)
  10.142 -
  10.143 -
  10.144 -subsection \<open>Balancedness\<close>
  10.145 -
  10.146 -lemma bal_upd: "bal t \<Longrightarrow> bal (tree\<^sub>i(upd x y t)) \<and> height(upd x y t) = height t"
  10.147 -by (induct t) (auto, auto split: up\<^sub>i.split) (* 20 secs (2015) *)
  10.148 -
  10.149 -lemma bal_update: "bal t \<Longrightarrow> bal (update x y t)"
  10.150 -by (simp add: update_def bal_upd)
  10.151 -
  10.152 -
  10.153 -lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  10.154 -by(induction x t rule: del.induct)
  10.155 -  (auto simp add: heights height_del_min split: prod.split)
  10.156 -(* 20 secs (2015) *)
  10.157 -
  10.158 -lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
  10.159 -by(induction x t rule: del.induct)
  10.160 -  (auto simp: bals bal_del_min height_del height_del_min split: prod.split)
  10.161 -(* 100 secs (2015) *)
  10.162 -
  10.163 -corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
  10.164 -by(simp add: delete_def bal_tree\<^sub>d_del)
  10.165 -
  10.166 -
  10.167 -subsection \<open>Overall Correctness\<close>
  10.168 -
  10.169 -interpretation T234_Map: Map_by_Ordered
  10.170 -where empty = Leaf and lookup = lookup and update = update and delete = delete
  10.171 -and inorder = inorder and wf = bal
  10.172 -proof (standard, goal_cases)
  10.173 -  case 2 thus ?case by(simp add: lookup)
  10.174 -next
  10.175 -  case 3 thus ?case by(simp add: inorder_update)
  10.176 -next
  10.177 -  case 4 thus ?case by(simp add: inorder_delete)
  10.178 -next
  10.179 -  case 6 thus ?case by(simp add: bal_update)
  10.180 -next
  10.181 -  case 7 thus ?case by(simp add: bal_delete)
  10.182 -qed simp+
  10.183 -
  10.184 -end
  10.185 +(* Author: Tobias Nipkow *)
  10.186 +
  10.187 +section \<open>A 2-3-4 Tree Implementation of Maps\<close>
  10.188 +
  10.189 +theory Tree234_Map
  10.190 +imports
  10.191 +  Tree234_Set
  10.192 +  "../Data_Structures/Map_by_Ordered"
  10.193 +begin
  10.194 +
  10.195 +subsection \<open>Map operations on 2-3-4 trees\<close>
  10.196 +
  10.197 +fun lookup :: "('a::cmp * 'b) tree234 \<Rightarrow> 'a \<Rightarrow> 'b option" where
  10.198 +"lookup Leaf x = None" |
  10.199 +"lookup (Node2 l (a,b) r) x = (case cmp x a of
  10.200 +  LT \<Rightarrow> lookup l x |
  10.201 +  GT \<Rightarrow> lookup r x |
  10.202 +  EQ \<Rightarrow> Some b)" |
  10.203 +"lookup (Node3 l (a1,b1) m (a2,b2) r) x = (case cmp x a1 of
  10.204 +  LT \<Rightarrow> lookup l x |
  10.205 +  EQ \<Rightarrow> Some b1 |
  10.206 +  GT \<Rightarrow> (case cmp x a2 of
  10.207 +          LT \<Rightarrow> lookup m x |
  10.208 +          EQ \<Rightarrow> Some b2 |
  10.209 +          GT \<Rightarrow> lookup r x))" |
  10.210 +"lookup (Node4 t1 (a1,b1) t2 (a2,b2) t3 (a3,b3) t4) x = (case cmp x a2 of
  10.211 +  LT \<Rightarrow> (case cmp x a1 of
  10.212 +           LT \<Rightarrow> lookup t1 x | EQ \<Rightarrow> Some b1 | GT \<Rightarrow> lookup t2 x) |
  10.213 +  EQ \<Rightarrow> Some b2 |
  10.214 +  GT \<Rightarrow> (case cmp x a3 of
  10.215 +           LT \<Rightarrow> lookup t3 x | EQ \<Rightarrow> Some b3 | GT \<Rightarrow> lookup t4 x))"
  10.216 +
  10.217 +fun upd :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) up\<^sub>i" where
  10.218 +"upd x y Leaf = Up\<^sub>i Leaf (x,y) Leaf" |
  10.219 +"upd x y (Node2 l ab r) = (case cmp x (fst ab) of
  10.220 +   LT \<Rightarrow> (case upd x y l of
  10.221 +           T\<^sub>i l' => T\<^sub>i (Node2 l' ab r)
  10.222 +         | Up\<^sub>i l1 ab' l2 => T\<^sub>i (Node3 l1 ab' l2 ab r)) |
  10.223 +   EQ \<Rightarrow> T\<^sub>i (Node2 l (x,y) r) |
  10.224 +   GT \<Rightarrow> (case upd x y r of
  10.225 +           T\<^sub>i r' => T\<^sub>i (Node2 l ab r')
  10.226 +         | Up\<^sub>i r1 ab' r2 => T\<^sub>i (Node3 l ab r1 ab' r2)))" |
  10.227 +"upd x y (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
  10.228 +   LT \<Rightarrow> (case upd x y l of
  10.229 +           T\<^sub>i l' => T\<^sub>i (Node3 l' ab1 m ab2 r)
  10.230 +         | Up\<^sub>i l1 ab' l2 => Up\<^sub>i (Node2 l1 ab' l2) ab1 (Node2 m ab2 r)) |
  10.231 +   EQ \<Rightarrow> T\<^sub>i (Node3 l (x,y) m ab2 r) |
  10.232 +   GT \<Rightarrow> (case cmp x (fst ab2) of
  10.233 +           LT \<Rightarrow> (case upd x y m of
  10.234 +                   T\<^sub>i m' => T\<^sub>i (Node3 l ab1 m' ab2 r)
  10.235 +                 | Up\<^sub>i m1 ab' m2 => Up\<^sub>i (Node2 l ab1 m1) ab' (Node2 m2 ab2 r)) |
  10.236 +           EQ \<Rightarrow> T\<^sub>i (Node3 l ab1 m (x,y) r) |
  10.237 +           GT \<Rightarrow> (case upd x y r of
  10.238 +                   T\<^sub>i r' => T\<^sub>i (Node3 l ab1 m ab2 r')
  10.239 +                 | Up\<^sub>i r1 ab' r2 => Up\<^sub>i (Node2 l ab1 m) ab2 (Node2 r1 ab' r2))))" |
  10.240 +"upd x y (Node4 t1 ab1 t2 ab2 t3 ab3 t4) = (case cmp x (fst ab2) of
  10.241 +   LT \<Rightarrow> (case cmp x (fst ab1) of
  10.242 +            LT \<Rightarrow> (case upd x y t1 of
  10.243 +                     T\<^sub>i t1' => T\<^sub>i (Node4 t1' ab1 t2 ab2 t3 ab3 t4)
  10.244 +                  | Up\<^sub>i t11 q t12 => Up\<^sub>i (Node2 t11 q t12) ab1 (Node3 t2 ab2 t3 ab3 t4)) |
  10.245 +            EQ \<Rightarrow> T\<^sub>i (Node4 t1 (x,y) t2 ab2 t3 ab3 t4) |
  10.246 +            GT \<Rightarrow> (case upd x y t2 of
  10.247 +                    T\<^sub>i t2' => T\<^sub>i (Node4 t1 ab1 t2' ab2 t3 ab3 t4)
  10.248 +                  | Up\<^sub>i t21 q t22 => Up\<^sub>i (Node2 t1 ab1 t21) q (Node3 t22 ab2 t3 ab3 t4))) |
  10.249 +   EQ \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 (x,y) t3 ab3 t4) |
  10.250 +   GT \<Rightarrow> (case cmp x (fst ab3) of
  10.251 +            LT \<Rightarrow> (case upd x y t3 of
  10.252 +                    T\<^sub>i t3' \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 ab2 t3' ab3 t4)
  10.253 +                  | Up\<^sub>i t31 q t32 => Up\<^sub>i (Node2 t1 ab1 t2) ab2(*q*) (Node3 t31 q t32 ab3 t4)) |
  10.254 +            EQ \<Rightarrow> T\<^sub>i (Node4 t1 ab1 t2 ab2 t3 (x,y) t4) |
  10.255 +            GT \<Rightarrow> (case upd x y t4 of
  10.256 +                    T\<^sub>i t4' => T\<^sub>i (Node4 t1 ab1 t2 ab2 t3 ab3 t4')
  10.257 +                  | Up\<^sub>i t41 q t42 => Up\<^sub>i (Node2 t1 ab1 t2) ab2 (Node3 t3 ab3 t41 q t42))))"
  10.258 +
  10.259 +definition update :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) tree234" where
  10.260 +"update x y t = tree\<^sub>i(upd x y t)"
  10.261 +
  10.262 +fun del :: "'a::cmp \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) up\<^sub>d" where
  10.263 +"del x Leaf = T\<^sub>d Leaf" |
  10.264 +"del x (Node2 Leaf ab1 Leaf) = (if x=fst ab1 then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf ab1 Leaf))" |
  10.265 +"del x (Node3 Leaf ab1 Leaf ab2 Leaf) = T\<^sub>d(if x=fst ab1 then Node2 Leaf ab2 Leaf
  10.266 +  else if x=fst ab2 then Node2 Leaf ab1 Leaf else Node3 Leaf ab1 Leaf ab2 Leaf)" |
  10.267 +"del x (Node4 Leaf ab1 Leaf ab2 Leaf ab3 Leaf) =
  10.268 +  T\<^sub>d(if x = fst ab1 then Node3 Leaf ab2 Leaf ab3 Leaf else
  10.269 +     if x = fst ab2 then Node3 Leaf ab1 Leaf ab3 Leaf else
  10.270 +     if x = fst ab3 then Node3 Leaf ab1 Leaf ab2 Leaf
  10.271 +     else Node4 Leaf ab1 Leaf ab2 Leaf ab3 Leaf)" |
  10.272 +"del x (Node2 l ab1 r) = (case cmp x (fst ab1) of
  10.273 +  LT \<Rightarrow> node21 (del x l) ab1 r |
  10.274 +  GT \<Rightarrow> node22 l ab1 (del x r) |
  10.275 +  EQ \<Rightarrow> let (ab1',t) = del_min r in node22 l ab1' t)" |
  10.276 +"del x (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
  10.277 +  LT \<Rightarrow> node31 (del x l) ab1 m ab2 r |
  10.278 +  EQ \<Rightarrow> let (ab1',m') = del_min m in node32 l ab1' m' ab2 r |
  10.279 +  GT \<Rightarrow> (case cmp x (fst ab2) of
  10.280 +           LT \<Rightarrow> node32 l ab1 (del x m) ab2 r |
  10.281 +           EQ \<Rightarrow> let (ab2',r') = del_min r in node33 l ab1 m ab2' r' |
  10.282 +           GT \<Rightarrow> node33 l ab1 m ab2 (del x r)))" |
  10.283 +"del x (Node4 t1 ab1 t2 ab2 t3 ab3 t4) = (case cmp x (fst ab2) of
  10.284 +  LT \<Rightarrow> (case cmp x (fst ab1) of
  10.285 +           LT \<Rightarrow> node41 (del x t1) ab1 t2 ab2 t3 ab3 t4 |
  10.286 +           EQ \<Rightarrow> let (ab',t2') = del_min t2 in node42 t1 ab' t2' ab2 t3 ab3 t4 |
  10.287 +           GT \<Rightarrow> node42 t1 ab1 (del x t2) ab2 t3 ab3 t4) |
  10.288 +  EQ \<Rightarrow> let (ab',t3') = del_min t3 in node43 t1 ab1 t2 ab' t3' ab3 t4 |
  10.289 +  GT \<Rightarrow> (case cmp x (fst ab3) of
  10.290 +          LT \<Rightarrow> node43 t1 ab1 t2 ab2 (del x t3) ab3 t4 |
  10.291 +          EQ \<Rightarrow> let (ab',t4') = del_min t4 in node44 t1 ab1 t2 ab2 t3 ab' t4' |
  10.292 +          GT \<Rightarrow> node44 t1 ab1 t2 ab2 t3 ab3 (del x t4)))"
  10.293 +
  10.294 +definition delete :: "'a::cmp \<Rightarrow> ('a*'b) tree234 \<Rightarrow> ('a*'b) tree234" where
  10.295 +"delete x t = tree\<^sub>d(del x t)"
  10.296 +
  10.297 +
  10.298 +subsection "Functional correctness"
  10.299 +
  10.300 +lemma lookup: "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
  10.301 +by (induction t) (auto simp: map_of_simps split: option.split)
  10.302 +
  10.303 +
  10.304 +lemma inorder_upd:
  10.305 +  "sorted1(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(upd a b t)) = upd_list a b (inorder t)"
  10.306 +by(induction t)
  10.307 +  (auto simp: upd_list_simps, auto simp: upd_list_simps split: up\<^sub>i.splits)
  10.308 +
  10.309 +lemma inorder_update:
  10.310 +  "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
  10.311 +by(simp add: update_def inorder_upd)
  10.312 +
  10.313 +
  10.314 +lemma inorder_del: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  10.315 +  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
  10.316 +by(induction t rule: del.induct)
  10.317 +  ((auto simp: del_list_simps inorder_nodes del_minD split: prod.splits)[1])+
  10.318 +(* 200 secs (2015) *)
  10.319 +
  10.320 +lemma inorder_delete: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  10.321 +  inorder(delete x t) = del_list x (inorder t)"
  10.322 +by(simp add: delete_def inorder_del)
  10.323 +
  10.324 +
  10.325 +subsection \<open>Balancedness\<close>
  10.326 +
  10.327 +lemma bal_upd: "bal t \<Longrightarrow> bal (tree\<^sub>i(upd x y t)) \<and> height(upd x y t) = height t"
  10.328 +by (induct t) (auto, auto split: up\<^sub>i.split) (* 20 secs (2015) *)
  10.329 +
  10.330 +lemma bal_update: "bal t \<Longrightarrow> bal (update x y t)"
  10.331 +by (simp add: update_def bal_upd)
  10.332 +
  10.333 +
  10.334 +lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  10.335 +by(induction x t rule: del.induct)
  10.336 +  (auto simp add: heights height_del_min split: prod.split)
  10.337 +(* 20 secs (2015) *)
  10.338 +
  10.339 +lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
  10.340 +by(induction x t rule: del.induct)
  10.341 +  (auto simp: bals bal_del_min height_del height_del_min split: prod.split)
  10.342 +(* 100 secs (2015) *)
  10.343 +
  10.344 +corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
  10.345 +by(simp add: delete_def bal_tree\<^sub>d_del)
  10.346 +
  10.347 +
  10.348 +subsection \<open>Overall Correctness\<close>
  10.349 +
  10.350 +interpretation T234_Map: Map_by_Ordered
  10.351 +where empty = Leaf and lookup = lookup and update = update and delete = delete
  10.352 +and inorder = inorder and wf = bal
  10.353 +proof (standard, goal_cases)
  10.354 +  case 2 thus ?case by(simp add: lookup)
  10.355 +next
  10.356 +  case 3 thus ?case by(simp add: inorder_update)
  10.357 +next
  10.358 +  case 4 thus ?case by(simp add: inorder_delete)
  10.359 +next
  10.360 +  case 6 thus ?case by(simp add: bal_update)
  10.361 +next
  10.362 +  case 7 thus ?case by(simp add: bal_delete)
  10.363 +qed simp+
  10.364 +
  10.365 +end
    11.1 --- a/src/HOL/Data_Structures/Tree234_Set.thy	Wed Nov 11 16:42:30 2015 +0100
    11.2 +++ b/src/HOL/Data_Structures/Tree234_Set.thy	Wed Nov 11 18:32:26 2015 +0100
    11.3 @@ -1,513 +1,513 @@
    11.4 -(* Author: Tobias Nipkow *)
    11.5 -
    11.6 -section \<open>A 2-3-4 Tree Implementation of Sets\<close>
    11.7 -
    11.8 -theory Tree234_Set
    11.9 -imports
   11.10 -  Tree234
   11.11 -  Cmp
   11.12 -  "../Data_Structures/Set_by_Ordered"
   11.13 -begin
   11.14 -
   11.15 -subsection \<open>Set operations on 2-3-4 trees\<close>
   11.16 -
   11.17 -fun isin :: "'a::cmp tree234 \<Rightarrow> 'a \<Rightarrow> bool" where
   11.18 -"isin Leaf x = False" |
   11.19 -"isin (Node2 l a r) x =
   11.20 -  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x)" |
   11.21 -"isin (Node3 l a m b r) x =
   11.22 -  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> (case cmp x b of
   11.23 -   LT \<Rightarrow> isin m x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x))" |
   11.24 -"isin (Node4 t1 a t2 b t3 c t4) x = (case cmp x b of
   11.25 -  LT \<Rightarrow> (case cmp x a of
   11.26 -          LT \<Rightarrow> isin t1 x |
   11.27 -          EQ \<Rightarrow> True |
   11.28 -          GT \<Rightarrow> isin t2 x) |
   11.29 -  EQ \<Rightarrow> True |
   11.30 -  GT \<Rightarrow> (case cmp x c of
   11.31 -          LT \<Rightarrow> isin t3 x |
   11.32 -          EQ \<Rightarrow> True |
   11.33 -          GT \<Rightarrow> isin t4 x))"
   11.34 -
   11.35 -datatype 'a up\<^sub>i = T\<^sub>i "'a tree234" | Up\<^sub>i "'a tree234" 'a "'a tree234"
   11.36 -
   11.37 -fun tree\<^sub>i :: "'a up\<^sub>i \<Rightarrow> 'a tree234" where
   11.38 -"tree\<^sub>i (T\<^sub>i t) = t" |
   11.39 -"tree\<^sub>i (Up\<^sub>i l p r) = Node2 l p r"
   11.40 -
   11.41 -fun ins :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>i" where
   11.42 -"ins x Leaf = Up\<^sub>i Leaf x Leaf" |
   11.43 -"ins x (Node2 l a r) =
   11.44 -   (case cmp x a of
   11.45 -      LT \<Rightarrow> (case ins x l of
   11.46 -              T\<^sub>i l' => T\<^sub>i (Node2 l' a r)
   11.47 -            | Up\<^sub>i l1 b l2 => T\<^sub>i (Node3 l1 b l2 a r)) |
   11.48 -      EQ \<Rightarrow> T\<^sub>i (Node2 l x r) |
   11.49 -      GT \<Rightarrow> (case ins x r of
   11.50 -              T\<^sub>i r' => T\<^sub>i (Node2 l a r')
   11.51 -            | Up\<^sub>i r1 b r2 => T\<^sub>i (Node3 l a r1 b r2)))" |
   11.52 -"ins x (Node3 l a m b r) =
   11.53 -   (case cmp x a of
   11.54 -      LT \<Rightarrow> (case ins x l of
   11.55 -              T\<^sub>i l' => T\<^sub>i (Node3 l' a m b r)
   11.56 -            | Up\<^sub>i l1 c l2 => Up\<^sub>i (Node2 l1 c l2) a (Node2 m b r)) |
   11.57 -      EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
   11.58 -      GT \<Rightarrow> (case cmp x b of
   11.59 -               GT \<Rightarrow> (case ins x r of
   11.60 -                       T\<^sub>i r' => T\<^sub>i (Node3 l a m b r')
   11.61 -                     | Up\<^sub>i r1 c r2 => Up\<^sub>i (Node2 l a m) b (Node2 r1 c r2)) |
   11.62 -               EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
   11.63 -               LT \<Rightarrow> (case ins x m of
   11.64 -                       T\<^sub>i m' => T\<^sub>i (Node3 l a m' b r)
   11.65 -                     | Up\<^sub>i m1 c m2 => Up\<^sub>i (Node2 l a m1) c (Node2 m2 b r))))" |
   11.66 -"ins a (Node4 l x1 m x2 n x3 r) =
   11.67 -   (if a < x2 then
   11.68 -      if a < x1 then
   11.69 -        (case ins a l of
   11.70 -           T\<^sub>i l' => T\<^sub>i (Node4 l' x1 m x2 n x3 r)
   11.71 -         | Up\<^sub>i l1 q l2 => Up\<^sub>i (Node2 l1 q l2) x1 (Node3 m x2 n x3 r))
   11.72 -      else if a=x1 then T\<^sub>i (Node4 l x1 m x2 n x3 r)
   11.73 -      else (case ins a m of
   11.74 -                T\<^sub>i m' => T\<^sub>i (Node4 l x1 m' x2 n x3 r)
   11.75 -              | Up\<^sub>i m1 q m2 => Up\<^sub>i (Node2 l x1 m1) q (Node3 m2 x2 n x3 r))
   11.76 -    else if a=x2 then T\<^sub>i (Node4 l x1 m x2 n x3 r)
   11.77 -    else if a < x3 then
   11.78 -           (case ins a n of
   11.79 -              T\<^sub>i n' => T\<^sub>i (Node4 l x1 m x2 n' x3 r)
   11.80 -            | Up\<^sub>i n1 q n2 => Up\<^sub>i (Node2 l x1 m) x2 (Node3 n1 q n2 x3 r))
   11.81 -         else if a=x3 then T\<^sub>i (Node4 l x1 m x2 n x3 r)
   11.82 -         else (case ins a r of
   11.83 -              T\<^sub>i r' => T\<^sub>i (Node4 l x1 m x2 n x3 r')
   11.84 -            | Up\<^sub>i r1 q r2 => Up\<^sub>i (Node2 l x1 m) x2 (Node3 n x3 r1 q r2))
   11.85 -)"
   11.86 -
   11.87 -hide_const insert
   11.88 -
   11.89 -definition insert :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a tree234" where
   11.90 -"insert x t = tree\<^sub>i(ins x t)"
   11.91 -
   11.92 -datatype 'a up\<^sub>d = T\<^sub>d "'a tree234" | Up\<^sub>d "'a tree234"
   11.93 -
   11.94 -fun tree\<^sub>d :: "'a up\<^sub>d \<Rightarrow> 'a tree234" where
   11.95 -"tree\<^sub>d (T\<^sub>d x) = x" |
   11.96 -"tree\<^sub>d (Up\<^sub>d x) = x"
   11.97 -
   11.98 -fun node21 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
   11.99 -"node21 (T\<^sub>d l) a r = T\<^sub>d(Node2 l a r)" |
  11.100 -"node21 (Up\<^sub>d l) a (Node2 lr b rr) = Up\<^sub>d(Node3 l a lr b rr)" |
  11.101 -"node21 (Up\<^sub>d l) a (Node3 lr b mr c rr) = T\<^sub>d(Node2 (Node2 l a lr) b (Node2 mr c rr))" |
  11.102 -"node21 (Up\<^sub>d t1) a (Node4 t2 b t3 c t4 d t5) = T\<^sub>d(Node2 (Node2 t1 a t2) b (Node3 t3 c t4 d t5))"
  11.103 -
  11.104 -fun node22 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  11.105 -"node22 l a (T\<^sub>d r) = T\<^sub>d(Node2 l a r)" |
  11.106 -"node22 (Node2 ll b rl) a (Up\<^sub>d r) = Up\<^sub>d(Node3 ll b rl a r)" |
  11.107 -"node22 (Node3 ll b ml c rl) a (Up\<^sub>d r) = T\<^sub>d(Node2 (Node2 ll b ml) c (Node2 rl a r))" |
  11.108 -"node22 (Node4 t1 a t2 b t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node2 (Node2 t1 a t2) b (Node3 t3 c t4 d t5))"
  11.109 -
  11.110 -fun node31 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.111 -"node31 (T\<^sub>d t1) a t2 b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
  11.112 -"node31 (Up\<^sub>d t1) a (Node2 t2 b t3) c t4 = T\<^sub>d(Node2 (Node3 t1 a t2 b t3) c t4)" |
  11.113 -"node31 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) d t5 = T\<^sub>d(Node3 (Node2 t1 a t2) b (Node2 t3 c t4) d t5)" |
  11.114 -"node31 (Up\<^sub>d t1) a (Node4 t2 b t3 c t4 d t5) e t6 = T\<^sub>d(Node3 (Node2 t1 a t2) b (Node3 t3 c t4 d t5) e t6)"
  11.115 -
  11.116 -fun node32 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.117 -"node32 t1 a (T\<^sub>d t2) b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
  11.118 -"node32 t1 a (Up\<^sub>d t2) b (Node2 t3 c t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
  11.119 -"node32 t1 a (Up\<^sub>d t2) b (Node3 t3 c t4 d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" |
  11.120 -"node32 t1 a (Up\<^sub>d t2) b (Node4 t3 c t4 d t5 e t6) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node3 t4 d t5 e t6))"
  11.121 -
  11.122 -fun node33 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  11.123 -"node33 l a m b (T\<^sub>d r) = T\<^sub>d(Node3 l a m b r)" |
  11.124 -"node33 t1 a (Node2 t2 b t3) c (Up\<^sub>d t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
  11.125 -"node33 t1 a (Node3 t2 b t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" |
  11.126 -"node33 t1 a (Node4 t2 b t3 c t4 d t5) e (Up\<^sub>d t6) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node3 t4 d t5 e t6))"
  11.127 -
  11.128 -fun node41 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.129 -"node41 (T\<^sub>d t1) a t2 b t3 c t4 = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.130 -"node41 (Up\<^sub>d t1) a (Node2 t2 b t3) c t4 d t5 = T\<^sub>d(Node3 (Node3 t1 a t2 b t3) c t4 d t5)" |
  11.131 -"node41 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) d t5 e t6 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node2 t3 c t4) d t5 e t6)" |
  11.132 -"node41 (Up\<^sub>d t1) a (Node4 t2 b t3 c t4 d t5) e t6 f t7 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node3 t3 c t4 d t5) e t6 f t7)"
  11.133 -
  11.134 -fun node42 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.135 -"node42 t1 a (T\<^sub>d t2) b t3 c t4 = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.136 -"node42 (Node2 t1 a t2) b (Up\<^sub>d t3) c t4 d t5 = T\<^sub>d(Node3 (Node3 t1 a t2 b t3) c t4 d t5)" |
  11.137 -"node42 (Node3 t1 a t2 b t3) c (Up\<^sub>d t4) d t5 e t6 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node2 t3 c t4) d t5 e t6)" |
  11.138 -"node42 (Node4 t1 a t2 b t3 c t4) d (Up\<^sub>d t5) e t6 f t7 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node3 t3 c t4 d t5) e t6 f t7)"
  11.139 -
  11.140 -fun node43 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.141 -"node43 t1 a t2 b (T\<^sub>d t3) c t4 = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.142 -"node43 t1 a (Node2 t2 b t3) c (Up\<^sub>d t4) d t5 = T\<^sub>d(Node3 t1 a (Node3 t2 b t3 c t4) d t5)" |
  11.143 -"node43 t1 a (Node3 t2 b t3 c t4) d (Up\<^sub>d t5) e t6 = T\<^sub>d(Node4 t1 a (Node2 t2 b t3) c (Node2 t4 d t5) e t6)" |
  11.144 -"node43 t1 a (Node4 t2 b t3 c t4 d t5) e (Up\<^sub>d t6) f t7 = T\<^sub>d(Node4 t1 a (Node2 t2 b t3) c (Node3 t4 d t5 e t6) f t7)"
  11.145 -
  11.146 -fun node44 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  11.147 -"node44 t1 a t2 b t3 c (T\<^sub>d t4) = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.148 -"node44 t1 a t2 b (Node2 t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node3 t1 a t2 b (Node3 t3 c t4 d t5))" |
  11.149 -"node44 t1 a t2 b (Node3 t3 c t4 d t5) e (Up\<^sub>d t6) = T\<^sub>d(Node4 t1 a t2 b (Node2 t3 c t4) d (Node2 t5 e t6))" |
  11.150 -"node44 t1 a t2 b (Node4 t3 c t4 d t5 e t6) f (Up\<^sub>d t7) = T\<^sub>d(Node4 t1 a t2 b (Node2 t3 c t4) d (Node3 t5 e t6 f t7))"
  11.151 -
  11.152 -fun del_min :: "'a tree234 \<Rightarrow> 'a * 'a up\<^sub>d" where
  11.153 -"del_min (Node2 Leaf a Leaf) = (a, Up\<^sub>d Leaf)" |
  11.154 -"del_min (Node3 Leaf a Leaf b Leaf) = (a, T\<^sub>d(Node2 Leaf b Leaf))" |
  11.155 -"del_min (Node4 Leaf a Leaf b Leaf c Leaf) = (a, T\<^sub>d(Node3 Leaf b Leaf c Leaf))" |
  11.156 -"del_min (Node2 l a r) = (let (x,l') = del_min l in (x, node21 l' a r))" |
  11.157 -"del_min (Node3 l a m b r) = (let (x,l') = del_min l in (x, node31 l' a m b r))" |
  11.158 -"del_min (Node4 l a m b n c r) = (let (x,l') = del_min l in (x, node41 l' a m b n c r))"
  11.159 -
  11.160 -fun del :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.161 -"del k Leaf = T\<^sub>d Leaf" |
  11.162 -"del k (Node2 Leaf p Leaf) = (if k=p then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf p Leaf))" |
  11.163 -"del k (Node3 Leaf p Leaf q Leaf) = T\<^sub>d(if k=p then Node2 Leaf q Leaf
  11.164 -  else if k=q then Node2 Leaf p Leaf else Node3 Leaf p Leaf q Leaf)" |
  11.165 -"del k (Node4 Leaf a Leaf b Leaf c Leaf) =
  11.166 -  T\<^sub>d(if k=a then Node3 Leaf b Leaf c Leaf else
  11.167 -     if k=b then Node3 Leaf a Leaf c Leaf else
  11.168 -     if k=c then Node3 Leaf a Leaf b Leaf
  11.169 -     else Node4 Leaf a Leaf b Leaf c Leaf)" |
  11.170 -"del k (Node2 l a r) = (case cmp k a of
  11.171 -  LT \<Rightarrow> node21 (del k l) a r |
  11.172 -  GT \<Rightarrow> node22 l a (del k r) |
  11.173 -  EQ \<Rightarrow> let (a',t) = del_min r in node22 l a' t)" |
  11.174 -"del k (Node3 l a m b r) = (case cmp k a of
  11.175 -  LT \<Rightarrow> node31 (del k l) a m b r |
  11.176 -  EQ \<Rightarrow> let (a',m') = del_min m in node32 l a' m' b r |
  11.177 -  GT \<Rightarrow> (case cmp k b of
  11.178 -           LT \<Rightarrow> node32 l a (del k m) b r |
  11.179 -           EQ \<Rightarrow> let (b',r') = del_min r in node33 l a m b' r' |
  11.180 -           GT \<Rightarrow> node33 l a m b (del k r)))" |
  11.181 -"del k (Node4 l a m b n c r) = (case cmp k b of
  11.182 -  LT \<Rightarrow> (case cmp k a of
  11.183 -          LT \<Rightarrow> node41 (del k l) a m b n c r |
  11.184 -          EQ \<Rightarrow> let (a',m') = del_min m in node42 l a' m' b n c r |
  11.185 -          GT \<Rightarrow> node42 l a (del k m) b n c r) |
  11.186 -  EQ \<Rightarrow> let (b',n') = del_min n in node43 l a m b' n' c r |
  11.187 -  GT \<Rightarrow> (case cmp k c of
  11.188 -           LT \<Rightarrow> node43 l a m b (del k n) c r |
  11.189 -           EQ \<Rightarrow> let (c',r') = del_min r in node44 l a m b n c' r' |
  11.190 -           GT \<Rightarrow> node44 l a m b n c (del k r)))"
  11.191 -
  11.192 -definition delete :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a tree234" where
  11.193 -"delete x t = tree\<^sub>d(del x t)"
  11.194 -
  11.195 -
  11.196 -subsection "Functional correctness"
  11.197 -
  11.198 -subsubsection \<open>Functional correctness of isin:\<close>
  11.199 -
  11.200 -lemma "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  11.201 -by (induction t) (auto simp: elems_simps1 ball_Un)
  11.202 -
  11.203 -lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  11.204 -by (induction t) (auto simp: elems_simps2)
  11.205 -
  11.206 -
  11.207 -subsubsection \<open>Functional correctness of insert:\<close>
  11.208 -
  11.209 -lemma inorder_ins:
  11.210 -  "sorted(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(ins x t)) = ins_list x (inorder t)"
  11.211 -by(induction t) (auto, auto simp: ins_list_simps split: up\<^sub>i.splits)
  11.212 -
  11.213 -lemma inorder_insert:
  11.214 -  "sorted(inorder t) \<Longrightarrow> inorder(insert a t) = ins_list a (inorder t)"
  11.215 -by(simp add: insert_def inorder_ins)
  11.216 -
  11.217 -
  11.218 -subsubsection \<open>Functional correctness of delete\<close>
  11.219 -
  11.220 -lemma inorder_node21: "height r > 0 \<Longrightarrow>
  11.221 -  inorder (tree\<^sub>d (node21 l' a r)) = inorder (tree\<^sub>d l') @ a # inorder r"
  11.222 -by(induct l' a r rule: node21.induct) auto
  11.223 -
  11.224 -lemma inorder_node22: "height l > 0 \<Longrightarrow>
  11.225 -  inorder (tree\<^sub>d (node22 l a r')) = inorder l @ a # inorder (tree\<^sub>d r')"
  11.226 -by(induct l a r' rule: node22.induct) auto
  11.227 -
  11.228 -lemma inorder_node31: "height m > 0 \<Longrightarrow>
  11.229 -  inorder (tree\<^sub>d (node31 l' a m b r)) = inorder (tree\<^sub>d l') @ a # inorder m @ b # inorder r"
  11.230 -by(induct l' a m b r rule: node31.induct) auto
  11.231 -
  11.232 -lemma inorder_node32: "height r > 0 \<Longrightarrow>
  11.233 -  inorder (tree\<^sub>d (node32 l a m' b r)) = inorder l @ a # inorder (tree\<^sub>d m') @ b # inorder r"
  11.234 -by(induct l a m' b r rule: node32.induct) auto
  11.235 -
  11.236 -lemma inorder_node33: "height m > 0 \<Longrightarrow>
  11.237 -  inorder (tree\<^sub>d (node33 l a m b r')) = inorder l @ a # inorder m @ b # inorder (tree\<^sub>d r')"
  11.238 -by(induct l a m b r' rule: node33.induct) auto
  11.239 -
  11.240 -lemma inorder_node41: "height m > 0 \<Longrightarrow>
  11.241 -  inorder (tree\<^sub>d (node41 l' a m b n c r)) = inorder (tree\<^sub>d l') @ a # inorder m @ b # inorder n @ c # inorder r"
  11.242 -by(induct l' a m b n c r rule: node41.induct) auto
  11.243 -
  11.244 -lemma inorder_node42: "height l > 0 \<Longrightarrow>
  11.245 -  inorder (tree\<^sub>d (node42 l a m b n c r)) = inorder l @ a # inorder (tree\<^sub>d m) @ b # inorder n @ c # inorder r"
  11.246 -by(induct l a m b n c r rule: node42.induct) auto
  11.247 -
  11.248 -lemma inorder_node43: "height m > 0 \<Longrightarrow>
  11.249 -  inorder (tree\<^sub>d (node43 l a m b n c r)) = inorder l @ a # inorder m @ b # inorder(tree\<^sub>d n) @ c # inorder r"
  11.250 -by(induct l a m b n c r rule: node43.induct) auto
  11.251 -
  11.252 -lemma inorder_node44: "height n > 0 \<Longrightarrow>
  11.253 -  inorder (tree\<^sub>d (node44 l a m b n c r)) = inorder l @ a # inorder m @ b # inorder n @ c # inorder (tree\<^sub>d r)"
  11.254 -by(induct l a m b n c r rule: node44.induct) auto
  11.255 -
  11.256 -lemmas inorder_nodes = inorder_node21 inorder_node22
  11.257 -  inorder_node31 inorder_node32 inorder_node33
  11.258 -  inorder_node41 inorder_node42 inorder_node43 inorder_node44
  11.259 -
  11.260 -lemma del_minD:
  11.261 -  "del_min t = (x,t') \<Longrightarrow> bal t \<Longrightarrow> height t > 0 \<Longrightarrow>
  11.262 -  x # inorder(tree\<^sub>d t') = inorder t"
  11.263 -by(induction t arbitrary: t' rule: del_min.induct)
  11.264 -  (auto simp: inorder_nodes split: prod.splits)
  11.265 -
  11.266 -lemma inorder_del: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  11.267 -  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
  11.268 -by(induction t rule: del.induct)
  11.269 -  (auto simp: inorder_nodes del_list_simps del_minD split: prod.splits)
  11.270 -  (* 150 secs (2015) *)
  11.271 -
  11.272 -lemma inorder_delete: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  11.273 -  inorder(delete x t) = del_list x (inorder t)"
  11.274 -by(simp add: delete_def inorder_del)
  11.275 -
  11.276 -
  11.277 -subsection \<open>Balancedness\<close>
  11.278 -
  11.279 -subsubsection "Proofs for insert"
  11.280 -
  11.281 -text{* First a standard proof that @{const ins} preserves @{const bal}. *}
  11.282 -
  11.283 -instantiation up\<^sub>i :: (type)height
  11.284 -begin
  11.285 -
  11.286 -fun height_up\<^sub>i :: "'a up\<^sub>i \<Rightarrow> nat" where
  11.287 -"height (T\<^sub>i t) = height t" |
  11.288 -"height (Up\<^sub>i l a r) = height l"
  11.289 -
  11.290 -instance ..
  11.291 -
  11.292 -end
  11.293 -
  11.294 -lemma bal_ins: "bal t \<Longrightarrow> bal (tree\<^sub>i(ins a t)) \<and> height(ins a t) = height t"
  11.295 -by (induct t) (auto, auto split: up\<^sub>i.split) (* 20 secs (2015) *)
  11.296 -
  11.297 -
  11.298 -text{* Now an alternative proof (by Brian Huffman) that runs faster because
  11.299 -two properties (balance and height) are combined in one predicate. *}
  11.300 -
  11.301 -inductive full :: "nat \<Rightarrow> 'a tree234 \<Rightarrow> bool" where
  11.302 -"full 0 Leaf" |
  11.303 -"\<lbrakk>full n l; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node2 l p r)" |
  11.304 -"\<lbrakk>full n l; full n m; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node3 l p m q r)" |
  11.305 -"\<lbrakk>full n l; full n m; full n m'; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node4 l p m q m' q' r)"
  11.306 -
  11.307 -inductive_cases full_elims:
  11.308 -  "full n Leaf"
  11.309 -  "full n (Node2 l p r)"
  11.310 -  "full n (Node3 l p m q r)"
  11.311 -  "full n (Node4 l p m q m' q' r)"
  11.312 -
  11.313 -inductive_cases full_0_elim: "full 0 t"
  11.314 -inductive_cases full_Suc_elim: "full (Suc n) t"
  11.315 -
  11.316 -lemma full_0_iff [simp]: "full 0 t \<longleftrightarrow> t = Leaf"
  11.317 -  by (auto elim: full_0_elim intro: full.intros)
  11.318 -
  11.319 -lemma full_Leaf_iff [simp]: "full n Leaf \<longleftrightarrow> n = 0"
  11.320 -  by (auto elim: full_elims intro: full.intros)
  11.321 -
  11.322 -lemma full_Suc_Node2_iff [simp]:
  11.323 -  "full (Suc n) (Node2 l p r) \<longleftrightarrow> full n l \<and> full n r"
  11.324 -  by (auto elim: full_elims intro: full.intros)
  11.325 -
  11.326 -lemma full_Suc_Node3_iff [simp]:
  11.327 -  "full (Suc n) (Node3 l p m q r) \<longleftrightarrow> full n l \<and> full n m \<and> full n r"
  11.328 -  by (auto elim: full_elims intro: full.intros)
  11.329 -
  11.330 -lemma full_Suc_Node4_iff [simp]:
  11.331 -  "full (Suc n) (Node4 l p m q m' q' r) \<longleftrightarrow> full n l \<and> full n m \<and> full n m' \<and> full n r"
  11.332 -  by (auto elim: full_elims intro: full.intros)
  11.333 -
  11.334 -lemma full_imp_height: "full n t \<Longrightarrow> height t = n"
  11.335 -  by (induct set: full, simp_all)
  11.336 -
  11.337 -lemma full_imp_bal: "full n t \<Longrightarrow> bal t"
  11.338 -  by (induct set: full, auto dest: full_imp_height)
  11.339 -
  11.340 -lemma bal_imp_full: "bal t \<Longrightarrow> full (height t) t"
  11.341 -  by (induct t, simp_all)
  11.342 -
  11.343 -lemma bal_iff_full: "bal t \<longleftrightarrow> (\<exists>n. full n t)"
  11.344 -  by (auto elim!: bal_imp_full full_imp_bal)
  11.345 -
  11.346 -text {* The @{const "insert"} function either preserves the height of the
  11.347 -tree, or increases it by one. The constructor returned by the @{term
  11.348 -"insert"} function determines which: A return value of the form @{term
  11.349 -"T\<^sub>i t"} indicates that the height will be the same. A value of the
  11.350 -form @{term "Up\<^sub>i l p r"} indicates an increase in height. *}
  11.351 -
  11.352 -primrec full\<^sub>i :: "nat \<Rightarrow> 'a up\<^sub>i \<Rightarrow> bool" where
  11.353 -"full\<^sub>i n (T\<^sub>i t) \<longleftrightarrow> full n t" |
  11.354 -"full\<^sub>i n (Up\<^sub>i l p r) \<longleftrightarrow> full n l \<and> full n r"
  11.355 -
  11.356 -lemma full\<^sub>i_ins: "full n t \<Longrightarrow> full\<^sub>i n (ins a t)"
  11.357 -by (induct rule: full.induct) (auto, auto split: up\<^sub>i.split)
  11.358 -
  11.359 -text {* The @{const insert} operation preserves balance. *}
  11.360 -
  11.361 -lemma bal_insert: "bal t \<Longrightarrow> bal (insert a t)"
  11.362 -unfolding bal_iff_full insert_def
  11.363 -apply (erule exE)
  11.364 -apply (drule full\<^sub>i_ins [of _ _ a])
  11.365 -apply (cases "ins a t")
  11.366 -apply (auto intro: full.intros)
  11.367 -done
  11.368 -
  11.369 -
  11.370 -subsubsection "Proofs for delete"
  11.371 -
  11.372 -instantiation up\<^sub>d :: (type)height
  11.373 -begin
  11.374 -
  11.375 -fun height_up\<^sub>d :: "'a up\<^sub>d \<Rightarrow> nat" where
  11.376 -"height (T\<^sub>d t) = height t" |
  11.377 -"height (Up\<^sub>d t) = height t + 1"
  11.378 -
  11.379 -instance ..
  11.380 -
  11.381 -end
  11.382 -
  11.383 -lemma bal_tree\<^sub>d_node21:
  11.384 -  "\<lbrakk>bal r; bal (tree\<^sub>d l); height r = height l \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node21 l a r))"
  11.385 -by(induct l a r rule: node21.induct) auto
  11.386 -
  11.387 -lemma bal_tree\<^sub>d_node22:
  11.388 -  "\<lbrakk>bal(tree\<^sub>d r); bal l; height r = height l \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node22 l a r))"
  11.389 -by(induct l a r rule: node22.induct) auto
  11.390 -
  11.391 -lemma bal_tree\<^sub>d_node31:
  11.392 -  "\<lbrakk> bal (tree\<^sub>d l); bal m; bal r; height l = height r; height m = height r \<rbrakk>
  11.393 -  \<Longrightarrow> bal (tree\<^sub>d (node31 l a m b r))"
  11.394 -by(induct l a m b r rule: node31.induct) auto
  11.395 -
  11.396 -lemma bal_tree\<^sub>d_node32:
  11.397 -  "\<lbrakk> bal l; bal (tree\<^sub>d m); bal r; height l = height r; height m = height r \<rbrakk>
  11.398 -  \<Longrightarrow> bal (tree\<^sub>d (node32 l a m b r))"
  11.399 -by(induct l a m b r rule: node32.induct) auto
  11.400 -
  11.401 -lemma bal_tree\<^sub>d_node33:
  11.402 -  "\<lbrakk> bal l; bal m; bal(tree\<^sub>d r); height l = height r; height m = height r \<rbrakk>
  11.403 -  \<Longrightarrow> bal (tree\<^sub>d (node33 l a m b r))"
  11.404 -by(induct l a m b r rule: node33.induct) auto
  11.405 -
  11.406 -lemma bal_tree\<^sub>d_node41:
  11.407 -  "\<lbrakk> bal (tree\<^sub>d l); bal m; bal n; bal r; height l = height r; height m = height r; height n = height r \<rbrakk>
  11.408 -  \<Longrightarrow> bal (tree\<^sub>d (node41 l a m b n c r))"
  11.409 -by(induct l a m b n c r rule: node41.induct) auto
  11.410 -
  11.411 -lemma bal_tree\<^sub>d_node42:
  11.412 -  "\<lbrakk> bal l; bal (tree\<^sub>d m); bal n; bal r; height l = height r; height m = height r; height n = height r \<rbrakk>
  11.413 -  \<Longrightarrow> bal (tree\<^sub>d (node42 l a m b n c r))"
  11.414 -by(induct l a m b n c r rule: node42.induct) auto
  11.415 -
  11.416 -lemma bal_tree\<^sub>d_node43:
  11.417 -  "\<lbrakk> bal l; bal m; bal (tree\<^sub>d n); bal r; height l = height r; height m = height r; height n = height r \<rbrakk>
  11.418 -  \<Longrightarrow> bal (tree\<^sub>d (node43 l a m b n c r))"
  11.419 -by(induct l a m b n c r rule: node43.induct) auto
  11.420 -
  11.421 -lemma bal_tree\<^sub>d_node44:
  11.422 -  "\<lbrakk> bal l; bal m; bal n; bal (tree\<^sub>d r); height l = height r; height m = height r; height n = height r \<rbrakk>
  11.423 -  \<Longrightarrow> bal (tree\<^sub>d (node44 l a m b n c r))"
  11.424 -by(induct l a m b n c r rule: node44.induct) auto
  11.425 -
  11.426 -lemmas bals = bal_tree\<^sub>d_node21 bal_tree\<^sub>d_node22
  11.427 -  bal_tree\<^sub>d_node31 bal_tree\<^sub>d_node32 bal_tree\<^sub>d_node33
  11.428 -  bal_tree\<^sub>d_node41 bal_tree\<^sub>d_node42 bal_tree\<^sub>d_node43 bal_tree\<^sub>d_node44
  11.429 -
  11.430 -lemma height_node21:
  11.431 -   "height r > 0 \<Longrightarrow> height(node21 l a r) = max (height l) (height r) + 1"
  11.432 -by(induct l a r rule: node21.induct)(simp_all add: max.assoc)
  11.433 -
  11.434 -lemma height_node22:
  11.435 -   "height l > 0 \<Longrightarrow> height(node22 l a r) = max (height l) (height r) + 1"
  11.436 -by(induct l a r rule: node22.induct)(simp_all add: max.assoc)
  11.437 -
  11.438 -lemma height_node31:
  11.439 -  "height m > 0 \<Longrightarrow> height(node31 l a m b r) =
  11.440 -   max (height l) (max (height m) (height r)) + 1"
  11.441 -by(induct l a m b r rule: node31.induct)(simp_all add: max_def)
  11.442 -
  11.443 -lemma height_node32:
  11.444 -  "height r > 0 \<Longrightarrow> height(node32 l a m b r) =
  11.445 -   max (height l) (max (height m) (height r)) + 1"
  11.446 -by(induct l a m b r rule: node32.induct)(simp_all add: max_def)
  11.447 -
  11.448 -lemma height_node33:
  11.449 -  "height m > 0 \<Longrightarrow> height(node33 l a m b r) =
  11.450 -   max (height l) (max (height m) (height r)) + 1"
  11.451 -by(induct l a m b r rule: node33.induct)(simp_all add: max_def)
  11.452 -
  11.453 -lemma height_node41:
  11.454 -  "height m > 0 \<Longrightarrow> height(node41 l a m b n c r) =
  11.455 -   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.456 -by(induct l a m b n c r rule: node41.induct)(simp_all add: max_def)
  11.457 -
  11.458 -lemma height_node42:
  11.459 -  "height l > 0 \<Longrightarrow> height(node42 l a m b n c r) =
  11.460 -   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.461 -by(induct l a m b n c r rule: node42.induct)(simp_all add: max_def)
  11.462 -
  11.463 -lemma height_node43:
  11.464 -  "height m > 0 \<Longrightarrow> height(node43 l a m b n c r) =
  11.465 -   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.466 -by(induct l a m b n c r rule: node43.induct)(simp_all add: max_def)
  11.467 -
  11.468 -lemma height_node44:
  11.469 -  "height n > 0 \<Longrightarrow> height(node44 l a m b n c r) =
  11.470 -   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.471 -by(induct l a m b n c r rule: node44.induct)(simp_all add: max_def)
  11.472 -
  11.473 -lemmas heights = height_node21 height_node22
  11.474 -  height_node31 height_node32 height_node33
  11.475 -  height_node41 height_node42 height_node43 height_node44
  11.476 -
  11.477 -lemma height_del_min:
  11.478 -  "del_min t = (x, t') \<Longrightarrow> height t > 0 \<Longrightarrow> bal t \<Longrightarrow> height t' = height t"
  11.479 -by(induct t arbitrary: x t' rule: del_min.induct)
  11.480 -  (auto simp: heights split: prod.splits)
  11.481 -
  11.482 -lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  11.483 -by(induction x t rule: del.induct)
  11.484 -  (auto simp add: heights height_del_min split: prod.split)
  11.485 -
  11.486 -lemma bal_del_min:
  11.487 -  "\<lbrakk> del_min t = (x, t'); bal t; height t > 0 \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d t')"
  11.488 -by(induct t arbitrary: x t' rule: del_min.induct)
  11.489 -  (auto simp: heights height_del_min bals split: prod.splits)
  11.490 -
  11.491 -lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
  11.492 -by(induction x t rule: del.induct)
  11.493 -  (auto simp: bals bal_del_min height_del height_del_min split: prod.split)
  11.494 -(* 60 secs (2015) *)
  11.495 -
  11.496 -corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
  11.497 -by(simp add: delete_def bal_tree\<^sub>d_del)
  11.498 -
  11.499 -subsection \<open>Overall Correctness\<close>
  11.500 -
  11.501 -interpretation Set_by_Ordered
  11.502 -where empty = Leaf and isin = isin and insert = insert and delete = delete
  11.503 -and inorder = inorder and inv = bal
  11.504 -proof (standard, goal_cases)
  11.505 -  case 2 thus ?case by(simp add: isin_set)
  11.506 -next
  11.507 -  case 3 thus ?case by(simp add: inorder_insert)
  11.508 -next
  11.509 -  case 4 thus ?case by(simp add: inorder_delete)
  11.510 -next
  11.511 -  case 6 thus ?case by(simp add: bal_insert)
  11.512 -next
  11.513 -  case 7 thus ?case by(simp add: bal_delete)
  11.514 -qed simp+
  11.515 -
  11.516 -end
  11.517 +(* Author: Tobias Nipkow *)
  11.518 +
  11.519 +section \<open>A 2-3-4 Tree Implementation of Sets\<close>
  11.520 +
  11.521 +theory Tree234_Set
  11.522 +imports
  11.523 +  Tree234
  11.524 +  Cmp
  11.525 +  "../Data_Structures/Set_by_Ordered"
  11.526 +begin
  11.527 +
  11.528 +subsection \<open>Set operations on 2-3-4 trees\<close>
  11.529 +
  11.530 +fun isin :: "'a::cmp tree234 \<Rightarrow> 'a \<Rightarrow> bool" where
  11.531 +"isin Leaf x = False" |
  11.532 +"isin (Node2 l a r) x =
  11.533 +  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x)" |
  11.534 +"isin (Node3 l a m b r) x =
  11.535 +  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> (case cmp x b of
  11.536 +   LT \<Rightarrow> isin m x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x))" |
  11.537 +"isin (Node4 t1 a t2 b t3 c t4) x = (case cmp x b of
  11.538 +  LT \<Rightarrow> (case cmp x a of
  11.539 +          LT \<Rightarrow> isin t1 x |
  11.540 +          EQ \<Rightarrow> True |
  11.541 +          GT \<Rightarrow> isin t2 x) |
  11.542 +  EQ \<Rightarrow> True |
  11.543 +  GT \<Rightarrow> (case cmp x c of
  11.544 +          LT \<Rightarrow> isin t3 x |
  11.545 +          EQ \<Rightarrow> True |
  11.546 +          GT \<Rightarrow> isin t4 x))"
  11.547 +
  11.548 +datatype 'a up\<^sub>i = T\<^sub>i "'a tree234" | Up\<^sub>i "'a tree234" 'a "'a tree234"
  11.549 +
  11.550 +fun tree\<^sub>i :: "'a up\<^sub>i \<Rightarrow> 'a tree234" where
  11.551 +"tree\<^sub>i (T\<^sub>i t) = t" |
  11.552 +"tree\<^sub>i (Up\<^sub>i l p r) = Node2 l p r"
  11.553 +
  11.554 +fun ins :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>i" where
  11.555 +"ins x Leaf = Up\<^sub>i Leaf x Leaf" |
  11.556 +"ins x (Node2 l a r) =
  11.557 +   (case cmp x a of
  11.558 +      LT \<Rightarrow> (case ins x l of
  11.559 +              T\<^sub>i l' => T\<^sub>i (Node2 l' a r)
  11.560 +            | Up\<^sub>i l1 b l2 => T\<^sub>i (Node3 l1 b l2 a r)) |
  11.561 +      EQ \<Rightarrow> T\<^sub>i (Node2 l x r) |
  11.562 +      GT \<Rightarrow> (case ins x r of
  11.563 +              T\<^sub>i r' => T\<^sub>i (Node2 l a r')
  11.564 +            | Up\<^sub>i r1 b r2 => T\<^sub>i (Node3 l a r1 b r2)))" |
  11.565 +"ins x (Node3 l a m b r) =
  11.566 +   (case cmp x a of
  11.567 +      LT \<Rightarrow> (case ins x l of
  11.568 +              T\<^sub>i l' => T\<^sub>i (Node3 l' a m b r)
  11.569 +            | Up\<^sub>i l1 c l2 => Up\<^sub>i (Node2 l1 c l2) a (Node2 m b r)) |
  11.570 +      EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
  11.571 +      GT \<Rightarrow> (case cmp x b of
  11.572 +               GT \<Rightarrow> (case ins x r of
  11.573 +                       T\<^sub>i r' => T\<^sub>i (Node3 l a m b r')
  11.574 +                     | Up\<^sub>i r1 c r2 => Up\<^sub>i (Node2 l a m) b (Node2 r1 c r2)) |
  11.575 +               EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
  11.576 +               LT \<Rightarrow> (case ins x m of
  11.577 +                       T\<^sub>i m' => T\<^sub>i (Node3 l a m' b r)
  11.578 +                     | Up\<^sub>i m1 c m2 => Up\<^sub>i (Node2 l a m1) c (Node2 m2 b r))))" |
  11.579 +"ins a (Node4 l x1 m x2 n x3 r) =
  11.580 +   (if a < x2 then
  11.581 +      if a < x1 then
  11.582 +        (case ins a l of
  11.583 +           T\<^sub>i l' => T\<^sub>i (Node4 l' x1 m x2 n x3 r)
  11.584 +         | Up\<^sub>i l1 q l2 => Up\<^sub>i (Node2 l1 q l2) x1 (Node3 m x2 n x3 r))
  11.585 +      else if a=x1 then T\<^sub>i (Node4 l x1 m x2 n x3 r)
  11.586 +      else (case ins a m of
  11.587 +                T\<^sub>i m' => T\<^sub>i (Node4 l x1 m' x2 n x3 r)
  11.588 +              | Up\<^sub>i m1 q m2 => Up\<^sub>i (Node2 l x1 m1) q (Node3 m2 x2 n x3 r))
  11.589 +    else if a=x2 then T\<^sub>i (Node4 l x1 m x2 n x3 r)
  11.590 +    else if a < x3 then
  11.591 +           (case ins a n of
  11.592 +              T\<^sub>i n' => T\<^sub>i (Node4 l x1 m x2 n' x3 r)
  11.593 +            | Up\<^sub>i n1 q n2 => Up\<^sub>i (Node2 l x1 m) x2 (Node3 n1 q n2 x3 r))
  11.594 +         else if a=x3 then T\<^sub>i (Node4 l x1 m x2 n x3 r)
  11.595 +         else (case ins a r of
  11.596 +              T\<^sub>i r' => T\<^sub>i (Node4 l x1 m x2 n x3 r')
  11.597 +            | Up\<^sub>i r1 q r2 => Up\<^sub>i (Node2 l x1 m) x2 (Node3 n x3 r1 q r2))
  11.598 +)"
  11.599 +
  11.600 +hide_const insert
  11.601 +
  11.602 +definition insert :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a tree234" where
  11.603 +"insert x t = tree\<^sub>i(ins x t)"
  11.604 +
  11.605 +datatype 'a up\<^sub>d = T\<^sub>d "'a tree234" | Up\<^sub>d "'a tree234"
  11.606 +
  11.607 +fun tree\<^sub>d :: "'a up\<^sub>d \<Rightarrow> 'a tree234" where
  11.608 +"tree\<^sub>d (T\<^sub>d x) = x" |
  11.609 +"tree\<^sub>d (Up\<^sub>d x) = x"
  11.610 +
  11.611 +fun node21 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.612 +"node21 (T\<^sub>d l) a r = T\<^sub>d(Node2 l a r)" |
  11.613 +"node21 (Up\<^sub>d l) a (Node2 lr b rr) = Up\<^sub>d(Node3 l a lr b rr)" |
  11.614 +"node21 (Up\<^sub>d l) a (Node3 lr b mr c rr) = T\<^sub>d(Node2 (Node2 l a lr) b (Node2 mr c rr))" |
  11.615 +"node21 (Up\<^sub>d t1) a (Node4 t2 b t3 c t4 d t5) = T\<^sub>d(Node2 (Node2 t1 a t2) b (Node3 t3 c t4 d t5))"
  11.616 +
  11.617 +fun node22 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  11.618 +"node22 l a (T\<^sub>d r) = T\<^sub>d(Node2 l a r)" |
  11.619 +"node22 (Node2 ll b rl) a (Up\<^sub>d r) = Up\<^sub>d(Node3 ll b rl a r)" |
  11.620 +"node22 (Node3 ll b ml c rl) a (Up\<^sub>d r) = T\<^sub>d(Node2 (Node2 ll b ml) c (Node2 rl a r))" |
  11.621 +"node22 (Node4 t1 a t2 b t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node2 (Node2 t1 a t2) b (Node3 t3 c t4 d t5))"
  11.622 +
  11.623 +fun node31 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.624 +"node31 (T\<^sub>d t1) a t2 b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
  11.625 +"node31 (Up\<^sub>d t1) a (Node2 t2 b t3) c t4 = T\<^sub>d(Node2 (Node3 t1 a t2 b t3) c t4)" |
  11.626 +"node31 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) d t5 = T\<^sub>d(Node3 (Node2 t1 a t2) b (Node2 t3 c t4) d t5)" |
  11.627 +"node31 (Up\<^sub>d t1) a (Node4 t2 b t3 c t4 d t5) e t6 = T\<^sub>d(Node3 (Node2 t1 a t2) b (Node3 t3 c t4 d t5) e t6)"
  11.628 +
  11.629 +fun node32 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.630 +"node32 t1 a (T\<^sub>d t2) b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
  11.631 +"node32 t1 a (Up\<^sub>d t2) b (Node2 t3 c t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
  11.632 +"node32 t1 a (Up\<^sub>d t2) b (Node3 t3 c t4 d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" |
  11.633 +"node32 t1 a (Up\<^sub>d t2) b (Node4 t3 c t4 d t5 e t6) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node3 t4 d t5 e t6))"
  11.634 +
  11.635 +fun node33 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  11.636 +"node33 l a m b (T\<^sub>d r) = T\<^sub>d(Node3 l a m b r)" |
  11.637 +"node33 t1 a (Node2 t2 b t3) c (Up\<^sub>d t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
  11.638 +"node33 t1 a (Node3 t2 b t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))" |
  11.639 +"node33 t1 a (Node4 t2 b t3 c t4 d t5) e (Up\<^sub>d t6) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node3 t4 d t5 e t6))"
  11.640 +
  11.641 +fun node41 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.642 +"node41 (T\<^sub>d t1) a t2 b t3 c t4 = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.643 +"node41 (Up\<^sub>d t1) a (Node2 t2 b t3) c t4 d t5 = T\<^sub>d(Node3 (Node3 t1 a t2 b t3) c t4 d t5)" |
  11.644 +"node41 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) d t5 e t6 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node2 t3 c t4) d t5 e t6)" |
  11.645 +"node41 (Up\<^sub>d t1) a (Node4 t2 b t3 c t4 d t5) e t6 f t7 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node3 t3 c t4 d t5) e t6 f t7)"
  11.646 +
  11.647 +fun node42 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.648 +"node42 t1 a (T\<^sub>d t2) b t3 c t4 = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.649 +"node42 (Node2 t1 a t2) b (Up\<^sub>d t3) c t4 d t5 = T\<^sub>d(Node3 (Node3 t1 a t2 b t3) c t4 d t5)" |
  11.650 +"node42 (Node3 t1 a t2 b t3) c (Up\<^sub>d t4) d t5 e t6 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node2 t3 c t4) d t5 e t6)" |
  11.651 +"node42 (Node4 t1 a t2 b t3 c t4) d (Up\<^sub>d t5) e t6 f t7 = T\<^sub>d(Node4 (Node2 t1 a t2) b (Node3 t3 c t4 d t5) e t6 f t7)"
  11.652 +
  11.653 +fun node43 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.654 +"node43 t1 a t2 b (T\<^sub>d t3) c t4 = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.655 +"node43 t1 a (Node2 t2 b t3) c (Up\<^sub>d t4) d t5 = T\<^sub>d(Node3 t1 a (Node3 t2 b t3 c t4) d t5)" |
  11.656 +"node43 t1 a (Node3 t2 b t3 c t4) d (Up\<^sub>d t5) e t6 = T\<^sub>d(Node4 t1 a (Node2 t2 b t3) c (Node2 t4 d t5) e t6)" |
  11.657 +"node43 t1 a (Node4 t2 b t3 c t4 d t5) e (Up\<^sub>d t6) f t7 = T\<^sub>d(Node4 t1 a (Node2 t2 b t3) c (Node3 t4 d t5 e t6) f t7)"
  11.658 +
  11.659 +fun node44 :: "'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a tree234 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  11.660 +"node44 t1 a t2 b t3 c (T\<^sub>d t4) = T\<^sub>d(Node4 t1 a t2 b t3 c t4)" |
  11.661 +"node44 t1 a t2 b (Node2 t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node3 t1 a t2 b (Node3 t3 c t4 d t5))" |
  11.662 +"node44 t1 a t2 b (Node3 t3 c t4 d t5) e (Up\<^sub>d t6) = T\<^sub>d(Node4 t1 a t2 b (Node2 t3 c t4) d (Node2 t5 e t6))" |
  11.663 +"node44 t1 a t2 b (Node4 t3 c t4 d t5 e t6) f (Up\<^sub>d t7) = T\<^sub>d(Node4 t1 a t2 b (Node2 t3 c t4) d (Node3 t5 e t6 f t7))"
  11.664 +
  11.665 +fun del_min :: "'a tree234 \<Rightarrow> 'a * 'a up\<^sub>d" where
  11.666 +"del_min (Node2 Leaf a Leaf) = (a, Up\<^sub>d Leaf)" |
  11.667 +"del_min (Node3 Leaf a Leaf b Leaf) = (a, T\<^sub>d(Node2 Leaf b Leaf))" |
  11.668 +"del_min (Node4 Leaf a Leaf b Leaf c Leaf) = (a, T\<^sub>d(Node3 Leaf b Leaf c Leaf))" |
  11.669 +"del_min (Node2 l a r) = (let (x,l') = del_min l in (x, node21 l' a r))" |
  11.670 +"del_min (Node3 l a m b r) = (let (x,l') = del_min l in (x, node31 l' a m b r))" |
  11.671 +"del_min (Node4 l a m b n c r) = (let (x,l') = del_min l in (x, node41 l' a m b n c r))"
  11.672 +
  11.673 +fun del :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a up\<^sub>d" where
  11.674 +"del k Leaf = T\<^sub>d Leaf" |
  11.675 +"del k (Node2 Leaf p Leaf) = (if k=p then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf p Leaf))" |
  11.676 +"del k (Node3 Leaf p Leaf q Leaf) = T\<^sub>d(if k=p then Node2 Leaf q Leaf
  11.677 +  else if k=q then Node2 Leaf p Leaf else Node3 Leaf p Leaf q Leaf)" |
  11.678 +"del k (Node4 Leaf a Leaf b Leaf c Leaf) =
  11.679 +  T\<^sub>d(if k=a then Node3 Leaf b Leaf c Leaf else
  11.680 +     if k=b then Node3 Leaf a Leaf c Leaf else
  11.681 +     if k=c then Node3 Leaf a Leaf b Leaf
  11.682 +     else Node4 Leaf a Leaf b Leaf c Leaf)" |
  11.683 +"del k (Node2 l a r) = (case cmp k a of
  11.684 +  LT \<Rightarrow> node21 (del k l) a r |
  11.685 +  GT \<Rightarrow> node22 l a (del k r) |
  11.686 +  EQ \<Rightarrow> let (a',t) = del_min r in node22 l a' t)" |
  11.687 +"del k (Node3 l a m b r) = (case cmp k a of
  11.688 +  LT \<Rightarrow> node31 (del k l) a m b r |
  11.689 +  EQ \<Rightarrow> let (a',m') = del_min m in node32 l a' m' b r |
  11.690 +  GT \<Rightarrow> (case cmp k b of
  11.691 +           LT \<Rightarrow> node32 l a (del k m) b r |
  11.692 +           EQ \<Rightarrow> let (b',r') = del_min r in node33 l a m b' r' |
  11.693 +           GT \<Rightarrow> node33 l a m b (del k r)))" |
  11.694 +"del k (Node4 l a m b n c r) = (case cmp k b of
  11.695 +  LT \<Rightarrow> (case cmp k a of
  11.696 +          LT \<Rightarrow> node41 (del k l) a m b n c r |
  11.697 +          EQ \<Rightarrow> let (a',m') = del_min m in node42 l a' m' b n c r |
  11.698 +          GT \<Rightarrow> node42 l a (del k m) b n c r) |
  11.699 +  EQ \<Rightarrow> let (b',n') = del_min n in node43 l a m b' n' c r |
  11.700 +  GT \<Rightarrow> (case cmp k c of
  11.701 +           LT \<Rightarrow> node43 l a m b (del k n) c r |
  11.702 +           EQ \<Rightarrow> let (c',r') = del_min r in node44 l a m b n c' r' |
  11.703 +           GT \<Rightarrow> node44 l a m b n c (del k r)))"
  11.704 +
  11.705 +definition delete :: "'a::cmp \<Rightarrow> 'a tree234 \<Rightarrow> 'a tree234" where
  11.706 +"delete x t = tree\<^sub>d(del x t)"
  11.707 +
  11.708 +
  11.709 +subsection "Functional correctness"
  11.710 +
  11.711 +subsubsection \<open>Functional correctness of isin:\<close>
  11.712 +
  11.713 +lemma "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  11.714 +by (induction t) (auto simp: elems_simps1 ball_Un)
  11.715 +
  11.716 +lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  11.717 +by (induction t) (auto simp: elems_simps2)
  11.718 +
  11.719 +
  11.720 +subsubsection \<open>Functional correctness of insert:\<close>
  11.721 +
  11.722 +lemma inorder_ins:
  11.723 +  "sorted(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(ins x t)) = ins_list x (inorder t)"
  11.724 +by(induction t) (auto, auto simp: ins_list_simps split: up\<^sub>i.splits)
  11.725 +
  11.726 +lemma inorder_insert:
  11.727 +  "sorted(inorder t) \<Longrightarrow> inorder(insert a t) = ins_list a (inorder t)"
  11.728 +by(simp add: insert_def inorder_ins)
  11.729 +
  11.730 +
  11.731 +subsubsection \<open>Functional correctness of delete\<close>
  11.732 +
  11.733 +lemma inorder_node21: "height r > 0 \<Longrightarrow>
  11.734 +  inorder (tree\<^sub>d (node21 l' a r)) = inorder (tree\<^sub>d l') @ a # inorder r"
  11.735 +by(induct l' a r rule: node21.induct) auto
  11.736 +
  11.737 +lemma inorder_node22: "height l > 0 \<Longrightarrow>
  11.738 +  inorder (tree\<^sub>d (node22 l a r')) = inorder l @ a # inorder (tree\<^sub>d r')"
  11.739 +by(induct l a r' rule: node22.induct) auto
  11.740 +
  11.741 +lemma inorder_node31: "height m > 0 \<Longrightarrow>
  11.742 +  inorder (tree\<^sub>d (node31 l' a m b r)) = inorder (tree\<^sub>d l') @ a # inorder m @ b # inorder r"
  11.743 +by(induct l' a m b r rule: node31.induct) auto
  11.744 +
  11.745 +lemma inorder_node32: "height r > 0 \<Longrightarrow>
  11.746 +  inorder (tree\<^sub>d (node32 l a m' b r)) = inorder l @ a # inorder (tree\<^sub>d m') @ b # inorder r"
  11.747 +by(induct l a m' b r rule: node32.induct) auto
  11.748 +
  11.749 +lemma inorder_node33: "height m > 0 \<Longrightarrow>
  11.750 +  inorder (tree\<^sub>d (node33 l a m b r')) = inorder l @ a # inorder m @ b # inorder (tree\<^sub>d r')"
  11.751 +by(induct l a m b r' rule: node33.induct) auto
  11.752 +
  11.753 +lemma inorder_node41: "height m > 0 \<Longrightarrow>
  11.754 +  inorder (tree\<^sub>d (node41 l' a m b n c r)) = inorder (tree\<^sub>d l') @ a # inorder m @ b # inorder n @ c # inorder r"
  11.755 +by(induct l' a m b n c r rule: node41.induct) auto
  11.756 +
  11.757 +lemma inorder_node42: "height l > 0 \<Longrightarrow>
  11.758 +  inorder (tree\<^sub>d (node42 l a m b n c r)) = inorder l @ a # inorder (tree\<^sub>d m) @ b # inorder n @ c # inorder r"
  11.759 +by(induct l a m b n c r rule: node42.induct) auto
  11.760 +
  11.761 +lemma inorder_node43: "height m > 0 \<Longrightarrow>
  11.762 +  inorder (tree\<^sub>d (node43 l a m b n c r)) = inorder l @ a # inorder m @ b # inorder(tree\<^sub>d n) @ c # inorder r"
  11.763 +by(induct l a m b n c r rule: node43.induct) auto
  11.764 +
  11.765 +lemma inorder_node44: "height n > 0 \<Longrightarrow>
  11.766 +  inorder (tree\<^sub>d (node44 l a m b n c r)) = inorder l @ a # inorder m @ b # inorder n @ c # inorder (tree\<^sub>d r)"
  11.767 +by(induct l a m b n c r rule: node44.induct) auto
  11.768 +
  11.769 +lemmas inorder_nodes = inorder_node21 inorder_node22
  11.770 +  inorder_node31 inorder_node32 inorder_node33
  11.771 +  inorder_node41 inorder_node42 inorder_node43 inorder_node44
  11.772 +
  11.773 +lemma del_minD:
  11.774 +  "del_min t = (x,t') \<Longrightarrow> bal t \<Longrightarrow> height t > 0 \<Longrightarrow>
  11.775 +  x # inorder(tree\<^sub>d t') = inorder t"
  11.776 +by(induction t arbitrary: t' rule: del_min.induct)
  11.777 +  (auto simp: inorder_nodes split: prod.splits)
  11.778 +
  11.779 +lemma inorder_del: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  11.780 +  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
  11.781 +by(induction t rule: del.induct)
  11.782 +  (auto simp: inorder_nodes del_list_simps del_minD split: prod.splits)
  11.783 +  (* 150 secs (2015) *)
  11.784 +
  11.785 +lemma inorder_delete: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  11.786 +  inorder(delete x t) = del_list x (inorder t)"
  11.787 +by(simp add: delete_def inorder_del)
  11.788 +
  11.789 +
  11.790 +subsection \<open>Balancedness\<close>
  11.791 +
  11.792 +subsubsection "Proofs for insert"
  11.793 +
  11.794 +text{* First a standard proof that @{const ins} preserves @{const bal}. *}
  11.795 +
  11.796 +instantiation up\<^sub>i :: (type)height
  11.797 +begin
  11.798 +
  11.799 +fun height_up\<^sub>i :: "'a up\<^sub>i \<Rightarrow> nat" where
  11.800 +"height (T\<^sub>i t) = height t" |
  11.801 +"height (Up\<^sub>i l a r) = height l"
  11.802 +
  11.803 +instance ..
  11.804 +
  11.805 +end
  11.806 +
  11.807 +lemma bal_ins: "bal t \<Longrightarrow> bal (tree\<^sub>i(ins a t)) \<and> height(ins a t) = height t"
  11.808 +by (induct t) (auto, auto split: up\<^sub>i.split) (* 20 secs (2015) *)
  11.809 +
  11.810 +
  11.811 +text{* Now an alternative proof (by Brian Huffman) that runs faster because
  11.812 +two properties (balance and height) are combined in one predicate. *}
  11.813 +
  11.814 +inductive full :: "nat \<Rightarrow> 'a tree234 \<Rightarrow> bool" where
  11.815 +"full 0 Leaf" |
  11.816 +"\<lbrakk>full n l; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node2 l p r)" |
  11.817 +"\<lbrakk>full n l; full n m; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node3 l p m q r)" |
  11.818 +"\<lbrakk>full n l; full n m; full n m'; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node4 l p m q m' q' r)"
  11.819 +
  11.820 +inductive_cases full_elims:
  11.821 +  "full n Leaf"
  11.822 +  "full n (Node2 l p r)"
  11.823 +  "full n (Node3 l p m q r)"
  11.824 +  "full n (Node4 l p m q m' q' r)"
  11.825 +
  11.826 +inductive_cases full_0_elim: "full 0 t"
  11.827 +inductive_cases full_Suc_elim: "full (Suc n) t"
  11.828 +
  11.829 +lemma full_0_iff [simp]: "full 0 t \<longleftrightarrow> t = Leaf"
  11.830 +  by (auto elim: full_0_elim intro: full.intros)
  11.831 +
  11.832 +lemma full_Leaf_iff [simp]: "full n Leaf \<longleftrightarrow> n = 0"
  11.833 +  by (auto elim: full_elims intro: full.intros)
  11.834 +
  11.835 +lemma full_Suc_Node2_iff [simp]:
  11.836 +  "full (Suc n) (Node2 l p r) \<longleftrightarrow> full n l \<and> full n r"
  11.837 +  by (auto elim: full_elims intro: full.intros)
  11.838 +
  11.839 +lemma full_Suc_Node3_iff [simp]:
  11.840 +  "full (Suc n) (Node3 l p m q r) \<longleftrightarrow> full n l \<and> full n m \<and> full n r"
  11.841 +  by (auto elim: full_elims intro: full.intros)
  11.842 +
  11.843 +lemma full_Suc_Node4_iff [simp]:
  11.844 +  "full (Suc n) (Node4 l p m q m' q' r) \<longleftrightarrow> full n l \<and> full n m \<and> full n m' \<and> full n r"
  11.845 +  by (auto elim: full_elims intro: full.intros)
  11.846 +
  11.847 +lemma full_imp_height: "full n t \<Longrightarrow> height t = n"
  11.848 +  by (induct set: full, simp_all)
  11.849 +
  11.850 +lemma full_imp_bal: "full n t \<Longrightarrow> bal t"
  11.851 +  by (induct set: full, auto dest: full_imp_height)
  11.852 +
  11.853 +lemma bal_imp_full: "bal t \<Longrightarrow> full (height t) t"
  11.854 +  by (induct t, simp_all)
  11.855 +
  11.856 +lemma bal_iff_full: "bal t \<longleftrightarrow> (\<exists>n. full n t)"
  11.857 +  by (auto elim!: bal_imp_full full_imp_bal)
  11.858 +
  11.859 +text {* The @{const "insert"} function either preserves the height of the
  11.860 +tree, or increases it by one. The constructor returned by the @{term
  11.861 +"insert"} function determines which: A return value of the form @{term
  11.862 +"T\<^sub>i t"} indicates that the height will be the same. A value of the
  11.863 +form @{term "Up\<^sub>i l p r"} indicates an increase in height. *}
  11.864 +
  11.865 +primrec full\<^sub>i :: "nat \<Rightarrow> 'a up\<^sub>i \<Rightarrow> bool" where
  11.866 +"full\<^sub>i n (T\<^sub>i t) \<longleftrightarrow> full n t" |
  11.867 +"full\<^sub>i n (Up\<^sub>i l p r) \<longleftrightarrow> full n l \<and> full n r"
  11.868 +
  11.869 +lemma full\<^sub>i_ins: "full n t \<Longrightarrow> full\<^sub>i n (ins a t)"
  11.870 +by (induct rule: full.induct) (auto, auto split: up\<^sub>i.split)
  11.871 +
  11.872 +text {* The @{const insert} operation preserves balance. *}
  11.873 +
  11.874 +lemma bal_insert: "bal t \<Longrightarrow> bal (insert a t)"
  11.875 +unfolding bal_iff_full insert_def
  11.876 +apply (erule exE)
  11.877 +apply (drule full\<^sub>i_ins [of _ _ a])
  11.878 +apply (cases "ins a t")
  11.879 +apply (auto intro: full.intros)
  11.880 +done
  11.881 +
  11.882 +
  11.883 +subsubsection "Proofs for delete"
  11.884 +
  11.885 +instantiation up\<^sub>d :: (type)height
  11.886 +begin
  11.887 +
  11.888 +fun height_up\<^sub>d :: "'a up\<^sub>d \<Rightarrow> nat" where
  11.889 +"height (T\<^sub>d t) = height t" |
  11.890 +"height (Up\<^sub>d t) = height t + 1"
  11.891 +
  11.892 +instance ..
  11.893 +
  11.894 +end
  11.895 +
  11.896 +lemma bal_tree\<^sub>d_node21:
  11.897 +  "\<lbrakk>bal r; bal (tree\<^sub>d l); height r = height l \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node21 l a r))"
  11.898 +by(induct l a r rule: node21.induct) auto
  11.899 +
  11.900 +lemma bal_tree\<^sub>d_node22:
  11.901 +  "\<lbrakk>bal(tree\<^sub>d r); bal l; height r = height l \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node22 l a r))"
  11.902 +by(induct l a r rule: node22.induct) auto
  11.903 +
  11.904 +lemma bal_tree\<^sub>d_node31:
  11.905 +  "\<lbrakk> bal (tree\<^sub>d l); bal m; bal r; height l = height r; height m = height r \<rbrakk>
  11.906 +  \<Longrightarrow> bal (tree\<^sub>d (node31 l a m b r))"
  11.907 +by(induct l a m b r rule: node31.induct) auto
  11.908 +
  11.909 +lemma bal_tree\<^sub>d_node32:
  11.910 +  "\<lbrakk> bal l; bal (tree\<^sub>d m); bal r; height l = height r; height m = height r \<rbrakk>
  11.911 +  \<Longrightarrow> bal (tree\<^sub>d (node32 l a m b r))"
  11.912 +by(induct l a m b r rule: node32.induct) auto
  11.913 +
  11.914 +lemma bal_tree\<^sub>d_node33:
  11.915 +  "\<lbrakk> bal l; bal m; bal(tree\<^sub>d r); height l = height r; height m = height r \<rbrakk>
  11.916 +  \<Longrightarrow> bal (tree\<^sub>d (node33 l a m b r))"
  11.917 +by(induct l a m b r rule: node33.induct) auto
  11.918 +
  11.919 +lemma bal_tree\<^sub>d_node41:
  11.920 +  "\<lbrakk> bal (tree\<^sub>d l); bal m; bal n; bal r; height l = height r; height m = height r; height n = height r \<rbrakk>
  11.921 +  \<Longrightarrow> bal (tree\<^sub>d (node41 l a m b n c r))"
  11.922 +by(induct l a m b n c r rule: node41.induct) auto
  11.923 +
  11.924 +lemma bal_tree\<^sub>d_node42:
  11.925 +  "\<lbrakk> bal l; bal (tree\<^sub>d m); bal n; bal r; height l = height r; height m = height r; height n = height r \<rbrakk>
  11.926 +  \<Longrightarrow> bal (tree\<^sub>d (node42 l a m b n c r))"
  11.927 +by(induct l a m b n c r rule: node42.induct) auto
  11.928 +
  11.929 +lemma bal_tree\<^sub>d_node43:
  11.930 +  "\<lbrakk> bal l; bal m; bal (tree\<^sub>d n); bal r; height l = height r; height m = height r; height n = height r \<rbrakk>
  11.931 +  \<Longrightarrow> bal (tree\<^sub>d (node43 l a m b n c r))"
  11.932 +by(induct l a m b n c r rule: node43.induct) auto
  11.933 +
  11.934 +lemma bal_tree\<^sub>d_node44:
  11.935 +  "\<lbrakk> bal l; bal m; bal n; bal (tree\<^sub>d r); height l = height r; height m = height r; height n = height r \<rbrakk>
  11.936 +  \<Longrightarrow> bal (tree\<^sub>d (node44 l a m b n c r))"
  11.937 +by(induct l a m b n c r rule: node44.induct) auto
  11.938 +
  11.939 +lemmas bals = bal_tree\<^sub>d_node21 bal_tree\<^sub>d_node22
  11.940 +  bal_tree\<^sub>d_node31 bal_tree\<^sub>d_node32 bal_tree\<^sub>d_node33
  11.941 +  bal_tree\<^sub>d_node41 bal_tree\<^sub>d_node42 bal_tree\<^sub>d_node43 bal_tree\<^sub>d_node44
  11.942 +
  11.943 +lemma height_node21:
  11.944 +   "height r > 0 \<Longrightarrow> height(node21 l a r) = max (height l) (height r) + 1"
  11.945 +by(induct l a r rule: node21.induct)(simp_all add: max.assoc)
  11.946 +
  11.947 +lemma height_node22:
  11.948 +   "height l > 0 \<Longrightarrow> height(node22 l a r) = max (height l) (height r) + 1"
  11.949 +by(induct l a r rule: node22.induct)(simp_all add: max.assoc)
  11.950 +
  11.951 +lemma height_node31:
  11.952 +  "height m > 0 \<Longrightarrow> height(node31 l a m b r) =
  11.953 +   max (height l) (max (height m) (height r)) + 1"
  11.954 +by(induct l a m b r rule: node31.induct)(simp_all add: max_def)
  11.955 +
  11.956 +lemma height_node32:
  11.957 +  "height r > 0 \<Longrightarrow> height(node32 l a m b r) =
  11.958 +   max (height l) (max (height m) (height r)) + 1"
  11.959 +by(induct l a m b r rule: node32.induct)(simp_all add: max_def)
  11.960 +
  11.961 +lemma height_node33:
  11.962 +  "height m > 0 \<Longrightarrow> height(node33 l a m b r) =
  11.963 +   max (height l) (max (height m) (height r)) + 1"
  11.964 +by(induct l a m b r rule: node33.induct)(simp_all add: max_def)
  11.965 +
  11.966 +lemma height_node41:
  11.967 +  "height m > 0 \<Longrightarrow> height(node41 l a m b n c r) =
  11.968 +   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.969 +by(induct l a m b n c r rule: node41.induct)(simp_all add: max_def)
  11.970 +
  11.971 +lemma height_node42:
  11.972 +  "height l > 0 \<Longrightarrow> height(node42 l a m b n c r) =
  11.973 +   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.974 +by(induct l a m b n c r rule: node42.induct)(simp_all add: max_def)
  11.975 +
  11.976 +lemma height_node43:
  11.977 +  "height m > 0 \<Longrightarrow> height(node43 l a m b n c r) =
  11.978 +   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.979 +by(induct l a m b n c r rule: node43.induct)(simp_all add: max_def)
  11.980 +
  11.981 +lemma height_node44:
  11.982 +  "height n > 0 \<Longrightarrow> height(node44 l a m b n c r) =
  11.983 +   max (height l) (max (height m) (max (height n) (height r))) + 1"
  11.984 +by(induct l a m b n c r rule: node44.induct)(simp_all add: max_def)
  11.985 +
  11.986 +lemmas heights = height_node21 height_node22
  11.987 +  height_node31 height_node32 height_node33
  11.988 +  height_node41 height_node42 height_node43 height_node44
  11.989 +
  11.990 +lemma height_del_min:
  11.991 +  "del_min t = (x, t') \<Longrightarrow> height t > 0 \<Longrightarrow> bal t \<Longrightarrow> height t' = height t"
  11.992 +by(induct t arbitrary: x t' rule: del_min.induct)
  11.993 +  (auto simp: heights split: prod.splits)
  11.994 +
  11.995 +lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  11.996 +by(induction x t rule: del.induct)
  11.997 +  (auto simp add: heights height_del_min split: prod.split)
  11.998 +
  11.999 +lemma bal_del_min:
 11.1000 +  "\<lbrakk> del_min t = (x, t'); bal t; height t > 0 \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d t')"
 11.1001 +by(induct t arbitrary: x t' rule: del_min.induct)
 11.1002 +  (auto simp: heights height_del_min bals split: prod.splits)
 11.1003 +
 11.1004 +lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
 11.1005 +by(induction x t rule: del.induct)
 11.1006 +  (auto simp: bals bal_del_min height_del height_del_min split: prod.split)
 11.1007 +(* 60 secs (2015) *)
 11.1008 +
 11.1009 +corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
 11.1010 +by(simp add: delete_def bal_tree\<^sub>d_del)
 11.1011 +
 11.1012 +subsection \<open>Overall Correctness\<close>
 11.1013 +
 11.1014 +interpretation Set_by_Ordered
 11.1015 +where empty = Leaf and isin = isin and insert = insert and delete = delete
 11.1016 +and inorder = inorder and inv = bal
 11.1017 +proof (standard, goal_cases)
 11.1018 +  case 2 thus ?case by(simp add: isin_set)
 11.1019 +next
 11.1020 +  case 3 thus ?case by(simp add: inorder_insert)
 11.1021 +next
 11.1022 +  case 4 thus ?case by(simp add: inorder_delete)
 11.1023 +next
 11.1024 +  case 6 thus ?case by(simp add: bal_insert)
 11.1025 +next
 11.1026 +  case 7 thus ?case by(simp add: bal_delete)
 11.1027 +qed simp+
 11.1028 +
 11.1029 +end
    12.1 --- a/src/HOL/Data_Structures/Tree23_Map.thy	Wed Nov 11 16:42:30 2015 +0100
    12.2 +++ b/src/HOL/Data_Structures/Tree23_Map.thy	Wed Nov 11 18:32:26 2015 +0100
    12.3 @@ -1,136 +1,136 @@
    12.4 -(* Author: Tobias Nipkow *)
    12.5 -
    12.6 -section \<open>A 2-3 Tree Implementation of Maps\<close>
    12.7 -
    12.8 -theory Tree23_Map
    12.9 -imports
   12.10 -  Tree23_Set
   12.11 -  Map_by_Ordered
   12.12 -begin
   12.13 -
   12.14 -fun lookup :: "('a::cmp * 'b) tree23 \<Rightarrow> 'a \<Rightarrow> 'b option" where
   12.15 -"lookup Leaf x = None" |
   12.16 -"lookup (Node2 l (a,b) r) x = (case cmp x a of
   12.17 -  LT \<Rightarrow> lookup l x |
   12.18 -  GT \<Rightarrow> lookup r x |
   12.19 -  EQ \<Rightarrow> Some b)" |
   12.20 -"lookup (Node3 l (a1,b1) m (a2,b2) r) x = (case cmp x a1 of
   12.21 -  LT \<Rightarrow> lookup l x |
   12.22 -  EQ \<Rightarrow> Some b1 |
   12.23 -  GT \<Rightarrow> (case cmp x a2 of
   12.24 -          LT \<Rightarrow> lookup m x |
   12.25 -          EQ \<Rightarrow> Some b2 |
   12.26 -          GT \<Rightarrow> lookup r x))"
   12.27 -
   12.28 -fun upd :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>i" where
   12.29 -"upd x y Leaf = Up\<^sub>i Leaf (x,y) Leaf" |
   12.30 -"upd x y (Node2 l ab r) = (case cmp x (fst ab) of
   12.31 -   LT \<Rightarrow> (case upd x y l of
   12.32 -           T\<^sub>i l' => T\<^sub>i (Node2 l' ab r)
   12.33 -         | Up\<^sub>i l1 ab' l2 => T\<^sub>i (Node3 l1 ab' l2 ab r)) |
   12.34 -   EQ \<Rightarrow> T\<^sub>i (Node2 l (x,y) r) |
   12.35 -   GT \<Rightarrow> (case upd x y r of
   12.36 -           T\<^sub>i r' => T\<^sub>i (Node2 l ab r')
   12.37 -         | Up\<^sub>i r1 ab' r2 => T\<^sub>i (Node3 l ab r1 ab' r2)))" |
   12.38 -"upd x y (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
   12.39 -   LT \<Rightarrow> (case upd x y l of
   12.40 -           T\<^sub>i l' => T\<^sub>i (Node3 l' ab1 m ab2 r)
   12.41 -         | Up\<^sub>i l1 ab' l2 => Up\<^sub>i (Node2 l1 ab' l2) ab1 (Node2 m ab2 r)) |
   12.42 -   EQ \<Rightarrow> T\<^sub>i (Node3 l (x,y) m ab2 r) |
   12.43 -   GT \<Rightarrow> (case cmp x (fst ab2) of
   12.44 -           LT \<Rightarrow> (case upd x y m of
   12.45 -                   T\<^sub>i m' => T\<^sub>i (Node3 l ab1 m' ab2 r)
   12.46 -                 | Up\<^sub>i m1 ab' m2 => Up\<^sub>i (Node2 l ab1 m1) ab' (Node2 m2 ab2 r)) |
   12.47 -           EQ \<Rightarrow> T\<^sub>i (Node3 l ab1 m (x,y) r) |
   12.48 -           GT \<Rightarrow> (case upd x y r of
   12.49 -                   T\<^sub>i r' => T\<^sub>i (Node3 l ab1 m ab2 r')
   12.50 -                 | Up\<^sub>i r1 ab' r2 => Up\<^sub>i (Node2 l ab1 m) ab2 (Node2 r1 ab' r2))))"
   12.51 -
   12.52 -definition update :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
   12.53 -"update a b t = tree\<^sub>i(upd a b t)"
   12.54 -
   12.55 -fun del :: "'a::cmp \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>d" where
   12.56 -"del x Leaf = T\<^sub>d Leaf" |
   12.57 -"del x (Node2 Leaf ab1 Leaf) = (if x=fst ab1 then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf ab1 Leaf))" |
   12.58 -"del x (Node3 Leaf ab1 Leaf ab2 Leaf) = T\<^sub>d(if x=fst ab1 then Node2 Leaf ab2 Leaf
   12.59 -  else if x=fst ab2 then Node2 Leaf ab1 Leaf else Node3 Leaf ab1 Leaf ab2 Leaf)" |
   12.60 -"del x (Node2 l ab1 r) = (case cmp x (fst ab1) of
   12.61 -  LT \<Rightarrow> node21 (del x l) ab1 r |
   12.62 -  GT \<Rightarrow> node22 l ab1 (del x r) |
   12.63 -  EQ \<Rightarrow> let (ab1',t) = del_min r in node22 l ab1' t)" |
   12.64 -"del x (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
   12.65 -  LT \<Rightarrow> node31 (del x l) ab1 m ab2 r |
   12.66 -  EQ \<Rightarrow> let (ab1',m') = del_min m in node32 l ab1' m' ab2 r |
   12.67 -  GT \<Rightarrow> (case cmp x (fst ab2) of
   12.68 -           LT \<Rightarrow> node32 l ab1 (del x m) ab2 r |
   12.69 -           EQ \<Rightarrow> let (ab2',r') = del_min r in node33 l ab1 m ab2' r' |
   12.70 -           GT \<Rightarrow> node33 l ab1 m ab2 (del x r)))"
   12.71 -
   12.72 -definition delete :: "'a::cmp \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
   12.73 -"delete x t = tree\<^sub>d(del x t)"
   12.74 -
   12.75 -
   12.76 -subsection \<open>Functional Correctness\<close>
   12.77 -
   12.78 -lemma lookup: "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
   12.79 -by (induction t) (auto simp: map_of_simps split: option.split)
   12.80 -
   12.81 -
   12.82 -lemma inorder_upd:
   12.83 -  "sorted1(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(upd a b t)) = upd_list a b (inorder t)"
   12.84 -by(induction t) (auto simp: upd_list_simps split: up\<^sub>i.splits)
   12.85 -
   12.86 -corollary inorder_update:
   12.87 -  "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
   12.88 -by(simp add: update_def inorder_upd)
   12.89 -
   12.90 -
   12.91 -lemma inorder_del: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
   12.92 -  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
   12.93 -by(induction t rule: del.induct)
   12.94 -  (auto simp: del_list_simps inorder_nodes del_minD split: prod.splits)
   12.95 -
   12.96 -corollary inorder_delete: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
   12.97 -  inorder(delete x t) = del_list x (inorder t)"
   12.98 -by(simp add: delete_def inorder_del)
   12.99 -
  12.100 -
  12.101 -subsection \<open>Balancedness\<close>
  12.102 -
  12.103 -lemma bal_upd: "bal t \<Longrightarrow> bal (tree\<^sub>i(upd a b t)) \<and> height(upd a b t) = height t"
  12.104 -by (induct t) (auto split: up\<^sub>i.split)(* 16 secs in 2015 *)
  12.105 -
  12.106 -corollary bal_update: "bal t \<Longrightarrow> bal (update a b t)"
  12.107 -by (simp add: update_def bal_upd)
  12.108 -
  12.109 -
  12.110 -lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  12.111 -by(induction x t rule: del.induct)
  12.112 -  (auto simp add: heights max_def height_del_min split: prod.split)
  12.113 -
  12.114 -lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
  12.115 -by(induction x t rule: del.induct)
  12.116 -  (auto simp: bals bal_del_min height_del height_del_min split: prod.split)
  12.117 -
  12.118 -corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
  12.119 -by(simp add: delete_def bal_tree\<^sub>d_del)
  12.120 -
  12.121 -
  12.122 -subsection \<open>Overall Correctness\<close>
  12.123 -
  12.124 -interpretation T23_Map: Map_by_Ordered
  12.125 -where empty = Leaf and lookup = lookup and update = update and delete = delete
  12.126 -and inorder = inorder and wf = bal
  12.127 -proof (standard, goal_cases)
  12.128 -  case 2 thus ?case by(simp add: lookup)
  12.129 -next
  12.130 -  case 3 thus ?case by(simp add: inorder_update)
  12.131 -next
  12.132 -  case 4 thus ?case by(simp add: inorder_delete)
  12.133 -next
  12.134 -  case 6 thus ?case by(simp add: bal_update)
  12.135 -next
  12.136 -  case 7 thus ?case by(simp add: bal_delete)
  12.137 -qed simp+
  12.138 -
  12.139 -end
  12.140 +(* Author: Tobias Nipkow *)
  12.141 +
  12.142 +section \<open>A 2-3 Tree Implementation of Maps\<close>
  12.143 +
  12.144 +theory Tree23_Map
  12.145 +imports
  12.146 +  Tree23_Set
  12.147 +  Map_by_Ordered
  12.148 +begin
  12.149 +
  12.150 +fun lookup :: "('a::cmp * 'b) tree23 \<Rightarrow> 'a \<Rightarrow> 'b option" where
  12.151 +"lookup Leaf x = None" |
  12.152 +"lookup (Node2 l (a,b) r) x = (case cmp x a of
  12.153 +  LT \<Rightarrow> lookup l x |
  12.154 +  GT \<Rightarrow> lookup r x |
  12.155 +  EQ \<Rightarrow> Some b)" |
  12.156 +"lookup (Node3 l (a1,b1) m (a2,b2) r) x = (case cmp x a1 of
  12.157 +  LT \<Rightarrow> lookup l x |
  12.158 +  EQ \<Rightarrow> Some b1 |
  12.159 +  GT \<Rightarrow> (case cmp x a2 of
  12.160 +          LT \<Rightarrow> lookup m x |
  12.161 +          EQ \<Rightarrow> Some b2 |
  12.162 +          GT \<Rightarrow> lookup r x))"
  12.163 +
  12.164 +fun upd :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>i" where
  12.165 +"upd x y Leaf = Up\<^sub>i Leaf (x,y) Leaf" |
  12.166 +"upd x y (Node2 l ab r) = (case cmp x (fst ab) of
  12.167 +   LT \<Rightarrow> (case upd x y l of
  12.168 +           T\<^sub>i l' => T\<^sub>i (Node2 l' ab r)
  12.169 +         | Up\<^sub>i l1 ab' l2 => T\<^sub>i (Node3 l1 ab' l2 ab r)) |
  12.170 +   EQ \<Rightarrow> T\<^sub>i (Node2 l (x,y) r) |
  12.171 +   GT \<Rightarrow> (case upd x y r of
  12.172 +           T\<^sub>i r' => T\<^sub>i (Node2 l ab r')
  12.173 +         | Up\<^sub>i r1 ab' r2 => T\<^sub>i (Node3 l ab r1 ab' r2)))" |
  12.174 +"upd x y (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
  12.175 +   LT \<Rightarrow> (case upd x y l of
  12.176 +           T\<^sub>i l' => T\<^sub>i (Node3 l' ab1 m ab2 r)
  12.177 +         | Up\<^sub>i l1 ab' l2 => Up\<^sub>i (Node2 l1 ab' l2) ab1 (Node2 m ab2 r)) |
  12.178 +   EQ \<Rightarrow> T\<^sub>i (Node3 l (x,y) m ab2 r) |
  12.179 +   GT \<Rightarrow> (case cmp x (fst ab2) of
  12.180 +           LT \<Rightarrow> (case upd x y m of
  12.181 +                   T\<^sub>i m' => T\<^sub>i (Node3 l ab1 m' ab2 r)
  12.182 +                 | Up\<^sub>i m1 ab' m2 => Up\<^sub>i (Node2 l ab1 m1) ab' (Node2 m2 ab2 r)) |
  12.183 +           EQ \<Rightarrow> T\<^sub>i (Node3 l ab1 m (x,y) r) |
  12.184 +           GT \<Rightarrow> (case upd x y r of
  12.185 +                   T\<^sub>i r' => T\<^sub>i (Node3 l ab1 m ab2 r')
  12.186 +                 | Up\<^sub>i r1 ab' r2 => Up\<^sub>i (Node2 l ab1 m) ab2 (Node2 r1 ab' r2))))"
  12.187 +
  12.188 +definition update :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
  12.189 +"update a b t = tree\<^sub>i(upd a b t)"
  12.190 +
  12.191 +fun del :: "'a::cmp \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) up\<^sub>d" where
  12.192 +"del x Leaf = T\<^sub>d Leaf" |
  12.193 +"del x (Node2 Leaf ab1 Leaf) = (if x=fst ab1 then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf ab1 Leaf))" |
  12.194 +"del x (Node3 Leaf ab1 Leaf ab2 Leaf) = T\<^sub>d(if x=fst ab1 then Node2 Leaf ab2 Leaf
  12.195 +  else if x=fst ab2 then Node2 Leaf ab1 Leaf else Node3 Leaf ab1 Leaf ab2 Leaf)" |
  12.196 +"del x (Node2 l ab1 r) = (case cmp x (fst ab1) of
  12.197 +  LT \<Rightarrow> node21 (del x l) ab1 r |
  12.198 +  GT \<Rightarrow> node22 l ab1 (del x r) |
  12.199 +  EQ \<Rightarrow> let (ab1',t) = del_min r in node22 l ab1' t)" |
  12.200 +"del x (Node3 l ab1 m ab2 r) = (case cmp x (fst ab1) of
  12.201 +  LT \<Rightarrow> node31 (del x l) ab1 m ab2 r |
  12.202 +  EQ \<Rightarrow> let (ab1',m') = del_min m in node32 l ab1' m' ab2 r |
  12.203 +  GT \<Rightarrow> (case cmp x (fst ab2) of
  12.204 +           LT \<Rightarrow> node32 l ab1 (del x m) ab2 r |
  12.205 +           EQ \<Rightarrow> let (ab2',r') = del_min r in node33 l ab1 m ab2' r' |
  12.206 +           GT \<Rightarrow> node33 l ab1 m ab2 (del x r)))"
  12.207 +
  12.208 +definition delete :: "'a::cmp \<Rightarrow> ('a*'b) tree23 \<Rightarrow> ('a*'b) tree23" where
  12.209 +"delete x t = tree\<^sub>d(del x t)"
  12.210 +
  12.211 +
  12.212 +subsection \<open>Functional Correctness\<close>
  12.213 +
  12.214 +lemma lookup: "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
  12.215 +by (induction t) (auto simp: map_of_simps split: option.split)
  12.216 +
  12.217 +
  12.218 +lemma inorder_upd:
  12.219 +  "sorted1(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(upd a b t)) = upd_list a b (inorder t)"
  12.220 +by(induction t) (auto simp: upd_list_simps split: up\<^sub>i.splits)
  12.221 +
  12.222 +corollary inorder_update:
  12.223 +  "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
  12.224 +by(simp add: update_def inorder_upd)
  12.225 +
  12.226 +
  12.227 +lemma inorder_del: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  12.228 +  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
  12.229 +by(induction t rule: del.induct)
  12.230 +  (auto simp: del_list_simps inorder_nodes del_minD split: prod.splits)
  12.231 +
  12.232 +corollary inorder_delete: "\<lbrakk> bal t ; sorted1(inorder t) \<rbrakk> \<Longrightarrow>
  12.233 +  inorder(delete x t) = del_list x (inorder t)"
  12.234 +by(simp add: delete_def inorder_del)
  12.235 +
  12.236 +
  12.237 +subsection \<open>Balancedness\<close>
  12.238 +
  12.239 +lemma bal_upd: "bal t \<Longrightarrow> bal (tree\<^sub>i(upd a b t)) \<and> height(upd a b t) = height t"
  12.240 +by (induct t) (auto split: up\<^sub>i.split)(* 16 secs in 2015 *)
  12.241 +
  12.242 +corollary bal_update: "bal t \<Longrightarrow> bal (update a b t)"
  12.243 +by (simp add: update_def bal_upd)
  12.244 +
  12.245 +
  12.246 +lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  12.247 +by(induction x t rule: del.induct)
  12.248 +  (auto simp add: heights max_def height_del_min split: prod.split)
  12.249 +
  12.250 +lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
  12.251 +by(induction x t rule: del.induct)
  12.252 +  (auto simp: bals bal_del_min height_del height_del_min split: prod.split)
  12.253 +
  12.254 +corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
  12.255 +by(simp add: delete_def bal_tree\<^sub>d_del)
  12.256 +
  12.257 +
  12.258 +subsection \<open>Overall Correctness\<close>
  12.259 +
  12.260 +interpretation T23_Map: Map_by_Ordered
  12.261 +where empty = Leaf and lookup = lookup and update = update and delete = delete
  12.262 +and inorder = inorder and wf = bal
  12.263 +proof (standard, goal_cases)
  12.264 +  case 2 thus ?case by(simp add: lookup)
  12.265 +next
  12.266 +  case 3 thus ?case by(simp add: inorder_update)
  12.267 +next
  12.268 +  case 4 thus ?case by(simp add: inorder_delete)
  12.269 +next
  12.270 +  case 6 thus ?case by(simp add: bal_update)
  12.271 +next
  12.272 +  case 7 thus ?case by(simp add: bal_delete)
  12.273 +qed simp+
  12.274 +
  12.275 +end
    13.1 --- a/src/HOL/Data_Structures/Tree23_Set.thy	Wed Nov 11 16:42:30 2015 +0100
    13.2 +++ b/src/HOL/Data_Structures/Tree23_Set.thy	Wed Nov 11 18:32:26 2015 +0100
    13.3 @@ -1,372 +1,372 @@
    13.4 -(* Author: Tobias Nipkow *)
    13.5 -
    13.6 -section \<open>A 2-3 Tree Implementation of Sets\<close>
    13.7 -
    13.8 -theory Tree23_Set
    13.9 -imports
   13.10 -  Tree23
   13.11 -  Cmp
   13.12 -  Set_by_Ordered
   13.13 -begin
   13.14 -
   13.15 -fun isin :: "'a::cmp tree23 \<Rightarrow> 'a \<Rightarrow> bool" where
   13.16 -"isin Leaf x = False" |
   13.17 -"isin (Node2 l a r) x =
   13.18 -  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x)" |
   13.19 -"isin (Node3 l a m b r) x =
   13.20 -  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> (case cmp x b of
   13.21 -   LT \<Rightarrow> isin m x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x))"
   13.22 -
   13.23 -datatype 'a up\<^sub>i = T\<^sub>i "'a tree23" | Up\<^sub>i "'a tree23" 'a "'a tree23"
   13.24 -
   13.25 -fun tree\<^sub>i :: "'a up\<^sub>i \<Rightarrow> 'a tree23" where
   13.26 -"tree\<^sub>i (T\<^sub>i t) = t" |
   13.27 -"tree\<^sub>i (Up\<^sub>i l p r) = Node2 l p r"
   13.28 -
   13.29 -fun ins :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>i" where
   13.30 -"ins x Leaf = Up\<^sub>i Leaf x Leaf" |
   13.31 -"ins x (Node2 l a r) =
   13.32 -   (case cmp x a of
   13.33 -      LT \<Rightarrow> (case ins x l of
   13.34 -              T\<^sub>i l' => T\<^sub>i (Node2 l' a r)
   13.35 -            | Up\<^sub>i l1 b l2 => T\<^sub>i (Node3 l1 b l2 a r)) |
   13.36 -      EQ \<Rightarrow> T\<^sub>i (Node2 l x r) |
   13.37 -      GT \<Rightarrow> (case ins x r of
   13.38 -              T\<^sub>i r' => T\<^sub>i (Node2 l a r')
   13.39 -            | Up\<^sub>i r1 b r2 => T\<^sub>i (Node3 l a r1 b r2)))" |
   13.40 -"ins x (Node3 l a m b r) =
   13.41 -   (case cmp x a of
   13.42 -      LT \<Rightarrow> (case ins x l of
   13.43 -              T\<^sub>i l' => T\<^sub>i (Node3 l' a m b r)
   13.44 -            | Up\<^sub>i l1 c l2 => Up\<^sub>i (Node2 l1 c l2) a (Node2 m b r)) |
   13.45 -      EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
   13.46 -      GT \<Rightarrow> (case cmp x b of
   13.47 -               GT \<Rightarrow> (case ins x r of
   13.48 -                       T\<^sub>i r' => T\<^sub>i (Node3 l a m b r')
   13.49 -                     | Up\<^sub>i r1 c r2 => Up\<^sub>i (Node2 l a m) b (Node2 r1 c r2)) |
   13.50 -               EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
   13.51 -               LT \<Rightarrow> (case ins x m of
   13.52 -                       T\<^sub>i m' => T\<^sub>i (Node3 l a m' b r)
   13.53 -                     | Up\<^sub>i m1 c m2 => Up\<^sub>i (Node2 l a m1) c (Node2 m2 b r))))"
   13.54 -
   13.55 -hide_const insert
   13.56 -
   13.57 -definition insert :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a tree23" where
   13.58 -"insert x t = tree\<^sub>i(ins x t)"
   13.59 -
   13.60 -datatype 'a up\<^sub>d = T\<^sub>d "'a tree23" | Up\<^sub>d "'a tree23"
   13.61 -
   13.62 -fun tree\<^sub>d :: "'a up\<^sub>d \<Rightarrow> 'a tree23" where
   13.63 -"tree\<^sub>d (T\<^sub>d x) = x" |
   13.64 -"tree\<^sub>d (Up\<^sub>d x) = x"
   13.65 -
   13.66 -(* Variation: return None to signal no-change *)
   13.67 -
   13.68 -fun node21 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d" where
   13.69 -"node21 (T\<^sub>d t1) a t2 = T\<^sub>d(Node2 t1 a t2)" |
   13.70 -"node21 (Up\<^sub>d t1) a (Node2 t2 b t3) = Up\<^sub>d(Node3 t1 a t2 b t3)" |
   13.71 -"node21 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) = T\<^sub>d(Node2 (Node2 t1 a t2) b (Node2 t3 c t4))"
   13.72 -
   13.73 -fun node22 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
   13.74 -"node22 t1 a (T\<^sub>d t2) = T\<^sub>d(Node2 t1 a t2)" |
   13.75 -"node22 (Node2 t1 b t2) a (Up\<^sub>d t3) = Up\<^sub>d(Node3 t1 b t2 a t3)" |
   13.76 -"node22 (Node3 t1 b t2 c t3) a (Up\<^sub>d t4) = T\<^sub>d(Node2 (Node2 t1 b t2) c (Node2 t3 a t4))"
   13.77 -
   13.78 -fun node31 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d" where
   13.79 -"node31 (T\<^sub>d t1) a t2 b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
   13.80 -"node31 (Up\<^sub>d t1) a (Node2 t2 b t3) c t4 = T\<^sub>d(Node2 (Node3 t1 a t2 b t3) c t4)" |
   13.81 -"node31 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) d t5 = T\<^sub>d(Node3 (Node2 t1 a t2) b (Node2 t3 c t4) d t5)"
   13.82 -
   13.83 -fun node32 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d" where
   13.84 -"node32 t1 a (T\<^sub>d t2) b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
   13.85 -"node32 t1 a (Up\<^sub>d t2) b (Node2 t3 c t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
   13.86 -"node32 t1 a (Up\<^sub>d t2) b (Node3 t3 c t4 d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))"
   13.87 -
   13.88 -fun node33 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
   13.89 -"node33 l a m b (T\<^sub>d r) = T\<^sub>d(Node3 l a m b r)" |
   13.90 -"node33 t1 a (Node2 t2 b t3) c (Up\<^sub>d t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
   13.91 -"node33 t1 a (Node3 t2 b t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))"
   13.92 -
   13.93 -fun del_min :: "'a tree23 \<Rightarrow> 'a * 'a up\<^sub>d" where
   13.94 -"del_min (Node2 Leaf a Leaf) = (a, Up\<^sub>d Leaf)" |
   13.95 -"del_min (Node3 Leaf a Leaf b Leaf) = (a, T\<^sub>d(Node2 Leaf b Leaf))" |
   13.96 -"del_min (Node2 l a r) = (let (x,l') = del_min l in (x, node21 l' a r))" |
   13.97 -"del_min (Node3 l a m b r) = (let (x,l') = del_min l in (x, node31 l' a m b r))"
   13.98 -
   13.99 -fun del :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d"
  13.100 -where
  13.101 -"del x Leaf = T\<^sub>d Leaf" |
  13.102 -"del x (Node2 Leaf a Leaf) = (if x = a then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf a Leaf))" |
  13.103 -"del x (Node3 Leaf a Leaf b Leaf) = T\<^sub>d(if x = a then Node2 Leaf b Leaf
  13.104 -  else if x = b then Node2 Leaf a Leaf else Node3 Leaf a Leaf b Leaf)" |
  13.105 -"del x (Node2 l a r) = (case cmp x a of
  13.106 -  LT \<Rightarrow> node21 (del x l) a r |
  13.107 -  GT \<Rightarrow> node22 l a (del x r) |
  13.108 -  EQ \<Rightarrow> let (a',t) = del_min r in node22 l a' t)" |
  13.109 -"del x (Node3 l a m b r) = (case cmp x a of
  13.110 -  LT \<Rightarrow> node31 (del x l) a m b r |
  13.111 -  EQ \<Rightarrow> let (a',m') = del_min m in node32 l a' m' b r |
  13.112 -  GT \<Rightarrow> (case cmp x b of
  13.113 -          LT \<Rightarrow> node32 l a (del x m) b r |
  13.114 -          EQ \<Rightarrow> let (b',r') = del_min r in node33 l a m b' r' |
  13.115 -          GT \<Rightarrow> node33 l a m b (del x r)))"
  13.116 -
  13.117 -definition delete :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a tree23" where
  13.118 -"delete x t = tree\<^sub>d(del x t)"
  13.119 -
  13.120 -
  13.121 -subsection "Functional Correctness"
  13.122 -
  13.123 -subsubsection "Proofs for isin"
  13.124 -
  13.125 -lemma "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  13.126 -by (induction t) (auto simp: elems_simps1 ball_Un)
  13.127 -
  13.128 -lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  13.129 -by (induction t) (auto simp: elems_simps2)
  13.130 -
  13.131 -
  13.132 -subsubsection "Proofs for insert"
  13.133 -
  13.134 -lemma inorder_ins:
  13.135 -  "sorted(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(ins x t)) = ins_list x (inorder t)"
  13.136 -by(induction t) (auto simp: ins_list_simps split: up\<^sub>i.splits)
  13.137 -
  13.138 -lemma inorder_insert:
  13.139 -  "sorted(inorder t) \<Longrightarrow> inorder(insert a t) = ins_list a (inorder t)"
  13.140 -by(simp add: insert_def inorder_ins)
  13.141 -
  13.142 -
  13.143 -subsubsection "Proofs for delete"
  13.144 -
  13.145 -lemma inorder_node21: "height r > 0 \<Longrightarrow>
  13.146 -  inorder (tree\<^sub>d (node21 l' a r)) = inorder (tree\<^sub>d l') @ a # inorder r"
  13.147 -by(induct l' a r rule: node21.induct) auto
  13.148 -
  13.149 -lemma inorder_node22: "height l > 0 \<Longrightarrow>
  13.150 -  inorder (tree\<^sub>d (node22 l a r')) = inorder l @ a # inorder (tree\<^sub>d r')"
  13.151 -by(induct l a r' rule: node22.induct) auto
  13.152 -
  13.153 -lemma inorder_node31: "height m > 0 \<Longrightarrow>
  13.154 -  inorder (tree\<^sub>d (node31 l' a m b r)) = inorder (tree\<^sub>d l') @ a # inorder m @ b # inorder r"
  13.155 -by(induct l' a m b r rule: node31.induct) auto
  13.156 -
  13.157 -lemma inorder_node32: "height r > 0 \<Longrightarrow>
  13.158 -  inorder (tree\<^sub>d (node32 l a m' b r)) = inorder l @ a # inorder (tree\<^sub>d m') @ b # inorder r"
  13.159 -by(induct l a m' b r rule: node32.induct) auto
  13.160 -
  13.161 -lemma inorder_node33: "height m > 0 \<Longrightarrow>
  13.162 -  inorder (tree\<^sub>d (node33 l a m b r')) = inorder l @ a # inorder m @ b # inorder (tree\<^sub>d r')"
  13.163 -by(induct l a m b r' rule: node33.induct) auto
  13.164 -
  13.165 -lemmas inorder_nodes = inorder_node21 inorder_node22
  13.166 -  inorder_node31 inorder_node32 inorder_node33
  13.167 -
  13.168 -lemma del_minD:
  13.169 -  "del_min t = (x,t') \<Longrightarrow> bal t \<Longrightarrow> height t > 0 \<Longrightarrow>
  13.170 -  x # inorder(tree\<^sub>d t') = inorder t"
  13.171 -by(induction t arbitrary: t' rule: del_min.induct)
  13.172 -  (auto simp: inorder_nodes split: prod.splits)
  13.173 -
  13.174 -lemma inorder_del: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  13.175 -  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
  13.176 -by(induction t rule: del.induct)
  13.177 -  (auto simp: del_list_simps inorder_nodes del_minD split: prod.splits)
  13.178 -
  13.179 -lemma inorder_delete: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  13.180 -  inorder(delete x t) = del_list x (inorder t)"
  13.181 -by(simp add: delete_def inorder_del)
  13.182 -
  13.183 -
  13.184 -subsection \<open>Balancedness\<close>
  13.185 -
  13.186 -
  13.187 -subsubsection "Proofs for insert"
  13.188 -
  13.189 -text{* First a standard proof that @{const ins} preserves @{const bal}. *}
  13.190 -
  13.191 -instantiation up\<^sub>i :: (type)height
  13.192 -begin
  13.193 -
  13.194 -fun height_up\<^sub>i :: "'a up\<^sub>i \<Rightarrow> nat" where
  13.195 -"height (T\<^sub>i t) = height t" |
  13.196 -"height (Up\<^sub>i l a r) = height l"
  13.197 -
  13.198 -instance ..
  13.199 -
  13.200 -end
  13.201 -
  13.202 -lemma bal_ins: "bal t \<Longrightarrow> bal (tree\<^sub>i(ins a t)) \<and> height(ins a t) = height t"
  13.203 -by (induct t) (auto split: up\<^sub>i.split) (* 15 secs in 2015 *)
  13.204 -
  13.205 -text{* Now an alternative proof (by Brian Huffman) that runs faster because
  13.206 -two properties (balance and height) are combined in one predicate. *}
  13.207 -
  13.208 -inductive full :: "nat \<Rightarrow> 'a tree23 \<Rightarrow> bool" where
  13.209 -"full 0 Leaf" |
  13.210 -"\<lbrakk>full n l; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node2 l p r)" |
  13.211 -"\<lbrakk>full n l; full n m; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node3 l p m q r)"
  13.212 -
  13.213 -inductive_cases full_elims:
  13.214 -  "full n Leaf"
  13.215 -  "full n (Node2 l p r)"
  13.216 -  "full n (Node3 l p m q r)"
  13.217 -
  13.218 -inductive_cases full_0_elim: "full 0 t"
  13.219 -inductive_cases full_Suc_elim: "full (Suc n) t"
  13.220 -
  13.221 -lemma full_0_iff [simp]: "full 0 t \<longleftrightarrow> t = Leaf"
  13.222 -  by (auto elim: full_0_elim intro: full.intros)
  13.223 -
  13.224 -lemma full_Leaf_iff [simp]: "full n Leaf \<longleftrightarrow> n = 0"
  13.225 -  by (auto elim: full_elims intro: full.intros)
  13.226 -
  13.227 -lemma full_Suc_Node2_iff [simp]:
  13.228 -  "full (Suc n) (Node2 l p r) \<longleftrightarrow> full n l \<and> full n r"
  13.229 -  by (auto elim: full_elims intro: full.intros)
  13.230 -
  13.231 -lemma full_Suc_Node3_iff [simp]:
  13.232 -  "full (Suc n) (Node3 l p m q r) \<longleftrightarrow> full n l \<and> full n m \<and> full n r"
  13.233 -  by (auto elim: full_elims intro: full.intros)
  13.234 -
  13.235 -lemma full_imp_height: "full n t \<Longrightarrow> height t = n"
  13.236 -  by (induct set: full, simp_all)
  13.237 -
  13.238 -lemma full_imp_bal: "full n t \<Longrightarrow> bal t"
  13.239 -  by (induct set: full, auto dest: full_imp_height)
  13.240 -
  13.241 -lemma bal_imp_full: "bal t \<Longrightarrow> full (height t) t"
  13.242 -  by (induct t, simp_all)
  13.243 -
  13.244 -lemma bal_iff_full: "bal t \<longleftrightarrow> (\<exists>n. full n t)"
  13.245 -  by (auto elim!: bal_imp_full full_imp_bal)
  13.246 -
  13.247 -text {* The @{const "insert"} function either preserves the height of the
  13.248 -tree, or increases it by one. The constructor returned by the @{term
  13.249 -"insert"} function determines which: A return value of the form @{term
  13.250 -"T\<^sub>i t"} indicates that the height will be the same. A value of the
  13.251 -form @{term "Up\<^sub>i l p r"} indicates an increase in height. *}
  13.252 -
  13.253 -fun full\<^sub>i :: "nat \<Rightarrow> 'a up\<^sub>i \<Rightarrow> bool" where
  13.254 -"full\<^sub>i n (T\<^sub>i t) \<longleftrightarrow> full n t" |
  13.255 -"full\<^sub>i n (Up\<^sub>i l p r) \<longleftrightarrow> full n l \<and> full n r"
  13.256 -
  13.257 -lemma full\<^sub>i_ins: "full n t \<Longrightarrow> full\<^sub>i n (ins a t)"
  13.258 -by (induct rule: full.induct) (auto split: up\<^sub>i.split)
  13.259 -
  13.260 -text {* The @{const insert} operation preserves balance. *}
  13.261 -
  13.262 -lemma bal_insert: "bal t \<Longrightarrow> bal (insert a t)"
  13.263 -unfolding bal_iff_full insert_def
  13.264 -apply (erule exE)
  13.265 -apply (drule full\<^sub>i_ins [of _ _ a])
  13.266 -apply (cases "ins a t")
  13.267 -apply (auto intro: full.intros)
  13.268 -done
  13.269 -
  13.270 -
  13.271 -subsection "Proofs for delete"
  13.272 -
  13.273 -instantiation up\<^sub>d :: (type)height
  13.274 -begin
  13.275 -
  13.276 -fun height_up\<^sub>d :: "'a up\<^sub>d \<Rightarrow> nat" where
  13.277 -"height (T\<^sub>d t) = height t" |
  13.278 -"height (Up\<^sub>d t) = height t + 1"
  13.279 -
  13.280 -instance ..
  13.281 -
  13.282 -end
  13.283 -
  13.284 -lemma bal_tree\<^sub>d_node21:
  13.285 -  "\<lbrakk>bal r; bal (tree\<^sub>d l'); height r = height l' \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node21 l' a r))"
  13.286 -by(induct l' a r rule: node21.induct) auto
  13.287 -
  13.288 -lemma bal_tree\<^sub>d_node22:
  13.289 -  "\<lbrakk>bal(tree\<^sub>d r'); bal l; height r' = height l \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node22 l a r'))"
  13.290 -by(induct l a r' rule: node22.induct) auto
  13.291 -
  13.292 -lemma bal_tree\<^sub>d_node31:
  13.293 -  "\<lbrakk> bal (tree\<^sub>d l'); bal m; bal r; height l' = height r; height m = height r \<rbrakk>
  13.294 -  \<Longrightarrow> bal (tree\<^sub>d (node31 l' a m b r))"
  13.295 -by(induct l' a m b r rule: node31.induct) auto
  13.296 -
  13.297 -lemma bal_tree\<^sub>d_node32:
  13.298 -  "\<lbrakk> bal l; bal (tree\<^sub>d m'); bal r; height l = height r; height m' = height r \<rbrakk>
  13.299 -  \<Longrightarrow> bal (tree\<^sub>d (node32 l a m' b r))"
  13.300 -by(induct l a m' b r rule: node32.induct) auto
  13.301 -
  13.302 -lemma bal_tree\<^sub>d_node33:
  13.303 -  "\<lbrakk> bal l; bal m; bal(tree\<^sub>d r'); height l = height r'; height m = height r' \<rbrakk>
  13.304 -  \<Longrightarrow> bal (tree\<^sub>d (node33 l a m b r'))"
  13.305 -by(induct l a m b r' rule: node33.induct) auto
  13.306 -
  13.307 -lemmas bals = bal_tree\<^sub>d_node21 bal_tree\<^sub>d_node22
  13.308 -  bal_tree\<^sub>d_node31 bal_tree\<^sub>d_node32 bal_tree\<^sub>d_node33
  13.309 -
  13.310 -lemma height'_node21:
  13.311 -   "height r > 0 \<Longrightarrow> height(node21 l' a r) = max (height l') (height r) + 1"
  13.312 -by(induct l' a r rule: node21.induct)(simp_all)
  13.313 -
  13.314 -lemma height'_node22:
  13.315 -   "height l > 0 \<Longrightarrow> height(node22 l a r') = max (height l) (height r') + 1"
  13.316 -by(induct l a r' rule: node22.induct)(simp_all)
  13.317 -
  13.318 -lemma height'_node31:
  13.319 -  "height m > 0 \<Longrightarrow> height(node31 l a m b r) =
  13.320 -   max (height l) (max (height m) (height r)) + 1"
  13.321 -by(induct l a m b r rule: node31.induct)(simp_all add: max_def)
  13.322 -
  13.323 -lemma height'_node32:
  13.324 -  "height r > 0 \<Longrightarrow> height(node32 l a m b r) =
  13.325 -   max (height l) (max (height m) (height r)) + 1"
  13.326 -by(induct l a m b r rule: node32.induct)(simp_all add: max_def)
  13.327 -
  13.328 -lemma height'_node33:
  13.329 -  "height m > 0 \<Longrightarrow> height(node33 l a m b r) =
  13.330 -   max (height l) (max (height m) (height r)) + 1"
  13.331 -by(induct l a m b r rule: node33.induct)(simp_all add: max_def)
  13.332 -
  13.333 -lemmas heights = height'_node21 height'_node22
  13.334 -  height'_node31 height'_node32 height'_node33
  13.335 -
  13.336 -lemma height_del_min:
  13.337 -  "del_min t = (x, t') \<Longrightarrow> height t > 0 \<Longrightarrow> bal t \<Longrightarrow> height t' = height t"
  13.338 -by(induct t arbitrary: x t' rule: del_min.induct)
  13.339 -  (auto simp: heights split: prod.splits)
  13.340 -
  13.341 -lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  13.342 -by(induction x t rule: del.induct)
  13.343 -  (auto simp: heights max_def height_del_min split: prod.splits)
  13.344 -
  13.345 -lemma bal_del_min:
  13.346 -  "\<lbrakk> del_min t = (x, t'); bal t; height t > 0 \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d t')"
  13.347 -by(induct t arbitrary: x t' rule: del_min.induct)
  13.348 -  (auto simp: heights height_del_min bals split: prod.splits)
  13.349 -
  13.350 -lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
  13.351 -by(induction x t rule: del.induct)
  13.352 -  (auto simp: bals bal_del_min height_del height_del_min split: prod.splits)
  13.353 -
  13.354 -corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
  13.355 -by(simp add: delete_def bal_tree\<^sub>d_del)
  13.356 -
  13.357 -
  13.358 -subsection \<open>Overall Correctness\<close>
  13.359 -
  13.360 -interpretation Set_by_Ordered
  13.361 -where empty = Leaf and isin = isin and insert = insert and delete = delete
  13.362 -and inorder = inorder and inv = bal
  13.363 -proof (standard, goal_cases)
  13.364 -  case 2 thus ?case by(simp add: isin_set)
  13.365 -next
  13.366 -  case 3 thus ?case by(simp add: inorder_insert)
  13.367 -next
  13.368 -  case 4 thus ?case by(simp add: inorder_delete)
  13.369 -next
  13.370 -  case 6 thus ?case by(simp add: bal_insert)
  13.371 -next
  13.372 -  case 7 thus ?case by(simp add: bal_delete)
  13.373 -qed simp+
  13.374 -
  13.375 -end
  13.376 +(* Author: Tobias Nipkow *)
  13.377 +
  13.378 +section \<open>A 2-3 Tree Implementation of Sets\<close>
  13.379 +
  13.380 +theory Tree23_Set
  13.381 +imports
  13.382 +  Tree23
  13.383 +  Cmp
  13.384 +  Set_by_Ordered
  13.385 +begin
  13.386 +
  13.387 +fun isin :: "'a::cmp tree23 \<Rightarrow> 'a \<Rightarrow> bool" where
  13.388 +"isin Leaf x = False" |
  13.389 +"isin (Node2 l a r) x =
  13.390 +  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x)" |
  13.391 +"isin (Node3 l a m b r) x =
  13.392 +  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> (case cmp x b of
  13.393 +   LT \<Rightarrow> isin m x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x))"
  13.394 +
  13.395 +datatype 'a up\<^sub>i = T\<^sub>i "'a tree23" | Up\<^sub>i "'a tree23" 'a "'a tree23"
  13.396 +
  13.397 +fun tree\<^sub>i :: "'a up\<^sub>i \<Rightarrow> 'a tree23" where
  13.398 +"tree\<^sub>i (T\<^sub>i t) = t" |
  13.399 +"tree\<^sub>i (Up\<^sub>i l p r) = Node2 l p r"
  13.400 +
  13.401 +fun ins :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>i" where
  13.402 +"ins x Leaf = Up\<^sub>i Leaf x Leaf" |
  13.403 +"ins x (Node2 l a r) =
  13.404 +   (case cmp x a of
  13.405 +      LT \<Rightarrow> (case ins x l of
  13.406 +              T\<^sub>i l' => T\<^sub>i (Node2 l' a r)
  13.407 +            | Up\<^sub>i l1 b l2 => T\<^sub>i (Node3 l1 b l2 a r)) |
  13.408 +      EQ \<Rightarrow> T\<^sub>i (Node2 l x r) |
  13.409 +      GT \<Rightarrow> (case ins x r of
  13.410 +              T\<^sub>i r' => T\<^sub>i (Node2 l a r')
  13.411 +            | Up\<^sub>i r1 b r2 => T\<^sub>i (Node3 l a r1 b r2)))" |
  13.412 +"ins x (Node3 l a m b r) =
  13.413 +   (case cmp x a of
  13.414 +      LT \<Rightarrow> (case ins x l of
  13.415 +              T\<^sub>i l' => T\<^sub>i (Node3 l' a m b r)
  13.416 +            | Up\<^sub>i l1 c l2 => Up\<^sub>i (Node2 l1 c l2) a (Node2 m b r)) |
  13.417 +      EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
  13.418 +      GT \<Rightarrow> (case cmp x b of
  13.419 +               GT \<Rightarrow> (case ins x r of
  13.420 +                       T\<^sub>i r' => T\<^sub>i (Node3 l a m b r')
  13.421 +                     | Up\<^sub>i r1 c r2 => Up\<^sub>i (Node2 l a m) b (Node2 r1 c r2)) |
  13.422 +               EQ \<Rightarrow> T\<^sub>i (Node3 l a m b r) |
  13.423 +               LT \<Rightarrow> (case ins x m of
  13.424 +                       T\<^sub>i m' => T\<^sub>i (Node3 l a m' b r)
  13.425 +                     | Up\<^sub>i m1 c m2 => Up\<^sub>i (Node2 l a m1) c (Node2 m2 b r))))"
  13.426 +
  13.427 +hide_const insert
  13.428 +
  13.429 +definition insert :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a tree23" where
  13.430 +"insert x t = tree\<^sub>i(ins x t)"
  13.431 +
  13.432 +datatype 'a up\<^sub>d = T\<^sub>d "'a tree23" | Up\<^sub>d "'a tree23"
  13.433 +
  13.434 +fun tree\<^sub>d :: "'a up\<^sub>d \<Rightarrow> 'a tree23" where
  13.435 +"tree\<^sub>d (T\<^sub>d x) = x" |
  13.436 +"tree\<^sub>d (Up\<^sub>d x) = x"
  13.437 +
  13.438 +(* Variation: return None to signal no-change *)
  13.439 +
  13.440 +fun node21 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d" where
  13.441 +"node21 (T\<^sub>d t1) a t2 = T\<^sub>d(Node2 t1 a t2)" |
  13.442 +"node21 (Up\<^sub>d t1) a (Node2 t2 b t3) = Up\<^sub>d(Node3 t1 a t2 b t3)" |
  13.443 +"node21 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) = T\<^sub>d(Node2 (Node2 t1 a t2) b (Node2 t3 c t4))"
  13.444 +
  13.445 +fun node22 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  13.446 +"node22 t1 a (T\<^sub>d t2) = T\<^sub>d(Node2 t1 a t2)" |
  13.447 +"node22 (Node2 t1 b t2) a (Up\<^sub>d t3) = Up\<^sub>d(Node3 t1 b t2 a t3)" |
  13.448 +"node22 (Node3 t1 b t2 c t3) a (Up\<^sub>d t4) = T\<^sub>d(Node2 (Node2 t1 b t2) c (Node2 t3 a t4))"
  13.449 +
  13.450 +fun node31 :: "'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d" where
  13.451 +"node31 (T\<^sub>d t1) a t2 b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
  13.452 +"node31 (Up\<^sub>d t1) a (Node2 t2 b t3) c t4 = T\<^sub>d(Node2 (Node3 t1 a t2 b t3) c t4)" |
  13.453 +"node31 (Up\<^sub>d t1) a (Node3 t2 b t3 c t4) d t5 = T\<^sub>d(Node3 (Node2 t1 a t2) b (Node2 t3 c t4) d t5)"
  13.454 +
  13.455 +fun node32 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d" where
  13.456 +"node32 t1 a (T\<^sub>d t2) b t3 = T\<^sub>d(Node3 t1 a t2 b t3)" |
  13.457 +"node32 t1 a (Up\<^sub>d t2) b (Node2 t3 c t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
  13.458 +"node32 t1 a (Up\<^sub>d t2) b (Node3 t3 c t4 d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))"
  13.459 +
  13.460 +fun node33 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a up\<^sub>d \<Rightarrow> 'a up\<^sub>d" where
  13.461 +"node33 l a m b (T\<^sub>d r) = T\<^sub>d(Node3 l a m b r)" |
  13.462 +"node33 t1 a (Node2 t2 b t3) c (Up\<^sub>d t4) = T\<^sub>d(Node2 t1 a (Node3 t2 b t3 c t4))" |
  13.463 +"node33 t1 a (Node3 t2 b t3 c t4) d (Up\<^sub>d t5) = T\<^sub>d(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))"
  13.464 +
  13.465 +fun del_min :: "'a tree23 \<Rightarrow> 'a * 'a up\<^sub>d" where
  13.466 +"del_min (Node2 Leaf a Leaf) = (a, Up\<^sub>d Leaf)" |
  13.467 +"del_min (Node3 Leaf a Leaf b Leaf) = (a, T\<^sub>d(Node2 Leaf b Leaf))" |
  13.468 +"del_min (Node2 l a r) = (let (x,l') = del_min l in (x, node21 l' a r))" |
  13.469 +"del_min (Node3 l a m b r) = (let (x,l') = del_min l in (x, node31 l' a m b r))"
  13.470 +
  13.471 +fun del :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a up\<^sub>d"
  13.472 +where
  13.473 +"del x Leaf = T\<^sub>d Leaf" |
  13.474 +"del x (Node2 Leaf a Leaf) = (if x = a then Up\<^sub>d Leaf else T\<^sub>d(Node2 Leaf a Leaf))" |
  13.475 +"del x (Node3 Leaf a Leaf b Leaf) = T\<^sub>d(if x = a then Node2 Leaf b Leaf
  13.476 +  else if x = b then Node2 Leaf a Leaf else Node3 Leaf a Leaf b Leaf)" |
  13.477 +"del x (Node2 l a r) = (case cmp x a of
  13.478 +  LT \<Rightarrow> node21 (del x l) a r |
  13.479 +  GT \<Rightarrow> node22 l a (del x r) |
  13.480 +  EQ \<Rightarrow> let (a',t) = del_min r in node22 l a' t)" |
  13.481 +"del x (Node3 l a m b r) = (case cmp x a of
  13.482 +  LT \<Rightarrow> node31 (del x l) a m b r |
  13.483 +  EQ \<Rightarrow> let (a',m') = del_min m in node32 l a' m' b r |
  13.484 +  GT \<Rightarrow> (case cmp x b of
  13.485 +          LT \<Rightarrow> node32 l a (del x m) b r |
  13.486 +          EQ \<Rightarrow> let (b',r') = del_min r in node33 l a m b' r' |
  13.487 +          GT \<Rightarrow> node33 l a m b (del x r)))"
  13.488 +
  13.489 +definition delete :: "'a::cmp \<Rightarrow> 'a tree23 \<Rightarrow> 'a tree23" where
  13.490 +"delete x t = tree\<^sub>d(del x t)"
  13.491 +
  13.492 +
  13.493 +subsection "Functional Correctness"
  13.494 +
  13.495 +subsubsection "Proofs for isin"
  13.496 +
  13.497 +lemma "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  13.498 +by (induction t) (auto simp: elems_simps1 ball_Un)
  13.499 +
  13.500 +lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  13.501 +by (induction t) (auto simp: elems_simps2)
  13.502 +
  13.503 +
  13.504 +subsubsection "Proofs for insert"
  13.505 +
  13.506 +lemma inorder_ins:
  13.507 +  "sorted(inorder t) \<Longrightarrow> inorder(tree\<^sub>i(ins x t)) = ins_list x (inorder t)"
  13.508 +by(induction t) (auto simp: ins_list_simps split: up\<^sub>i.splits)
  13.509 +
  13.510 +lemma inorder_insert:
  13.511 +  "sorted(inorder t) \<Longrightarrow> inorder(insert a t) = ins_list a (inorder t)"
  13.512 +by(simp add: insert_def inorder_ins)
  13.513 +
  13.514 +
  13.515 +subsubsection "Proofs for delete"
  13.516 +
  13.517 +lemma inorder_node21: "height r > 0 \<Longrightarrow>
  13.518 +  inorder (tree\<^sub>d (node21 l' a r)) = inorder (tree\<^sub>d l') @ a # inorder r"
  13.519 +by(induct l' a r rule: node21.induct) auto
  13.520 +
  13.521 +lemma inorder_node22: "height l > 0 \<Longrightarrow>
  13.522 +  inorder (tree\<^sub>d (node22 l a r')) = inorder l @ a # inorder (tree\<^sub>d r')"
  13.523 +by(induct l a r' rule: node22.induct) auto
  13.524 +
  13.525 +lemma inorder_node31: "height m > 0 \<Longrightarrow>
  13.526 +  inorder (tree\<^sub>d (node31 l' a m b r)) = inorder (tree\<^sub>d l') @ a # inorder m @ b # inorder r"
  13.527 +by(induct l' a m b r rule: node31.induct) auto
  13.528 +
  13.529 +lemma inorder_node32: "height r > 0 \<Longrightarrow>
  13.530 +  inorder (tree\<^sub>d (node32 l a m' b r)) = inorder l @ a # inorder (tree\<^sub>d m') @ b # inorder r"
  13.531 +by(induct l a m' b r rule: node32.induct) auto
  13.532 +
  13.533 +lemma inorder_node33: "height m > 0 \<Longrightarrow>
  13.534 +  inorder (tree\<^sub>d (node33 l a m b r')) = inorder l @ a # inorder m @ b # inorder (tree\<^sub>d r')"
  13.535 +by(induct l a m b r' rule: node33.induct) auto
  13.536 +
  13.537 +lemmas inorder_nodes = inorder_node21 inorder_node22
  13.538 +  inorder_node31 inorder_node32 inorder_node33
  13.539 +
  13.540 +lemma del_minD:
  13.541 +  "del_min t = (x,t') \<Longrightarrow> bal t \<Longrightarrow> height t > 0 \<Longrightarrow>
  13.542 +  x # inorder(tree\<^sub>d t') = inorder t"
  13.543 +by(induction t arbitrary: t' rule: del_min.induct)
  13.544 +  (auto simp: inorder_nodes split: prod.splits)
  13.545 +
  13.546 +lemma inorder_del: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  13.547 +  inorder(tree\<^sub>d (del x t)) = del_list x (inorder t)"
  13.548 +by(induction t rule: del.induct)
  13.549 +  (auto simp: del_list_simps inorder_nodes del_minD split: prod.splits)
  13.550 +
  13.551 +lemma inorder_delete: "\<lbrakk> bal t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  13.552 +  inorder(delete x t) = del_list x (inorder t)"
  13.553 +by(simp add: delete_def inorder_del)
  13.554 +
  13.555 +
  13.556 +subsection \<open>Balancedness\<close>
  13.557 +
  13.558 +
  13.559 +subsubsection "Proofs for insert"
  13.560 +
  13.561 +text{* First a standard proof that @{const ins} preserves @{const bal}. *}
  13.562 +
  13.563 +instantiation up\<^sub>i :: (type)height
  13.564 +begin
  13.565 +
  13.566 +fun height_up\<^sub>i :: "'a up\<^sub>i \<Rightarrow> nat" where
  13.567 +"height (T\<^sub>i t) = height t" |
  13.568 +"height (Up\<^sub>i l a r) = height l"
  13.569 +
  13.570 +instance ..
  13.571 +
  13.572 +end
  13.573 +
  13.574 +lemma bal_ins: "bal t \<Longrightarrow> bal (tree\<^sub>i(ins a t)) \<and> height(ins a t) = height t"
  13.575 +by (induct t) (auto split: up\<^sub>i.split) (* 15 secs in 2015 *)
  13.576 +
  13.577 +text{* Now an alternative proof (by Brian Huffman) that runs faster because
  13.578 +two properties (balance and height) are combined in one predicate. *}
  13.579 +
  13.580 +inductive full :: "nat \<Rightarrow> 'a tree23 \<Rightarrow> bool" where
  13.581 +"full 0 Leaf" |
  13.582 +"\<lbrakk>full n l; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node2 l p r)" |
  13.583 +"\<lbrakk>full n l; full n m; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node3 l p m q r)"
  13.584 +
  13.585 +inductive_cases full_elims:
  13.586 +  "full n Leaf"
  13.587 +  "full n (Node2 l p r)"
  13.588 +  "full n (Node3 l p m q r)"
  13.589 +
  13.590 +inductive_cases full_0_elim: "full 0 t"
  13.591 +inductive_cases full_Suc_elim: "full (Suc n) t"
  13.592 +
  13.593 +lemma full_0_iff [simp]: "full 0 t \<longleftrightarrow> t = Leaf"
  13.594 +  by (auto elim: full_0_elim intro: full.intros)
  13.595 +
  13.596 +lemma full_Leaf_iff [simp]: "full n Leaf \<longleftrightarrow> n = 0"
  13.597 +  by (auto elim: full_elims intro: full.intros)
  13.598 +
  13.599 +lemma full_Suc_Node2_iff [simp]:
  13.600 +  "full (Suc n) (Node2 l p r) \<longleftrightarrow> full n l \<and> full n r"
  13.601 +  by (auto elim: full_elims intro: full.intros)
  13.602 +
  13.603 +lemma full_Suc_Node3_iff [simp]:
  13.604 +  "full (Suc n) (Node3 l p m q r) \<longleftrightarrow> full n l \<and> full n m \<and> full n r"
  13.605 +  by (auto elim: full_elims intro: full.intros)
  13.606 +
  13.607 +lemma full_imp_height: "full n t \<Longrightarrow> height t = n"
  13.608 +  by (induct set: full, simp_all)
  13.609 +
  13.610 +lemma full_imp_bal: "full n t \<Longrightarrow> bal t"
  13.611 +  by (induct set: full, auto dest: full_imp_height)
  13.612 +
  13.613 +lemma bal_imp_full: "bal t \<Longrightarrow> full (height t) t"
  13.614 +  by (induct t, simp_all)
  13.615 +
  13.616 +lemma bal_iff_full: "bal t \<longleftrightarrow> (\<exists>n. full n t)"
  13.617 +  by (auto elim!: bal_imp_full full_imp_bal)
  13.618 +
  13.619 +text {* The @{const "insert"} function either preserves the height of the
  13.620 +tree, or increases it by one. The constructor returned by the @{term
  13.621 +"insert"} function determines which: A return value of the form @{term
  13.622 +"T\<^sub>i t"} indicates that the height will be the same. A value of the
  13.623 +form @{term "Up\<^sub>i l p r"} indicates an increase in height. *}
  13.624 +
  13.625 +fun full\<^sub>i :: "nat \<Rightarrow> 'a up\<^sub>i \<Rightarrow> bool" where
  13.626 +"full\<^sub>i n (T\<^sub>i t) \<longleftrightarrow> full n t" |
  13.627 +"full\<^sub>i n (Up\<^sub>i l p r) \<longleftrightarrow> full n l \<and> full n r"
  13.628 +
  13.629 +lemma full\<^sub>i_ins: "full n t \<Longrightarrow> full\<^sub>i n (ins a t)"
  13.630 +by (induct rule: full.induct) (auto split: up\<^sub>i.split)
  13.631 +
  13.632 +text {* The @{const insert} operation preserves balance. *}
  13.633 +
  13.634 +lemma bal_insert: "bal t \<Longrightarrow> bal (insert a t)"
  13.635 +unfolding bal_iff_full insert_def
  13.636 +apply (erule exE)
  13.637 +apply (drule full\<^sub>i_ins [of _ _ a])
  13.638 +apply (cases "ins a t")
  13.639 +apply (auto intro: full.intros)
  13.640 +done
  13.641 +
  13.642 +
  13.643 +subsection "Proofs for delete"
  13.644 +
  13.645 +instantiation up\<^sub>d :: (type)height
  13.646 +begin
  13.647 +
  13.648 +fun height_up\<^sub>d :: "'a up\<^sub>d \<Rightarrow> nat" where
  13.649 +"height (T\<^sub>d t) = height t" |
  13.650 +"height (Up\<^sub>d t) = height t + 1"
  13.651 +
  13.652 +instance ..
  13.653 +
  13.654 +end
  13.655 +
  13.656 +lemma bal_tree\<^sub>d_node21:
  13.657 +  "\<lbrakk>bal r; bal (tree\<^sub>d l'); height r = height l' \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node21 l' a r))"
  13.658 +by(induct l' a r rule: node21.induct) auto
  13.659 +
  13.660 +lemma bal_tree\<^sub>d_node22:
  13.661 +  "\<lbrakk>bal(tree\<^sub>d r'); bal l; height r' = height l \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d (node22 l a r'))"
  13.662 +by(induct l a r' rule: node22.induct) auto
  13.663 +
  13.664 +lemma bal_tree\<^sub>d_node31:
  13.665 +  "\<lbrakk> bal (tree\<^sub>d l'); bal m; bal r; height l' = height r; height m = height r \<rbrakk>
  13.666 +  \<Longrightarrow> bal (tree\<^sub>d (node31 l' a m b r))"
  13.667 +by(induct l' a m b r rule: node31.induct) auto
  13.668 +
  13.669 +lemma bal_tree\<^sub>d_node32:
  13.670 +  "\<lbrakk> bal l; bal (tree\<^sub>d m'); bal r; height l = height r; height m' = height r \<rbrakk>
  13.671 +  \<Longrightarrow> bal (tree\<^sub>d (node32 l a m' b r))"
  13.672 +by(induct l a m' b r rule: node32.induct) auto
  13.673 +
  13.674 +lemma bal_tree\<^sub>d_node33:
  13.675 +  "\<lbrakk> bal l; bal m; bal(tree\<^sub>d r'); height l = height r'; height m = height r' \<rbrakk>
  13.676 +  \<Longrightarrow> bal (tree\<^sub>d (node33 l a m b r'))"
  13.677 +by(induct l a m b r' rule: node33.induct) auto
  13.678 +
  13.679 +lemmas bals = bal_tree\<^sub>d_node21 bal_tree\<^sub>d_node22
  13.680 +  bal_tree\<^sub>d_node31 bal_tree\<^sub>d_node32 bal_tree\<^sub>d_node33
  13.681 +
  13.682 +lemma height'_node21:
  13.683 +   "height r > 0 \<Longrightarrow> height(node21 l' a r) = max (height l') (height r) + 1"
  13.684 +by(induct l' a r rule: node21.induct)(simp_all)
  13.685 +
  13.686 +lemma height'_node22:
  13.687 +   "height l > 0 \<Longrightarrow> height(node22 l a r') = max (height l) (height r') + 1"
  13.688 +by(induct l a r' rule: node22.induct)(simp_all)
  13.689 +
  13.690 +lemma height'_node31:
  13.691 +  "height m > 0 \<Longrightarrow> height(node31 l a m b r) =
  13.692 +   max (height l) (max (height m) (height r)) + 1"
  13.693 +by(induct l a m b r rule: node31.induct)(simp_all add: max_def)
  13.694 +
  13.695 +lemma height'_node32:
  13.696 +  "height r > 0 \<Longrightarrow> height(node32 l a m b r) =
  13.697 +   max (height l) (max (height m) (height r)) + 1"
  13.698 +by(induct l a m b r rule: node32.induct)(simp_all add: max_def)
  13.699 +
  13.700 +lemma height'_node33:
  13.701 +  "height m > 0 \<Longrightarrow> height(node33 l a m b r) =
  13.702 +   max (height l) (max (height m) (height r)) + 1"
  13.703 +by(induct l a m b r rule: node33.induct)(simp_all add: max_def)
  13.704 +
  13.705 +lemmas heights = height'_node21 height'_node22
  13.706 +  height'_node31 height'_node32 height'_node33
  13.707 +
  13.708 +lemma height_del_min:
  13.709 +  "del_min t = (x, t') \<Longrightarrow> height t > 0 \<Longrightarrow> bal t \<Longrightarrow> height t' = height t"
  13.710 +by(induct t arbitrary: x t' rule: del_min.induct)
  13.711 +  (auto simp: heights split: prod.splits)
  13.712 +
  13.713 +lemma height_del: "bal t \<Longrightarrow> height(del x t) = height t"
  13.714 +by(induction x t rule: del.induct)
  13.715 +  (auto simp: heights max_def height_del_min split: prod.splits)
  13.716 +
  13.717 +lemma bal_del_min:
  13.718 +  "\<lbrakk> del_min t = (x, t'); bal t; height t > 0 \<rbrakk> \<Longrightarrow> bal (tree\<^sub>d t')"
  13.719 +by(induct t arbitrary: x t' rule: del_min.induct)
  13.720 +  (auto simp: heights height_del_min bals split: prod.splits)
  13.721 +
  13.722 +lemma bal_tree\<^sub>d_del: "bal t \<Longrightarrow> bal(tree\<^sub>d(del x t))"
  13.723 +by(induction x t rule: del.induct)
  13.724 +  (auto simp: bals bal_del_min height_del height_del_min split: prod.splits)
  13.725 +
  13.726 +corollary bal_delete: "bal t \<Longrightarrow> bal(delete x t)"
  13.727 +by(simp add: delete_def bal_tree\<^sub>d_del)
  13.728 +
  13.729 +
  13.730 +subsection \<open>Overall Correctness\<close>
  13.731 +
  13.732 +interpretation Set_by_Ordered
  13.733 +where empty = Leaf and isin = isin and insert = insert and delete = delete
  13.734 +and inorder = inorder and inv = bal
  13.735 +proof (standard, goal_cases)
  13.736 +  case 2 thus ?case by(simp add: isin_set)
  13.737 +next
  13.738 +  case 3 thus ?case by(simp add: inorder_insert)
  13.739 +next
  13.740 +  case 4 thus ?case by(simp add: inorder_delete)
  13.741 +next
  13.742 +  case 6 thus ?case by(simp add: bal_insert)
  13.743 +next
  13.744 +  case 7 thus ?case by(simp add: bal_delete)
  13.745 +qed simp+
  13.746 +
  13.747 +end
    14.1 --- a/src/HOL/Data_Structures/Tree_Map.thy	Wed Nov 11 16:42:30 2015 +0100
    14.2 +++ b/src/HOL/Data_Structures/Tree_Map.thy	Wed Nov 11 18:32:26 2015 +0100
    14.3 @@ -1,66 +1,66 @@
    14.4 -(* Author: Tobias Nipkow *)
    14.5 -
    14.6 -section {* Unbalanced Tree as Map *}
    14.7 -
    14.8 -theory Tree_Map
    14.9 -imports
   14.10 -  Tree_Set
   14.11 -  Map_by_Ordered
   14.12 -begin
   14.13 -
   14.14 -fun lookup :: "('a::cmp*'b) tree \<Rightarrow> 'a \<Rightarrow> 'b option" where
   14.15 -"lookup Leaf x = None" |
   14.16 -"lookup (Node l (a,b) r) x =
   14.17 -  (case cmp x a of LT \<Rightarrow> lookup l x | GT \<Rightarrow> lookup r x | EQ \<Rightarrow> Some b)"
   14.18 -
   14.19 -fun update :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
   14.20 -"update x y Leaf = Node Leaf (x,y) Leaf" |
   14.21 -"update x y (Node l (a,b) r) = (case cmp x a of
   14.22 -   LT \<Rightarrow> Node (update x y l) (a,b) r |
   14.23 -   EQ \<Rightarrow> Node l (x,y) r |
   14.24 -   GT \<Rightarrow> Node l (a,b) (update x y r))"
   14.25 -
   14.26 -fun delete :: "'a::cmp \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
   14.27 -"delete x Leaf = Leaf" |
   14.28 -"delete x (Node l (a,b) r) = (case cmp x a of
   14.29 -  LT \<Rightarrow> Node (delete x l) (a,b) r |
   14.30 -  GT \<Rightarrow> Node l (a,b) (delete x r) |
   14.31 -  EQ \<Rightarrow> if r = Leaf then l else let (ab',r') = del_min r in Node l ab' r')"
   14.32 -
   14.33 -
   14.34 -subsection "Functional Correctness Proofs"
   14.35 -
   14.36 -lemma lookup_eq:
   14.37 -  "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
   14.38 -by (induction t) (auto simp: map_of_simps split: option.split)
   14.39 -
   14.40 -
   14.41 -lemma inorder_update:
   14.42 -  "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
   14.43 -by(induction t) (auto simp: upd_list_simps)
   14.44 -
   14.45 -
   14.46 -lemma del_minD:
   14.47 -  "del_min t = (x,t') \<Longrightarrow> t \<noteq> Leaf \<Longrightarrow> sorted1(inorder t) \<Longrightarrow>
   14.48 -   x # inorder t' = inorder t"
   14.49 -by(induction t arbitrary: t' rule: del_min.induct)
   14.50 -  (auto simp: del_list_simps split: prod.splits)
   14.51 -
   14.52 -lemma inorder_delete:
   14.53 -  "sorted1(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
   14.54 -by(induction t) (auto simp: del_list_simps del_minD split: prod.splits)
   14.55 -
   14.56 -interpretation Map_by_Ordered
   14.57 -where empty = Leaf and lookup = lookup and update = update and delete = delete
   14.58 -and inorder = inorder and wf = "\<lambda>_. True"
   14.59 -proof (standard, goal_cases)
   14.60 -  case 1 show ?case by simp
   14.61 -next
   14.62 -  case 2 thus ?case by(simp add: lookup_eq)
   14.63 -next
   14.64 -  case 3 thus ?case by(simp add: inorder_update)
   14.65 -next
   14.66 -  case 4 thus ?case by(simp add: inorder_delete)
   14.67 -qed (rule TrueI)+
   14.68 -
   14.69 -end
   14.70 +(* Author: Tobias Nipkow *)
   14.71 +
   14.72 +section {* Unbalanced Tree as Map *}
   14.73 +
   14.74 +theory Tree_Map
   14.75 +imports
   14.76 +  Tree_Set
   14.77 +  Map_by_Ordered
   14.78 +begin
   14.79 +
   14.80 +fun lookup :: "('a::cmp*'b) tree \<Rightarrow> 'a \<Rightarrow> 'b option" where
   14.81 +"lookup Leaf x = None" |
   14.82 +"lookup (Node l (a,b) r) x =
   14.83 +  (case cmp x a of LT \<Rightarrow> lookup l x | GT \<Rightarrow> lookup r x | EQ \<Rightarrow> Some b)"
   14.84 +
   14.85 +fun update :: "'a::cmp \<Rightarrow> 'b \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
   14.86 +"update x y Leaf = Node Leaf (x,y) Leaf" |
   14.87 +"update x y (Node l (a,b) r) = (case cmp x a of
   14.88 +   LT \<Rightarrow> Node (update x y l) (a,b) r |
   14.89 +   EQ \<Rightarrow> Node l (x,y) r |
   14.90 +   GT \<Rightarrow> Node l (a,b) (update x y r))"
   14.91 +
   14.92 +fun delete :: "'a::cmp \<Rightarrow> ('a*'b) tree \<Rightarrow> ('a*'b) tree" where
   14.93 +"delete x Leaf = Leaf" |
   14.94 +"delete x (Node l (a,b) r) = (case cmp x a of
   14.95 +  LT \<Rightarrow> Node (delete x l) (a,b) r |
   14.96 +  GT \<Rightarrow> Node l (a,b) (delete x r) |
   14.97 +  EQ \<Rightarrow> if r = Leaf then l else let (ab',r') = del_min r in Node l ab' r')"
   14.98 +
   14.99 +
  14.100 +subsection "Functional Correctness Proofs"
  14.101 +
  14.102 +lemma lookup_eq:
  14.103 +  "sorted1(inorder t) \<Longrightarrow> lookup t x = map_of (inorder t) x"
  14.104 +by (induction t) (auto simp: map_of_simps split: option.split)
  14.105 +
  14.106 +
  14.107 +lemma inorder_update:
  14.108 +  "sorted1(inorder t) \<Longrightarrow> inorder(update a b t) = upd_list a b (inorder t)"
  14.109 +by(induction t) (auto simp: upd_list_simps)
  14.110 +
  14.111 +
  14.112 +lemma del_minD:
  14.113 +  "del_min t = (x,t') \<Longrightarrow> t \<noteq> Leaf \<Longrightarrow> sorted1(inorder t) \<Longrightarrow>
  14.114 +   x # inorder t' = inorder t"
  14.115 +by(induction t arbitrary: t' rule: del_min.induct)
  14.116 +  (auto simp: del_list_simps split: prod.splits)
  14.117 +
  14.118 +lemma inorder_delete:
  14.119 +  "sorted1(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
  14.120 +by(induction t) (auto simp: del_list_simps del_minD split: prod.splits)
  14.121 +
  14.122 +interpretation Map_by_Ordered
  14.123 +where empty = Leaf and lookup = lookup and update = update and delete = delete
  14.124 +and inorder = inorder and wf = "\<lambda>_. True"
  14.125 +proof (standard, goal_cases)
  14.126 +  case 1 show ?case by simp
  14.127 +next
  14.128 +  case 2 thus ?case by(simp add: lookup_eq)
  14.129 +next
  14.130 +  case 3 thus ?case by(simp add: inorder_update)
  14.131 +next
  14.132 +  case 4 thus ?case by(simp add: inorder_delete)
  14.133 +qed (rule TrueI)+
  14.134 +
  14.135 +end
    15.1 --- a/src/HOL/Data_Structures/Tree_Set.thy	Wed Nov 11 16:42:30 2015 +0100
    15.2 +++ b/src/HOL/Data_Structures/Tree_Set.thy	Wed Nov 11 18:32:26 2015 +0100
    15.3 @@ -1,75 +1,75 @@
    15.4 -(* Author: Tobias Nipkow *)
    15.5 -
    15.6 -section {* Tree Implementation of Sets *}
    15.7 -
    15.8 -theory Tree_Set
    15.9 -imports
   15.10 -  "~~/src/HOL/Library/Tree"
   15.11 -  Cmp
   15.12 -  Set_by_Ordered
   15.13 -begin
   15.14 -
   15.15 -fun isin :: "'a::cmp tree \<Rightarrow> 'a \<Rightarrow> bool" where
   15.16 -"isin Leaf x = False" |
   15.17 -"isin (Node l a r) x =
   15.18 -  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x)"
   15.19 -
   15.20 -hide_const (open) insert
   15.21 -
   15.22 -fun insert :: "'a::cmp \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
   15.23 -"insert x Leaf = Node Leaf x Leaf" |
   15.24 -"insert x (Node l a r) = (case cmp x a of
   15.25 -      LT \<Rightarrow> Node (insert x l) a r |
   15.26 -      EQ \<Rightarrow> Node l a r |
   15.27 -      GT \<Rightarrow> Node l a (insert x r))"
   15.28 -
   15.29 -fun del_min :: "'a tree \<Rightarrow> 'a * 'a tree" where
   15.30 -"del_min (Node Leaf a r) = (a, r)" |
   15.31 -"del_min (Node l a r) = (let (x,l') = del_min l in (x, Node l' a r))"
   15.32 -
   15.33 -fun delete :: "'a::cmp \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
   15.34 -"delete x Leaf = Leaf" |
   15.35 -"delete x (Node l a r) = (case cmp x a of
   15.36 -  LT \<Rightarrow>  Node (delete x l) a r |
   15.37 -  GT \<Rightarrow>  Node l a (delete x r) |
   15.38 -  EQ \<Rightarrow> if r = Leaf then l else let (a',r') = del_min r in Node l a' r')"
   15.39 -
   15.40 -
   15.41 -subsection "Functional Correctness Proofs"
   15.42 -
   15.43 -lemma "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
   15.44 -by (induction t) (auto simp: elems_simps1)
   15.45 -
   15.46 -lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
   15.47 -by (induction t) (auto simp: elems_simps2)
   15.48 -
   15.49 -
   15.50 -lemma inorder_insert:
   15.51 -  "sorted(inorder t) \<Longrightarrow> inorder(insert x t) = ins_list x (inorder t)"
   15.52 -by(induction t) (auto simp: ins_list_simps)
   15.53 -
   15.54 -
   15.55 -lemma del_minD:
   15.56 -  "del_min t = (x,t') \<Longrightarrow> t \<noteq> Leaf \<Longrightarrow> sorted(inorder t) \<Longrightarrow>
   15.57 -   x # inorder t' = inorder t"
   15.58 -by(induction t arbitrary: t' rule: del_min.induct)
   15.59 -  (auto simp: sorted_lems split: prod.splits)
   15.60 -
   15.61 -lemma inorder_delete:
   15.62 -  "sorted(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
   15.63 -by(induction t) (auto simp: del_list_simps del_minD split: prod.splits)
   15.64 -
   15.65 -interpretation Set_by_Ordered
   15.66 -where empty = Leaf and isin = isin and insert = insert and delete = delete
   15.67 -and inorder = inorder and inv = "\<lambda>_. True"
   15.68 -proof (standard, goal_cases)
   15.69 -  case 1 show ?case by simp
   15.70 -next
   15.71 -  case 2 thus ?case by(simp add: isin_set)
   15.72 -next
   15.73 -  case 3 thus ?case by(simp add: inorder_insert)
   15.74 -next
   15.75 -  case 4 thus ?case by(simp add: inorder_delete)
   15.76 -qed (rule TrueI)+
   15.77 -
   15.78 -end
   15.79 +(* Author: Tobias Nipkow *)
   15.80 +
   15.81 +section {* Tree Implementation of Sets *}
   15.82 +
   15.83 +theory Tree_Set
   15.84 +imports
   15.85 +  "~~/src/HOL/Library/Tree"
   15.86 +  Cmp
   15.87 +  Set_by_Ordered
   15.88 +begin
   15.89 +
   15.90 +fun isin :: "'a::cmp tree \<Rightarrow> 'a \<Rightarrow> bool" where
   15.91 +"isin Leaf x = False" |
   15.92 +"isin (Node l a r) x =
   15.93 +  (case cmp x a of LT \<Rightarrow> isin l x | EQ \<Rightarrow> True | GT \<Rightarrow> isin r x)"
   15.94 +
   15.95 +hide_const (open) insert
   15.96 +
   15.97 +fun insert :: "'a::cmp \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
   15.98 +"insert x Leaf = Node Leaf x Leaf" |
   15.99 +"insert x (Node l a r) = (case cmp x a of
  15.100 +      LT \<Rightarrow> Node (insert x l) a r |
  15.101 +      EQ \<Rightarrow> Node l a r |
  15.102 +      GT \<Rightarrow> Node l a (insert x r))"
  15.103 +
  15.104 +fun del_min :: "'a tree \<Rightarrow> 'a * 'a tree" where
  15.105 +"del_min (Node Leaf a r) = (a, r)" |
  15.106 +"del_min (Node l a r) = (let (x,l') = del_min l in (x, Node l' a r))"
  15.107 +
  15.108 +fun delete :: "'a::cmp \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
  15.109 +"delete x Leaf = Leaf" |
  15.110 +"delete x (Node l a r) = (case cmp x a of
  15.111 +  LT \<Rightarrow>  Node (delete x l) a r |
  15.112 +  GT \<Rightarrow>  Node l a (delete x r) |
  15.113 +  EQ \<Rightarrow> if r = Leaf then l else let (a',r') = del_min r in Node l a' r')"
  15.114 +
  15.115 +
  15.116 +subsection "Functional Correctness Proofs"
  15.117 +
  15.118 +lemma "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  15.119 +by (induction t) (auto simp: elems_simps1)
  15.120 +
  15.121 +lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> elems (inorder t))"
  15.122 +by (induction t) (auto simp: elems_simps2)
  15.123 +
  15.124 +
  15.125 +lemma inorder_insert:
  15.126 +  "sorted(inorder t) \<Longrightarrow> inorder(insert x t) = ins_list x (inorder t)"
  15.127 +by(induction t) (auto simp: ins_list_simps)
  15.128 +
  15.129 +
  15.130 +lemma del_minD:
  15.131 +  "del_min t = (x,t') \<Longrightarrow> t \<noteq> Leaf \<Longrightarrow> sorted(inorder t) \<Longrightarrow>
  15.132 +   x # inorder t' = inorder t"
  15.133 +by(induction t arbitrary: t' rule: del_min.induct)
  15.134 +  (auto simp: sorted_lems split: prod.splits)
  15.135 +
  15.136 +lemma inorder_delete:
  15.137 +  "sorted(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"
  15.138 +by(induction t) (auto simp: del_list_simps del_minD split: prod.splits)
  15.139 +
  15.140 +interpretation Set_by_Ordered
  15.141 +where empty = Leaf and isin = isin and insert = insert and delete = delete
  15.142 +and inorder = inorder and inv = "\<lambda>_. True"
  15.143 +proof (standard, goal_cases)
  15.144 +  case 1 show ?case by simp
  15.145 +next
  15.146 +  case 2 thus ?case by(simp add: isin_set)
  15.147 +next
  15.148 +  case 3 thus ?case by(simp add: inorder_insert)
  15.149 +next
  15.150 +  case 4 thus ?case by(simp add: inorder_delete)
  15.151 +qed (rule TrueI)+
  15.152 +
  15.153 +end