diff -r 32f0e953cc96 -r 8f96e1329845 src/HOL/List.thy --- a/src/HOL/List.thy Sat Aug 24 14:14:57 2024 +0100 +++ b/src/HOL/List.thy Sat Aug 24 23:44:05 2024 +0100 @@ -3359,12 +3359,7 @@ lemma nth_take_lemma: "k \ length xs \ k \ length ys \ (\i. i < k \ xs!i = ys!i) \ take k xs = take k ys" -proof (induct k arbitrary: xs ys) - case (Suc k) - then show ?case - apply (simp add: less_Suc_eq_0_disj) - by (simp add: Suc.prems(3) take_Suc_conv_app_nth) -qed simp + by (induct k arbitrary: xs ys) (simp_all add: take_Suc_conv_app_nth) lemma nth_equalityI: "\length xs = length ys; \i. i < length xs \ xs!i = ys!i\ \ xs = ys" @@ -3712,7 +3707,7 @@ lemma nth_eq_iff_index_eq: "\ distinct xs; i < length xs; j < length xs \ \ (xs!i = xs!j) = (i = j)" -by(auto simp: distinct_conv_nth) + by(auto simp: distinct_conv_nth) lemma distinct_Ex1: "distinct xs \ x \ set xs \ (\!i. i < length xs \ xs ! i = x)" @@ -3733,9 +3728,7 @@ lemma distinct_swap[simp]: "\ i < size xs; j < size xs\ \ distinct(xs[i := xs!j, j := xs!i]) = distinct xs" - apply (simp add: distinct_conv_nth nth_list_update) - apply (safe; metis) - done + by (smt (verit, del_insts) distinct_conv_nth length_list_update nth_list_update) lemma set_swap[simp]: "\ i < size xs; j < size xs \ \ set(xs[i := xs!j, j := xs!i]) = set xs" @@ -4320,7 +4313,7 @@ next case (Cons x xs) thus ?case apply(auto simp: nth_Cons' split: if_splits) - using diff_Suc_1[unfolded One_nat_def] less_Suc_eq_0_disj by fastforce + using diff_Suc_1 less_Suc_eq_0_disj by fastforce qed lemmas find_Some_iff2 = find_Some_iff[THEN eq_iff_swap] @@ -4514,9 +4507,16 @@ distinct (removeAll [] xs) \ (\ys. ys \ set xs \ distinct ys) \ (\ys zs. ys \ set xs \ zs \ set xs \ ys \ zs \ set ys \ set zs = {})" -apply (induct xs) - apply(simp_all, safe, auto) -by (metis Int_iff UN_I empty_iff equals0I set_empty) +proof (induct xs) + case Nil + then show ?case by auto +next + case (Cons a xs) + have "\set a \ \ (set ` set xs) = {}; a \ set xs\ \ a=[]" + by (metis Int_iff UN_I empty_iff equals0I set_empty) + then show ?case + by (auto simp: Cons) +qed subsubsection \\<^const>\replicate\\ @@ -4535,24 +4535,24 @@ qed lemma Ex_list_of_length: "\xs. length xs = n" -by (rule exI[of _ "replicate n undefined"]) simp + by (rule exI[of _ "replicate n undefined"]) simp lemma map_replicate [simp]: "map f (replicate n x) = replicate n (f x)" -by (induct n) auto + by (induct n) auto lemma map_replicate_const: "map (\ x. k) lst = replicate (length lst) k" -by (induct lst) auto + by (induct lst) auto lemma replicate_app_Cons_same: -"(replicate n x) @ (x # xs) = x # replicate n x @ xs" -by (induct n) auto + "(replicate n x) @ (x # xs) = x # replicate n x @ xs" + by (induct n) auto lemma rev_replicate [simp]: "rev (replicate n x) = replicate n x" -by (induct n) (auto simp: replicate_app_Cons_same) + by (metis length_rev map_replicate map_replicate_const rev_map) lemma replicate_add: "replicate (n + m) x = replicate n x @ replicate m x" -by (induct n) auto + by (induct n) auto text\Courtesy of Matthias Daum:\ lemma append_replicate_commute: @@ -4899,10 +4899,7 @@ lemma nth_rotate: \rotate m xs ! n = xs ! ((m + n) mod length xs)\ if \n < length xs\ - using that apply (auto simp add: rotate_drop_take nth_append not_less less_diff_conv ac_simps dest!: le_Suc_ex) - apply (metis add.commute mod_add_right_eq mod_less) - apply (metis (no_types, lifting) Nat.diff_diff_right add.commute add_diff_cancel_right' diff_le_self dual_order.strict_trans2 length_greater_0_conv less_nat_zero_code list.size(3) mod_add_right_eq mod_add_self2 mod_le_divisor mod_less) - done + by (smt (verit) add.commute hd_rotate_conv_nth length_rotate not_less0 list.size(3) mod_less rotate_rotate that) lemma nth_rotate1: \rotate1 xs ! n = xs ! (Suc n mod length xs)\ if \n < length xs\ @@ -4944,10 +4941,8 @@ by (auto simp add: nths_def) lemma nths_all: "\i < length xs. i \ I \ nths xs I = xs" -apply (simp add: nths_def) -apply (subst filter_True) - apply (auto simp: in_set_zip subset_iff) -done + unfolding nths_def + by (metis add_0 diff_zero filter_True in_set_zip length_upt nth_upt zip_eq_conv) lemma length_nths: "length (nths xs I) = card{i. i < length xs \ i \ I}" @@ -5343,8 +5338,7 @@ show ?thesis unfolding transpose.simps \i = Suc j\ nth_Cons_Suc "3.hyps"[OF j_less] - apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric]) - by (simp add: nth_tl) + by (auto simp: nth_tl transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric]) qed qed simp_all @@ -6644,14 +6638,9 @@ have "(xs,ys) \ ?L (Suc n)" if r: "(xs,ys) \ ?R (Suc n)" for xs ys proof - from r obtain xys where r': "?len (Suc n) xs" "?len (Suc n) ys" "?P xs ys xys" by auto - then show ?thesis - proof (cases xys) - case Nil - thus ?thesis using r' by (auto simp: image_Collect lex_prod_def) - next - case Cons - thus ?thesis using r' Suc by (fastforce simp: image_Collect lex_prod_def) - qed + then show ?thesis + using r' Suc + by (cases xys; fastforce simp: image_Collect lex_prod_def) qed moreover have "(xs,ys) \ ?L (Suc n) \ (xs,ys) \ ?R (Suc n)" for xs ys using Suc by (auto simp add: image_Collect lex_prod_def)(blast, meson Cons_eq_appendI) @@ -6867,25 +6856,25 @@ lemma lexord_same_pref_iff: "(xs @ ys, xs @ zs) \ lexord r \ (\x \ set xs. (x,x) \ r) \ (ys, zs) \ lexord r" -by(induction xs) auto + by(induction xs) auto lemma lexord_same_pref_if_irrefl[simp]: "irrefl r \ (xs @ ys, xs @ zs) \ lexord r \ (ys, zs) \ lexord r" -by (simp add: irrefl_def lexord_same_pref_iff) + by (simp add: irrefl_def lexord_same_pref_iff) lemma lexord_append_rightI: "\ b z. y = b # z \ (x, x @ y) \ lexord r" -by (metis append_Nil2 lexord_Nil_left lexord_same_pref_iff) + by (metis append_Nil2 lexord_Nil_left lexord_same_pref_iff) lemma lexord_append_left_rightI: "(a,b) \ r \ (u @ a # x, u @ b # y) \ lexord r" -by (simp add: lexord_same_pref_iff) + by (simp add: lexord_same_pref_iff) lemma lexord_append_leftI: "(u,v) \ lexord r \ (x @ u, x @ v) \ lexord r" -by (simp add: lexord_same_pref_iff) + by (simp add: lexord_same_pref_iff) lemma lexord_append_leftD: "\(x @ u, x @ v) \ lexord r; (\a. (a,a) \ r) \ \ (u,v) \ lexord r" -by (simp add: lexord_same_pref_iff) + by (simp add: lexord_same_pref_iff) lemma lexord_take_index_conv: "((x,y) \ lexord r) = @@ -6897,9 +6886,13 @@ moreover have "(\u a b. (a, b) \ r \ (\v. x = u @ a # v) \ (\w. y = u @ b # w)) = (\i take i x = take i y \ (x ! i, y ! i) \ r)" - apply safe - using less_iff_Suc_add apply auto[1] - by (metis id_take_nth_drop) + (is "?L=?R") + proof + show "?L\?R" + by (metis append_eq_conv_conj drop_all leI list.simps(3) nth_append_length) + show "?R\?L" + by (metis id_take_nth_drop) + qed ultimately show ?thesis by (auto simp: lexord_def Let_def) qed @@ -7118,19 +7111,19 @@ by(subst lexordp_eq.simps, fastforce)+ lemma lexordp_append_rightI: "ys \ Nil \ lexordp xs (xs @ ys)" -by(induct xs)(auto simp add: neq_Nil_conv) + by(induct xs)(auto simp add: neq_Nil_conv) lemma lexordp_append_left_rightI: "x < y \ lexordp (us @ x # xs) (us @ y # ys)" -by(induct us) auto + by(induct us) auto lemma lexordp_eq_refl: "lexordp_eq xs xs" -by(induct xs) simp_all + by(induct xs) simp_all lemma lexordp_append_leftI: "lexordp us vs \ lexordp (xs @ us) (xs @ vs)" -by(induct xs) auto + by(induct xs) auto lemma lexordp_append_leftD: "\ lexordp (xs @ us) (xs @ vs); \a. \ a < a \ \ lexordp us vs" -by(induct xs) auto + by(induct xs) auto lemma lexordp_irreflexive: assumes irrefl: "\x. \ x < x" @@ -7251,21 +7244,21 @@ definition "measures fs = inv_image (lex less_than) (%a. map (%f. f a) fs)" lemma wf_measures[simp]: "wf (measures fs)" -unfolding measures_def -by blast + unfolding measures_def + by blast lemma in_measures[simp]: "(x, y) \ measures [] = False" "(x, y) \ measures (f # fs) = (f x < f y \ (f x = f y \ (x, y) \ measures fs))" -unfolding measures_def -by auto + unfolding measures_def + by auto lemma measures_less: "f x < f y \ (x, y) \ measures (f#fs)" -by simp + by simp lemma measures_lesseq: "f x \ f y \ (x, y) \ measures fs \ (x, y) \ measures (f#fs)" -by auto + by auto subsubsection \Lifting Relations to Lists: one element\ @@ -7286,27 +7279,27 @@ unfolding listrel1_def by auto lemma not_Nil_listrel1 [iff]: "([], xs) \ listrel1 r" -unfolding listrel1_def by blast + unfolding listrel1_def by blast lemma not_listrel1_Nil [iff]: "(xs, []) \ listrel1 r" -unfolding listrel1_def by blast + unfolding listrel1_def by blast lemma Cons_listrel1_Cons [iff]: "(x # xs, y # ys) \ listrel1 r \ (x,y) \ r \ xs = ys \ x = y \ (xs, ys) \ listrel1 r" -by (simp add: listrel1_def Cons_eq_append_conv) (blast) + by (simp add: listrel1_def Cons_eq_append_conv) (blast) lemma listrel1I1: "(x,y) \ r \ (x # xs, y # xs) \ listrel1 r" -by fast + by fast lemma listrel1I2: "(xs, ys) \ listrel1 r \ (x # xs, x # ys) \ listrel1 r" -by fast + by fast lemma append_listrel1I: "(xs, ys) \ listrel1 r \ us = vs \ xs = ys \ (us, vs) \ listrel1 r \ (xs @ us, ys @ vs) \ listrel1 r" -unfolding listrel1_def -by auto (blast intro: append_eq_appendI)+ + unfolding listrel1_def + by auto (blast intro: append_eq_appendI)+ lemma Cons_listrel1E1[elim!]: assumes "(x # xs, ys) \ listrel1 r" @@ -7333,19 +7326,19 @@ qed lemma listrel1_eq_len: "(xs,ys) \ listrel1 r \ length xs = length ys" -unfolding listrel1_def by auto + unfolding listrel1_def by auto lemma listrel1_mono: "r \ s \ listrel1 r \ listrel1 s" -unfolding listrel1_def by blast + unfolding listrel1_def by blast lemma listrel1_converse: "listrel1 (r\) = (listrel1 r)\" -unfolding listrel1_def by blast + unfolding listrel1_def by blast lemma in_listrel1_converse: "(x,y) \ listrel1 (r\) \ (x,y) \ (listrel1 r)\" -unfolding listrel1_def by blast + unfolding listrel1_def by blast lemma listrel1_iff_update: "(xs,ys) \ (listrel1 r) @@ -7618,19 +7611,19 @@ stack overflow in some target languages.\ fun map_tailrec_rev :: "('a \ 'b) \ 'a list \ 'b list \ 'b list" where -"map_tailrec_rev f [] bs = bs" | -"map_tailrec_rev f (a#as) bs = map_tailrec_rev f as (f a # bs)" + "map_tailrec_rev f [] bs = bs" | + "map_tailrec_rev f (a#as) bs = map_tailrec_rev f as (f a # bs)" lemma map_tailrec_rev: "map_tailrec_rev f as bs = rev(map f as) @ bs" -by(induction as arbitrary: bs) simp_all + by(induction as arbitrary: bs) simp_all definition map_tailrec :: "('a \ 'b) \ 'a list \ 'b list" where -"map_tailrec f as = rev (map_tailrec_rev f as [])" + "map_tailrec f as = rev (map_tailrec_rev f as [])" text\Code equation:\ lemma map_eq_map_tailrec: "map = map_tailrec" -by(simp add: fun_eq_iff map_tailrec_def map_tailrec_rev) + by(simp add: fun_eq_iff map_tailrec_def map_tailrec_rev) subsubsection \Counterparts for set-related operations\ @@ -8375,7 +8368,7 @@ lemma list_all_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> (=)) list_all list_all" - unfolding list_all_iff [abs_def] by transfer_prover + using list.pred_transfer by blast lemma list_ex_transfer [transfer_rule]: "((A ===> (=)) ===> list_all2 A ===> (=)) list_ex list_ex"