summary |
shortlog |
changelog |
graph |
tags |
branches |
files |
changeset |
file |
revisions |
annotate |
diff |
raw

src/HOL/Library/More_List.thy

changeset 45990 | b7b905b23b2a |

parent 45989 | b39256df5f8a |

child 45991 | 3289ac99d714 |

1.1 --- a/src/HOL/Library/More_List.thy Mon Dec 26 22:17:10 2011 +0100 1.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 1.3 @@ -1,312 +0,0 @@ 1.4 -(* Author: Florian Haftmann, TU Muenchen *) 1.5 - 1.6 -header {* Operations on lists beyond the standard List theory *} 1.7 - 1.8 -theory More_List 1.9 -imports Main Multiset 1.10 -begin 1.11 - 1.12 -hide_const (open) Finite_Set.fold 1.13 - 1.14 -text {* Repairing code generator setup *} 1.15 - 1.16 -declare (in lattice) Inf_fin_set_fold [code_unfold del] 1.17 -declare (in lattice) Sup_fin_set_fold [code_unfold del] 1.18 -declare (in linorder) Min_fin_set_fold [code_unfold del] 1.19 -declare (in linorder) Max_fin_set_fold [code_unfold del] 1.20 -declare (in complete_lattice) Inf_set_fold [code_unfold del] 1.21 -declare (in complete_lattice) Sup_set_fold [code_unfold del] 1.22 - 1.23 - 1.24 -text {* Fold combinator with canonical argument order *} 1.25 - 1.26 -primrec fold :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where 1.27 - "fold f [] = id" 1.28 - | "fold f (x # xs) = fold f xs \<circ> f x" 1.29 - 1.30 -lemma foldl_fold: 1.31 - "foldl f s xs = fold (\<lambda>x s. f s x) xs s" 1.32 - by (induct xs arbitrary: s) simp_all 1.33 - 1.34 -lemma foldr_fold_rev: 1.35 - "foldr f xs = fold f (rev xs)" 1.36 - by (simp add: foldr_foldl foldl_fold fun_eq_iff) 1.37 - 1.38 -lemma fold_rev_conv [code_unfold]: 1.39 - "fold f (rev xs) = foldr f xs" 1.40 - by (simp add: foldr_fold_rev) 1.41 - 1.42 -lemma fold_cong [fundef_cong]: 1.43 - "a = b \<Longrightarrow> xs = ys \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> f x = g x) 1.44 - \<Longrightarrow> fold f xs a = fold g ys b" 1.45 - by (induct ys arbitrary: a b xs) simp_all 1.46 - 1.47 -lemma fold_id: 1.48 - assumes "\<And>x. x \<in> set xs \<Longrightarrow> f x = id" 1.49 - shows "fold f xs = id" 1.50 - using assms by (induct xs) simp_all 1.51 - 1.52 -lemma fold_commute: 1.53 - assumes "\<And>x. x \<in> set xs \<Longrightarrow> h \<circ> g x = f x \<circ> h" 1.54 - shows "h \<circ> fold g xs = fold f xs \<circ> h" 1.55 - using assms by (induct xs) (simp_all add: fun_eq_iff) 1.56 - 1.57 -lemma fold_commute_apply: 1.58 - assumes "\<And>x. x \<in> set xs \<Longrightarrow> h \<circ> g x = f x \<circ> h" 1.59 - shows "h (fold g xs s) = fold f xs (h s)" 1.60 -proof - 1.61 - from assms have "h \<circ> fold g xs = fold f xs \<circ> h" by (rule fold_commute) 1.62 - then show ?thesis by (simp add: fun_eq_iff) 1.63 -qed 1.64 - 1.65 -lemma fold_invariant: 1.66 - assumes "\<And>x. x \<in> set xs \<Longrightarrow> Q x" and "P s" 1.67 - and "\<And>x s. Q x \<Longrightarrow> P s \<Longrightarrow> P (f x s)" 1.68 - shows "P (fold f xs s)" 1.69 - using assms by (induct xs arbitrary: s) simp_all 1.70 - 1.71 -lemma fold_weak_invariant: 1.72 - assumes "P s" 1.73 - and "\<And>s x. x \<in> set xs \<Longrightarrow> P s \<Longrightarrow> P (f x s)" 1.74 - shows "P (fold f xs s)" 1.75 - using assms by (induct xs arbitrary: s) simp_all 1.76 - 1.77 -lemma fold_append [simp]: 1.78 - "fold f (xs @ ys) = fold f ys \<circ> fold f xs" 1.79 - by (induct xs) simp_all 1.80 - 1.81 -lemma fold_map [code_unfold]: 1.82 - "fold g (map f xs) = fold (g o f) xs" 1.83 - by (induct xs) simp_all 1.84 - 1.85 -lemma fold_remove1_split: 1.86 - assumes f: "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f x \<circ> f y = f y \<circ> f x" 1.87 - and x: "x \<in> set xs" 1.88 - shows "fold f xs = fold f (remove1 x xs) \<circ> f x" 1.89 - using assms by (induct xs) (auto simp add: o_assoc [symmetric]) 1.90 - 1.91 -lemma fold_multiset_equiv: 1.92 - assumes f: "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f x \<circ> f y = f y \<circ> f x" 1.93 - and equiv: "multiset_of xs = multiset_of ys" 1.94 - shows "fold f xs = fold f ys" 1.95 -using f equiv [symmetric] proof (induct xs arbitrary: ys) 1.96 - case Nil then show ?case by simp 1.97 -next 1.98 - case (Cons x xs) 1.99 - then have *: "set ys = set (x # xs)" by (blast dest: multiset_of_eq_setD) 1.100 - have "\<And>x y. x \<in> set ys \<Longrightarrow> y \<in> set ys \<Longrightarrow> f x \<circ> f y = f y \<circ> f x" 1.101 - by (rule Cons.prems(1)) (simp_all add: *) 1.102 - moreover from * have "x \<in> set ys" by simp 1.103 - ultimately have "fold f ys = fold f (remove1 x ys) \<circ> f x" by (fact fold_remove1_split) 1.104 - moreover from Cons.prems have "fold f xs = fold f (remove1 x ys)" by (auto intro: Cons.hyps) 1.105 - ultimately show ?case by simp 1.106 -qed 1.107 - 1.108 -lemma fold_rev: 1.109 - assumes "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y" 1.110 - shows "fold f (rev xs) = fold f xs" 1.111 - by (rule fold_multiset_equiv, rule assms) (simp_all add: in_multiset_in_set) 1.112 - 1.113 -lemma foldr_fold: 1.114 - assumes "\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y" 1.115 - shows "foldr f xs = fold f xs" 1.116 - using assms unfolding foldr_fold_rev by (rule fold_rev) 1.117 - 1.118 -lemma fold_Cons_rev: 1.119 - "fold Cons xs = append (rev xs)" 1.120 - by (induct xs) simp_all 1.121 - 1.122 -lemma rev_conv_fold [code]: 1.123 - "rev xs = fold Cons xs []" 1.124 - by (simp add: fold_Cons_rev) 1.125 - 1.126 -lemma fold_append_concat_rev: 1.127 - "fold append xss = append (concat (rev xss))" 1.128 - by (induct xss) simp_all 1.129 - 1.130 -lemma concat_conv_foldr [code]: 1.131 - "concat xss = foldr append xss []" 1.132 - by (simp add: fold_append_concat_rev foldr_fold_rev) 1.133 - 1.134 -lemma fold_plus_listsum_rev: 1.135 - "fold plus xs = plus (listsum (rev xs))" 1.136 - by (induct xs) (simp_all add: add.assoc) 1.137 - 1.138 -lemma (in monoid_add) listsum_conv_fold [code]: 1.139 - "listsum xs = fold (\<lambda>x y. y + x) xs 0" 1.140 - by (auto simp add: listsum_foldl foldl_fold fun_eq_iff) 1.141 - 1.142 -lemma (in linorder) sort_key_conv_fold: 1.143 - assumes "inj_on f (set xs)" 1.144 - shows "sort_key f xs = fold (insort_key f) xs []" 1.145 -proof - 1.146 - have "fold (insort_key f) (rev xs) = fold (insort_key f) xs" 1.147 - proof (rule fold_rev, rule ext) 1.148 - fix zs 1.149 - fix x y 1.150 - assume "x \<in> set xs" "y \<in> set xs" 1.151 - with assms have *: "f y = f x \<Longrightarrow> y = x" by (auto dest: inj_onD) 1.152 - have **: "x = y \<longleftrightarrow> y = x" by auto 1.153 - show "(insort_key f y \<circ> insort_key f x) zs = (insort_key f x \<circ> insort_key f y) zs" 1.154 - by (induct zs) (auto intro: * simp add: **) 1.155 - qed 1.156 - then show ?thesis by (simp add: sort_key_def foldr_fold_rev) 1.157 -qed 1.158 - 1.159 -lemma (in linorder) sort_conv_fold: 1.160 - "sort xs = fold insort xs []" 1.161 - by (rule sort_key_conv_fold) simp 1.162 - 1.163 - 1.164 -text {* @{const Finite_Set.fold} and @{const fold} *} 1.165 - 1.166 -lemma (in comp_fun_commute) fold_set_remdups: 1.167 - "Finite_Set.fold f y (set xs) = fold f (remdups xs) y" 1.168 - by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_comm insert_absorb) 1.169 - 1.170 -lemma (in comp_fun_idem) fold_set: 1.171 - "Finite_Set.fold f y (set xs) = fold f xs y" 1.172 - by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_comm) 1.173 - 1.174 -lemma (in ab_semigroup_idem_mult) fold1_set: 1.175 - assumes "xs \<noteq> []" 1.176 - shows "Finite_Set.fold1 times (set xs) = fold times (tl xs) (hd xs)" 1.177 -proof - 1.178 - interpret comp_fun_idem times by (fact comp_fun_idem) 1.179 - from assms obtain y ys where xs: "xs = y # ys" 1.180 - by (cases xs) auto 1.181 - show ?thesis 1.182 - proof (cases "set ys = {}") 1.183 - case True with xs show ?thesis by simp 1.184 - next 1.185 - case False 1.186 - then have "fold1 times (insert y (set ys)) = Finite_Set.fold times y (set ys)" 1.187 - by (simp only: finite_set fold1_eq_fold_idem) 1.188 - with xs show ?thesis by (simp add: fold_set mult_commute) 1.189 - qed 1.190 -qed 1.191 - 1.192 -lemma (in lattice) Inf_fin_set_fold: 1.193 - "Inf_fin (set (x # xs)) = fold inf xs x" 1.194 -proof - 1.195 - interpret ab_semigroup_idem_mult "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" 1.196 - by (fact ab_semigroup_idem_mult_inf) 1.197 - show ?thesis 1.198 - by (simp add: Inf_fin_def fold1_set del: set.simps) 1.199 -qed 1.200 - 1.201 -lemma (in lattice) Inf_fin_set_foldr [code_unfold]: 1.202 - "Inf_fin (set (x # xs)) = foldr inf xs x" 1.203 - by (simp add: Inf_fin_set_fold ac_simps foldr_fold fun_eq_iff del: set.simps) 1.204 - 1.205 -lemma (in lattice) Sup_fin_set_fold: 1.206 - "Sup_fin (set (x # xs)) = fold sup xs x" 1.207 -proof - 1.208 - interpret ab_semigroup_idem_mult "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" 1.209 - by (fact ab_semigroup_idem_mult_sup) 1.210 - show ?thesis 1.211 - by (simp add: Sup_fin_def fold1_set del: set.simps) 1.212 -qed 1.213 - 1.214 -lemma (in lattice) Sup_fin_set_foldr [code_unfold]: 1.215 - "Sup_fin (set (x # xs)) = foldr sup xs x" 1.216 - by (simp add: Sup_fin_set_fold ac_simps foldr_fold fun_eq_iff del: set.simps) 1.217 - 1.218 -lemma (in linorder) Min_fin_set_fold: 1.219 - "Min (set (x # xs)) = fold min xs x" 1.220 -proof - 1.221 - interpret ab_semigroup_idem_mult "min :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" 1.222 - by (fact ab_semigroup_idem_mult_min) 1.223 - show ?thesis 1.224 - by (simp add: Min_def fold1_set del: set.simps) 1.225 -qed 1.226 - 1.227 -lemma (in linorder) Min_fin_set_foldr [code_unfold]: 1.228 - "Min (set (x # xs)) = foldr min xs x" 1.229 - by (simp add: Min_fin_set_fold ac_simps foldr_fold fun_eq_iff del: set.simps) 1.230 - 1.231 -lemma (in linorder) Max_fin_set_fold: 1.232 - "Max (set (x # xs)) = fold max xs x" 1.233 -proof - 1.234 - interpret ab_semigroup_idem_mult "max :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" 1.235 - by (fact ab_semigroup_idem_mult_max) 1.236 - show ?thesis 1.237 - by (simp add: Max_def fold1_set del: set.simps) 1.238 -qed 1.239 - 1.240 -lemma (in linorder) Max_fin_set_foldr [code_unfold]: 1.241 - "Max (set (x # xs)) = foldr max xs x" 1.242 - by (simp add: Max_fin_set_fold ac_simps foldr_fold fun_eq_iff del: set.simps) 1.243 - 1.244 -lemma (in complete_lattice) Inf_set_fold: 1.245 - "Inf (set xs) = fold inf xs top" 1.246 -proof - 1.247 - interpret comp_fun_idem "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" 1.248 - by (fact comp_fun_idem_inf) 1.249 - show ?thesis by (simp add: Inf_fold_inf fold_set inf_commute) 1.250 -qed 1.251 - 1.252 -lemma (in complete_lattice) Inf_set_foldr [code_unfold]: 1.253 - "Inf (set xs) = foldr inf xs top" 1.254 - by (simp add: Inf_set_fold ac_simps foldr_fold fun_eq_iff) 1.255 - 1.256 -lemma (in complete_lattice) Sup_set_fold: 1.257 - "Sup (set xs) = fold sup xs bot" 1.258 -proof - 1.259 - interpret comp_fun_idem "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a" 1.260 - by (fact comp_fun_idem_sup) 1.261 - show ?thesis by (simp add: Sup_fold_sup fold_set sup_commute) 1.262 -qed 1.263 - 1.264 -lemma (in complete_lattice) Sup_set_foldr [code_unfold]: 1.265 - "Sup (set xs) = foldr sup xs bot" 1.266 - by (simp add: Sup_set_fold ac_simps foldr_fold fun_eq_iff) 1.267 - 1.268 -lemma (in complete_lattice) INFI_set_fold: 1.269 - "INFI (set xs) f = fold (inf \<circ> f) xs top" 1.270 - unfolding INF_def set_map [symmetric] Inf_set_fold fold_map .. 1.271 - 1.272 -lemma (in complete_lattice) SUPR_set_fold: 1.273 - "SUPR (set xs) f = fold (sup \<circ> f) xs bot" 1.274 - unfolding SUP_def set_map [symmetric] Sup_set_fold fold_map .. 1.275 - 1.276 - 1.277 -text {* @{text nth_map} *} 1.278 - 1.279 -definition nth_map :: "nat \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> 'a list \<Rightarrow> 'a list" where 1.280 - "nth_map n f xs = (if n < length xs then 1.281 - take n xs @ [f (xs ! n)] @ drop (Suc n) xs 1.282 - else xs)" 1.283 - 1.284 -lemma nth_map_id: 1.285 - "n \<ge> length xs \<Longrightarrow> nth_map n f xs = xs" 1.286 - by (simp add: nth_map_def) 1.287 - 1.288 -lemma nth_map_unfold: 1.289 - "n < length xs \<Longrightarrow> nth_map n f xs = take n xs @ [f (xs ! n)] @ drop (Suc n) xs" 1.290 - by (simp add: nth_map_def) 1.291 - 1.292 -lemma nth_map_Nil [simp]: 1.293 - "nth_map n f [] = []" 1.294 - by (simp add: nth_map_def) 1.295 - 1.296 -lemma nth_map_zero [simp]: 1.297 - "nth_map 0 f (x # xs) = f x # xs" 1.298 - by (simp add: nth_map_def) 1.299 - 1.300 -lemma nth_map_Suc [simp]: 1.301 - "nth_map (Suc n) f (x # xs) = x # nth_map n f xs" 1.302 - by (simp add: nth_map_def) 1.303 - 1.304 - 1.305 -text {* monad operation *} 1.306 - 1.307 -definition bind :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b list) \<Rightarrow> 'b list" where 1.308 - "bind xs f = concat (map f xs)" 1.309 - 1.310 -lemma bind_simps [simp]: 1.311 - "bind [] f = []" 1.312 - "bind (x # xs) f = f x @ bind xs f" 1.313 - by (simp_all add: bind_def) 1.314 - 1.315 -end