# HG changeset patch # User wenzelm # Date 1526329405 -7200 # Node ID c80b0a35eb5421d223f04433f2075fa47160eeb8 # Parent 3e4af46a6f6aaa903aff33ae6ca83825d74cca2d# Parent 6c693b2700b3e29334fac13417414cf3daa01f76 merged diff -r 6c693b2700b3 -r c80b0a35eb54 src/HOL/List.thy --- a/src/HOL/List.thy Mon May 14 22:22:47 2018 +0200 +++ b/src/HOL/List.thy Mon May 14 22:23:25 2018 +0200 @@ -4971,22 +4971,29 @@ lemma sorted_wrt01: "length xs \ 1 \ sorted_wrt P xs" by(auto simp: le_Suc_eq length_Suc_conv) -lemma sorted_wrt_iff_nth_Suc: +lemma sorted_wrt_iff_nth_less: "sorted_wrt P xs = (\i j. i < j \ j < length xs \ P (xs ! i) (xs ! j))" apply(induction xs) - apply simp -apply(force simp: in_set_conv_nth nth_Cons split: nat.split) +apply(auto simp add: in_set_conv_nth Ball_def nth_Cons split: nat.split) done lemma sorted_wrt_nth_less: "\ sorted_wrt P xs; i < j; j < length xs \ \ P (xs ! i) (xs ! j)" -by(auto simp: sorted_wrt_iff_nth_Suc) - -text \Strictly Ascending Sequences of Natural Numbers\ +by(auto simp: sorted_wrt_iff_nth_less) lemma sorted_wrt_upt[simp]: "sorted_wrt (<) [m.. n < m" + hence "m \ n" by simp + thus ?thesis + by(induction m rule:int_le_induct)(auto simp: upto_rec1) +qed + text \Each element is greater or equal to its index:\ lemma sorted_wrt_less_idx: @@ -5021,6 +5028,14 @@ lemmas [code] = sorted.simps(1) sorted2_simps +lemma sorted_append: + "sorted (xs@ys) = (sorted xs \ sorted ys \ (\x \ set xs. \y \ set ys. x\y))" +by (simp add: sorted_sorted_wrt sorted_wrt_append) + +lemma sorted_map: + "sorted (map f xs) = sorted_wrt (\x y. f x \ f y) xs" +by (simp add: sorted_sorted_wrt sorted_wrt_map) + lemma sorted01: "length xs \ 1 \ sorted xs" by (simp add: sorted_sorted_wrt sorted_wrt01) @@ -5028,13 +5043,13 @@ "sorted xs \ sorted (tl xs)" by (cases xs) (simp_all) -lemma sorted_append: - "sorted (xs@ys) = (sorted xs \ sorted ys \ (\x \ set xs. \y \ set ys. x\y))" -by (induct xs) (auto) +lemma sorted_iff_nth_mono: + "sorted xs = (\i j. i < j \ j < length xs \ xs ! i \ xs ! j)" +by (simp add: sorted_sorted_wrt sorted_wrt_iff_nth_less) lemma sorted_nth_mono: "sorted xs \ i \ j \ j < length xs \ xs!i \ xs!j" -by (induct xs arbitrary: i j) (auto simp:nth_Cons') +by (auto simp: sorted_iff_nth_mono nat_less_le) lemma sorted_rev_nth_mono: "sorted (rev xs) \ i \ j \ j < length xs \ xs!j \ xs!i" @@ -5042,31 +5057,6 @@ rev_nth[of "length xs - i - 1" "xs"] rev_nth[of "length xs - j - 1" "xs"] by auto -lemma sorted_nth_monoI: - "(\ i j. \ i \ j ; j < length xs \ \ xs ! i \ xs ! j) \ sorted xs" -proof (induct xs) - case (Cons x xs) - have "sorted xs" - proof (rule Cons.hyps) - fix i j assume "i \ j" and "j < length xs" - with Cons.prems[of "Suc i" "Suc j"] - show "xs ! i \ xs ! j" by auto - qed - moreover - { - fix y assume "y \ set xs" - then obtain j where "j < length xs" and "xs ! j = y" - unfolding in_set_conv_nth by blast - with Cons.prems[of 0 "Suc j"] have "x \ y" by auto - } - ultimately - show ?case by auto -qed simp - -lemma sorted_equals_nth_mono: - "sorted xs = (\j < length xs. \i \ j. xs ! i \ xs ! j)" -by (auto intro: sorted_nth_monoI sorted_nth_mono) - lemma sorted_map_remove1: "sorted (map f xs) \ sorted (map f (remove1 x xs))" by (induct xs) (auto) @@ -5446,7 +5436,7 @@ subsubsection \@{const transpose} on sorted lists\ lemma sorted_transpose[simp]: "sorted (rev (map length (transpose xs)))" -by (auto simp: sorted_equals_nth_mono rev_nth nth_transpose +by (auto simp: sorted_iff_nth_mono rev_nth nth_transpose length_filter_conv_card intro: card_mono) lemma transpose_max_length: @@ -5579,7 +5569,7 @@ (is "?trans = ?map") proof (rule nth_equalityI) have "sorted (rev (map length xs))" - by (auto simp: rev_nth rect intro!: sorted_nth_monoI) + by (auto simp: rev_nth rect sorted_iff_nth_mono) from foldr_max_sorted[OF this] assms show len: "length ?trans = length ?map" by (simp_all add: length_transpose foldr_map comp_def) diff -r 6c693b2700b3 -r c80b0a35eb54 src/HOL/ex/Radix_Sort.thy --- a/src/HOL/ex/Radix_Sort.thy Mon May 14 22:22:47 2018 +0200 +++ b/src/HOL/ex/Radix_Sort.thy Mon May 14 22:23:25 2018 +0200 @@ -7,14 +7,21 @@ "HOL-Library.Multiset" begin +text \The \Radix_Sort\ locale provides a sorting function \radix_sort\ that sorts +lists of lists. It is parameterized by a sorting function \sort1 f\ that also sorts +lists of lists, but only w.r.t. the column selected by \f\. +Working with lists, \f\ is instantiated with @{term"\xs. xs ! n"} to select the \n\-th element. +A more efficient implementation would sort lists of arrays because arrays support +constant time access to every element.\ + locale Radix_Sort = fixes sort1 :: "('a list \ 'a::linorder) \ 'a list list \ 'a list list" -assumes sorted: "sorted (map f (sort1 f xs))" -assumes mset: "mset (sort1 f xs) = mset xs" +assumes sorted: "sorted (map f (sort1 f xss))" +assumes mset: "mset (sort1 f xss) = mset xss" assumes stable: "stable_sort_key sort1" begin -lemma set_sort1[simp]: "set(sort1 f xs) = set xs" +lemma set_sort1[simp]: "set(sort1 f xss) = set xss" by (metis mset set_mset_mset) abbreviation "sort_col i xss \ sort1 (\xs. xs ! i) xss" @@ -95,7 +102,7 @@ corollary sorted_radix_sort: "cols xss n \ sorted (radix_sort n xss)" apply(frule sorted_from_radix_sort[OF _ le_refl]) - apply(auto simp add: cols_def sorted_equals_nth_mono) + apply(auto simp add: cols_def sorted_iff_nth_mono) done end