changeset 53721 | ccaceea6c768 |
parent 53689 | 705f0b728b1b |
child 53940 | 36cf426cb1c6 |
53720:03fac7082137 | 53721:ccaceea6c768 |
---|---|
144 "product [] _ = []" | |
144 "product [] _ = []" | |
145 "product (x#xs) ys = map (Pair x) ys @ product xs ys" |
145 "product (x#xs) ys = map (Pair x) ys @ product xs ys" |
146 |
146 |
147 hide_const (open) product |
147 hide_const (open) product |
148 |
148 |
149 primrec product_lists :: "'a list list \<Rightarrow> 'a list list" where |
|
150 "product_lists [] = [[]]" | |
|
151 "product_lists (xs # xss) = concat (map (\<lambda>x. map (Cons x) (product_lists xss)) xs)" |
|
152 |
|
149 primrec upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where |
153 primrec upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where |
150 upt_0: "[i..<0] = []" | |
154 upt_0: "[i..<0] = []" | |
151 upt_Suc: "[i..<(Suc j)] = (if i <= j then [i..<j] @ [j] else [])" |
155 upt_Suc: "[i..<(Suc j)] = (if i <= j then [i..<j] @ [j] else [])" |
152 |
156 |
153 definition insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
157 definition insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where |
182 "distinct (x # xs) \<longleftrightarrow> x \<notin> set xs \<and> distinct xs" |
186 "distinct (x # xs) \<longleftrightarrow> x \<notin> set xs \<and> distinct xs" |
183 |
187 |
184 primrec remdups :: "'a list \<Rightarrow> 'a list" where |
188 primrec remdups :: "'a list \<Rightarrow> 'a list" where |
185 "remdups [] = []" | |
189 "remdups [] = []" | |
186 "remdups (x # xs) = (if x \<in> set xs then remdups xs else x # remdups xs)" |
190 "remdups (x # xs) = (if x \<in> set xs then remdups xs else x # remdups xs)" |
191 |
|
192 fun remdups_adj :: "'a list \<Rightarrow> 'a list" where |
|
193 "remdups_adj [] = []" | |
|
194 "remdups_adj [x] = [x]" | |
|
195 "remdups_adj (x # y # xs) = (if x = y then remdups_adj (x # xs) else x # remdups_adj (y # xs))" |
|
187 |
196 |
188 primrec replicate :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
197 primrec replicate :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where |
189 replicate_0: "replicate 0 x = []" | |
198 replicate_0: "replicate 0 x = []" | |
190 replicate_Suc: "replicate (Suc n) x = x # replicate n x" |
199 replicate_Suc: "replicate (Suc n) x = x # replicate n x" |
191 |
200 |
248 @{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\ |
257 @{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\ |
249 @{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\ |
258 @{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\ |
250 @{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\ |
259 @{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\ |
251 @{lemma "enumerate 3 [a,b,c] = [(3,a),(4,b),(5,c)]" by normalization}\\ |
260 @{lemma "enumerate 3 [a,b,c] = [(3,a),(4,b),(5,c)]" by normalization}\\ |
252 @{lemma "List.product [a,b] [c,d] = [(a, c), (a, d), (b, c), (b, d)]" by simp}\\ |
261 @{lemma "List.product [a,b] [c,d] = [(a, c), (a, d), (b, c), (b, d)]" by simp}\\ |
262 @{lemma "product_lists [[a,b], [c], [d,e]] = [[a,c,d], [a,c,e], [b,c,d], [b,c,e]]" by simp}\\ |
|
253 @{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\ |
263 @{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\ |
254 @{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\ |
264 @{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\ |
255 @{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\ |
265 @{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\ |
256 @{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\ |
266 @{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\ |
257 @{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\ |
267 @{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\ |
258 @{lemma "drop 6 [a,b,c,d] = []" by simp}\\ |
268 @{lemma "drop 6 [a,b,c,d] = []" by simp}\\ |
259 @{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\ |
269 @{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\ |
260 @{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\ |
270 @{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\ |
261 @{lemma "distinct [2,0,1::nat]" by simp}\\ |
271 @{lemma "distinct [2,0,1::nat]" by simp}\\ |
262 @{lemma "remdups [2,0,2,1::nat,2] = [0,1,2]" by simp}\\ |
272 @{lemma "remdups [2,0,2,1::nat,2] = [0,1,2]" by simp}\\ |
273 @{lemma "remdups_adj [2,2,3,1,1::nat,2,1] = [2,3,1,2,1]" by simp}\\ |
|
263 @{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\ |
274 @{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\ |
264 @{lemma "List.insert 3 [0::nat,1,2] = [3,0,1,2]" by (simp add: List.insert_def)}\\ |
275 @{lemma "List.insert 3 [0::nat,1,2] = [3,0,1,2]" by (simp add: List.insert_def)}\\ |
265 @{lemma "List.find (%i::int. i>0) [0,0] = None" by simp}\\ |
276 @{lemma "List.find (%i::int. i>0) [0,0] = None" by simp}\\ |
266 @{lemma "List.find (%i::int. i>0) [0,1,0,2] = Some 1" by simp}\\ |
277 @{lemma "List.find (%i::int. i>0) [0,1,0,2] = Some 1" by simp}\\ |
267 @{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\ |
278 @{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\ |
2661 lemma list_eq_iff_zip_eq: |
2672 lemma list_eq_iff_zip_eq: |
2662 "xs = ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>(x,y) \<in> set (zip xs ys). x = y)" |
2673 "xs = ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>(x,y) \<in> set (zip xs ys). x = y)" |
2663 by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong) |
2674 by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong) |
2664 |
2675 |
2665 |
2676 |
2666 subsubsection {* @{const List.product} *} |
2677 subsubsection {* @{const List.product} and @{const product_lists} *} |
2667 |
2678 |
2668 lemma product_list_set: |
2679 lemma product_list_set: |
2669 "set (List.product xs ys) = set xs \<times> set ys" |
2680 "set (List.product xs ys) = set xs \<times> set ys" |
2670 by (induct xs) auto |
2681 by (induct xs) auto |
2671 |
2682 |
2681 next |
2692 next |
2682 case (Cons x xs n) |
2693 case (Cons x xs n) |
2683 then have "length ys > 0" by auto |
2694 then have "length ys > 0" by auto |
2684 with Cons show ?case |
2695 with Cons show ?case |
2685 by (auto simp add: nth_append not_less le_mod_geq le_div_geq) |
2696 by (auto simp add: nth_append not_less le_mod_geq le_div_geq) |
2697 qed |
|
2698 |
|
2699 lemma in_set_product_lists_length: |
|
2700 "xs \<in> set (product_lists xss) \<Longrightarrow> length xs = length xss" |
|
2701 by (induct xss arbitrary: xs) auto |
|
2702 |
|
2703 lemma product_lists_set: |
|
2704 "set (product_lists xss) = {xs. list_all2 (\<lambda>x ys. x \<in> set ys) xs xss}" (is "?L = Collect ?R") |
|
2705 proof (intro equalityI subsetI, unfold mem_Collect_eq) |
|
2706 fix xs assume "xs \<in> ?L" |
|
2707 then have "length xs = length xss" by (rule in_set_product_lists_length) |
|
2708 from this `xs \<in> ?L` show "?R xs" by (induct xs xss rule: list_induct2) auto |
|
2709 next |
|
2710 fix xs assume "?R xs" |
|
2711 then show "xs \<in> ?L" by induct auto |
|
2686 qed |
2712 qed |
2687 |
2713 |
2688 |
2714 |
2689 subsubsection {* @{const fold} with natural argument order *} |
2715 subsubsection {* @{const fold} with natural argument order *} |
2690 |
2716 |
3083 |
3109 |
3084 lemma upto_code[code]: "[i..j] = upto_aux i j []" |
3110 lemma upto_code[code]: "[i..j] = upto_aux i j []" |
3085 by(simp add: upto_aux_def) |
3111 by(simp add: upto_aux_def) |
3086 |
3112 |
3087 |
3113 |
3088 subsubsection {* @{const distinct} and @{const remdups} *} |
3114 subsubsection {* @{const distinct} and @{const remdups} and @{const remdups_adj} *} |
3089 |
3115 |
3090 lemma distinct_tl: |
3116 lemma distinct_tl: |
3091 "distinct xs \<Longrightarrow> distinct (tl xs)" |
3117 "distinct xs \<Longrightarrow> distinct (tl xs)" |
3092 by (cases xs) simp_all |
3118 by (cases xs) simp_all |
3093 |
3119 |
3278 assumes "distinct xs" and "distinct ys" |
3304 assumes "distinct xs" and "distinct ys" |
3279 shows "distinct (List.product xs ys)" |
3305 shows "distinct (List.product xs ys)" |
3280 using assms by (induct xs) |
3306 using assms by (induct xs) |
3281 (auto intro: inj_onI simp add: product_list_set distinct_map) |
3307 (auto intro: inj_onI simp add: product_list_set distinct_map) |
3282 |
3308 |
3309 lemma distinct_product_lists: |
|
3310 assumes "\<forall>xs \<in> set xss. distinct xs" |
|
3311 shows "distinct (product_lists xss)" |
|
3312 using assms proof (induction xss) |
|
3313 case (Cons xs xss) note * = this |
|
3314 then show ?case |
|
3315 proof (cases "product_lists xss") |
|
3316 case Nil then show ?thesis by (induct xs) simp_all |
|
3317 next |
|
3318 case (Cons ps pss) with * show ?thesis |
|
3319 by (auto intro!: inj_onI distinct_concat simp add: distinct_map) |
|
3320 qed |
|
3321 qed simp |
|
3322 |
|
3283 lemma length_remdups_concat: |
3323 lemma length_remdups_concat: |
3284 "length (remdups (concat xss)) = card (\<Union>xs\<in>set xss. set xs)" |
3324 "length (remdups (concat xss)) = card (\<Union>xs\<in>set xss. set xs)" |
3285 by (simp add: distinct_card [symmetric]) |
3325 by (simp add: distinct_card [symmetric]) |
3286 |
3326 |
3287 lemma length_remdups_card_conv: "length(remdups xs) = card(set xs)" |
3327 lemma length_remdups_card_conv: "length(remdups xs) = card(set xs)" |
3341 |
3381 |
3342 lemma distinct_length_2_or_more: |
3382 lemma distinct_length_2_or_more: |
3343 "distinct (a # b # xs) \<longleftrightarrow> (a \<noteq> b \<and> distinct (a # xs) \<and> distinct (b # xs))" |
3383 "distinct (a # b # xs) \<longleftrightarrow> (a \<noteq> b \<and> distinct (a # xs) \<and> distinct (b # xs))" |
3344 by (metis distinct.simps(2) hd.simps hd_in_set list.simps(2) set_ConsD set_rev_mp set_subset_Cons) |
3384 by (metis distinct.simps(2) hd.simps hd_in_set list.simps(2) set_ConsD set_rev_mp set_subset_Cons) |
3345 |
3385 |
3386 lemma remdups_adj_Cons: "remdups_adj (x # xs) = |
|
3387 (case remdups_adj xs of [] \<Rightarrow> [x] | y # xs \<Rightarrow> if x = y then y # xs else x # y # xs)" |
|
3388 by (induct xs arbitrary: x) (auto split: list.splits) |
|
3389 |
|
3390 lemma remdups_adj_append_two: |
|
3391 "remdups_adj (xs @ [x,y]) = remdups_adj (xs @ [x]) @ (if x = y then [] else [y])" |
|
3392 by (induct xs rule: remdups_adj.induct, simp_all) |
|
3393 |
|
3394 lemma remdups_adj_rev[simp]: "remdups_adj (rev xs) = rev (remdups_adj xs)" |
|
3395 by (induct xs rule: remdups_adj.induct, simp_all add: remdups_adj_append_two) |
|
3396 |
|
3397 lemma remdups_adj_length[simp]: "length (remdups_adj xs) \<le> length xs" |
|
3398 by (induct xs rule: remdups_adj.induct, auto) |
|
3399 |
|
3400 lemma remdups_adj_length_ge1[simp]: "xs \<noteq> [] \<Longrightarrow> length (remdups_adj xs) \<ge> Suc 0" |
|
3401 by (induct xs rule: remdups_adj.induct, simp_all) |
|
3402 |
|
3403 lemma remdups_adj_Nil_iff[simp]: "remdups_adj xs = [] \<longleftrightarrow> xs = []" |
|
3404 by (induct xs rule: remdups_adj.induct, simp_all) |
|
3405 |
|
3406 lemma remdups_adj_set[simp]: "set (remdups_adj xs) = set xs" |
|
3407 by (induct xs rule: remdups_adj.induct, simp_all) |
|
3408 |
|
3409 lemma remdups_adj_Cons_alt[simp]: "x # tl (remdups_adj (x # xs)) = remdups_adj (x # xs)" |
|
3410 by (induct xs rule: remdups_adj.induct, auto) |
|
3411 |
|
3412 lemma remdups_adj_distinct: "distinct xs \<Longrightarrow> remdups_adj xs = xs" |
|
3413 by (induct xs rule: remdups_adj.induct, simp_all) |
|
3414 |
|
3415 lemma remdups_adj_append: |
|
3416 "remdups_adj (xs\<^sub>1 @ x # xs\<^sub>2) = remdups_adj (xs\<^sub>1 @ [x]) @ tl (remdups_adj (x # xs\<^sub>2))" |
|
3417 by (induct xs\<^sub>1 rule: remdups_adj.induct, simp_all) |
|
3418 |
|
3419 lemma remdups_adj_singleton: |
|
3420 "remdups_adj xs = [x] \<Longrightarrow> xs = replicate (length xs) x" |
|
3421 by (induct xs rule: remdups_adj.induct, auto split: split_if_asm) |
|
3422 |
|
3423 lemma remdups_adj_map_injective: |
|
3424 assumes "inj f" |
|
3425 shows "remdups_adj (map f xs) = map f (remdups_adj xs)" |
|
3426 by (induct xs rule: remdups_adj.induct, |
|
3427 auto simp add: injD[OF assms]) |
|
3428 |
|
3346 |
3429 |
3347 subsubsection {* List summation: @{const listsum} and @{text"\<Sum>"}*} |
3430 subsubsection {* List summation: @{const listsum} and @{text"\<Sum>"}*} |
3348 |
3431 |
3349 lemma (in monoid_add) listsum_simps [simp]: |
3432 lemma (in monoid_add) listsum_simps [simp]: |
3350 "listsum [] = 0" |
3433 "listsum [] = 0" |
3393 by (induct xs) auto |
3476 by (induct xs) auto |
3394 |
3477 |
3395 lemma (in monoid_add) length_concat: |
3478 lemma (in monoid_add) length_concat: |
3396 "length (concat xss) = listsum (map length xss)" |
3479 "length (concat xss) = listsum (map length xss)" |
3397 by (induct xss) simp_all |
3480 by (induct xss) simp_all |
3481 |
|
3482 lemma (in monoid_add) length_product_lists: |
|
3483 "length (product_lists xss) = foldr op * (map length xss) 1" |
|
3484 proof (induct xss) |
|
3485 case (Cons xs xss) then show ?case by (induct xs) (auto simp: length_concat o_def) |
|
3486 qed simp |
|
3398 |
3487 |
3399 lemma (in monoid_add) listsum_map_filter: |
3488 lemma (in monoid_add) listsum_map_filter: |
3400 assumes "\<And>x. x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> f x = 0" |
3489 assumes "\<And>x. x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> f x = 0" |
3401 shows "listsum (map f (filter P xs)) = listsum (map f xs)" |
3490 shows "listsum (map f (filter P xs)) = listsum (map f xs)" |
3402 using assms by (induct xs) auto |
3491 using assms by (induct xs) auto |
4570 qed |
4659 qed |
4571 |
4660 |
4572 lemma sorted_remdups[simp]: |
4661 lemma sorted_remdups[simp]: |
4573 "sorted l \<Longrightarrow> sorted (remdups l)" |
4662 "sorted l \<Longrightarrow> sorted (remdups l)" |
4574 by (induct l) (auto simp: sorted_Cons) |
4663 by (induct l) (auto simp: sorted_Cons) |
4664 |
|
4665 lemma sorted_remdups_adj[simp]: |
|
4666 "sorted xs \<Longrightarrow> sorted (remdups_adj xs)" |
|
4667 by (induct xs rule: remdups_adj.induct, simp_all split: split_if_asm add: sorted_Cons) |
|
4575 |
4668 |
4576 lemma sorted_distinct_set_unique: |
4669 lemma sorted_distinct_set_unique: |
4577 assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys" |
4670 assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys" |
4578 shows "xs = ys" |
4671 shows "xs = ys" |
4579 proof - |
4672 proof - |
6460 |
6553 |
6461 lemma zip_transfer [transfer_rule]: |
6554 lemma zip_transfer [transfer_rule]: |
6462 "(list_all2 A ===> list_all2 B ===> list_all2 (prod_rel A B)) zip zip" |
6555 "(list_all2 A ===> list_all2 B ===> list_all2 (prod_rel A B)) zip zip" |
6463 unfolding zip_def by transfer_prover |
6556 unfolding zip_def by transfer_prover |
6464 |
6557 |
6558 lemma product_transfer [transfer_rule]: |
|
6559 "(list_all2 A ===> list_all2 B ===> list_all2 (prod_rel A B)) List.product List.product" |
|
6560 unfolding List.product_def by transfer_prover |
|
6561 |
|
6562 lemma product_lists_transfer [transfer_rule]: |
|
6563 "(list_all2 (list_all2 A) ===> list_all2 (list_all2 A)) product_lists product_lists" |
|
6564 unfolding product_lists_def by transfer_prover |
|
6565 |
|
6465 lemma insert_transfer [transfer_rule]: |
6566 lemma insert_transfer [transfer_rule]: |
6466 assumes [transfer_rule]: "bi_unique A" |
6567 assumes [transfer_rule]: "bi_unique A" |
6467 shows "(A ===> list_all2 A ===> list_all2 A) List.insert List.insert" |
6568 shows "(A ===> list_all2 A ===> list_all2 A) List.insert List.insert" |
6468 unfolding List.insert_def [abs_def] by transfer_prover |
6569 unfolding List.insert_def [abs_def] by transfer_prover |
6469 |
6570 |
6488 |
6589 |
6489 lemma remdups_transfer [transfer_rule]: |
6590 lemma remdups_transfer [transfer_rule]: |
6490 assumes [transfer_rule]: "bi_unique A" |
6591 assumes [transfer_rule]: "bi_unique A" |
6491 shows "(list_all2 A ===> list_all2 A) remdups remdups" |
6592 shows "(list_all2 A ===> list_all2 A) remdups remdups" |
6492 unfolding remdups_def by transfer_prover |
6593 unfolding remdups_def by transfer_prover |
6594 |
|
6595 lemma remdups_adj_transfer [transfer_rule]: |
|
6596 assumes [transfer_rule]: "bi_unique A" |
|
6597 shows "(list_all2 A ===> list_all2 A) remdups_adj remdups_adj" |
|
6598 proof (rule fun_relI, erule list_all2_induct) |
|
6599 qed (auto simp: remdups_adj_Cons assms[unfolded bi_unique_def] split: list.splits) |
|
6493 |
6600 |
6494 lemma replicate_transfer [transfer_rule]: |
6601 lemma replicate_transfer [transfer_rule]: |
6495 "(op = ===> A ===> list_all2 A) replicate replicate" |
6602 "(op = ===> A ===> list_all2 A) replicate replicate" |
6496 unfolding replicate_def by transfer_prover |
6603 unfolding replicate_def by transfer_prover |
6497 |
6604 |