# HG changeset patch # User haftmann # Date 1743358826 -7200 # Node ID f1ff9123c62ac8374b66fe251f1eec3212f535d6 # Parent 667c67b1e8f1fbca7e84373a7c1d04430ea51788 tuned diff -r 667c67b1e8f1 -r f1ff9123c62a src/HOL/Library/Comparator.thy --- a/src/HOL/Library/Comparator.thy Mon Mar 31 19:17:51 2025 +0200 +++ b/src/HOL/Library/Comparator.thy Sun Mar 30 20:20:26 2025 +0200 @@ -13,146 +13,146 @@ datatype comp = Less | Equiv | Greater locale comparator = - fixes cmp :: "'a \ 'a \ comp" - assumes refl [simp]: "\a. cmp a a = Equiv" - and trans_equiv: "\a b c. cmp a b = Equiv \ cmp b c = Equiv \ cmp a c = Equiv" - assumes trans_less: "cmp a b = Less \ cmp b c = Less \ cmp a c = Less" - and greater_iff_sym_less: "\b a. cmp b a = Greater \ cmp a b = Less" + fixes cmp :: \'a \ 'a \ comp\ + assumes refl [simp]: \\a. cmp a a = Equiv\ + and trans_equiv: \\a b c. cmp a b = Equiv \ cmp b c = Equiv \ cmp a c = Equiv\ + assumes trans_less: \cmp a b = Less \ cmp b c = Less \ cmp a c = Less\ + and greater_iff_sym_less: \\b a. cmp b a = Greater \ cmp a b = Less\ begin text \Dual properties\ lemma trans_greater: - "cmp a c = Greater" if "cmp a b = Greater" "cmp b c = Greater" + \cmp a c = Greater\ if \cmp a b = Greater\ \cmp b c = Greater\ using that greater_iff_sym_less trans_less by blast lemma less_iff_sym_greater: - "cmp b a = Less \ cmp a b = Greater" + \cmp b a = Less \ cmp a b = Greater\ by (simp add: greater_iff_sym_less) text \The equivalence part\ lemma sym: - "cmp b a = Equiv \ cmp a b = Equiv" + \cmp b a = Equiv \ cmp a b = Equiv\ by (metis (full_types) comp.exhaust greater_iff_sym_less) lemma reflp: - "reflp (\a b. cmp a b = Equiv)" + \reflp (\a b. cmp a b = Equiv)\ by (rule reflpI) simp lemma symp: - "symp (\a b. cmp a b = Equiv)" + \symp (\a b. cmp a b = Equiv)\ by (rule sympI) (simp add: sym) lemma transp: - "transp (\a b. cmp a b = Equiv)" + \transp (\a b. cmp a b = Equiv)\ by (rule transpI) (fact trans_equiv) lemma equivp: - "equivp (\a b. cmp a b = Equiv)" + \equivp (\a b. cmp a b = Equiv)\ using reflp symp transp by (rule equivpI) text \The strict part\ lemma irreflp_less: - "irreflp (\a b. cmp a b = Less)" + \irreflp (\a b. cmp a b = Less)\ by (rule irreflpI) simp lemma irreflp_greater: - "irreflp (\a b. cmp a b = Greater)" + \irreflp (\a b. cmp a b = Greater)\ by (rule irreflpI) simp lemma asym_less: - "cmp b a \ Less" if "cmp a b = Less" + \cmp b a \ Less\ if \cmp a b = Less\ using that greater_iff_sym_less by force lemma asym_greater: - "cmp b a \ Greater" if "cmp a b = Greater" + \cmp b a \ Greater\ if \cmp a b = Greater\ using that greater_iff_sym_less by force lemma asymp_less: - "asymp (\a b. cmp a b = Less)" - using irreflp_less by (auto intro: asympI dest: asym_less) + \asymp (\a b. cmp a b = Less)\ + using irreflp_less by (auto dest: asym_less) lemma asymp_greater: - "asymp (\a b. cmp a b = Greater)" - using irreflp_greater by (auto intro!: asympI dest: asym_greater) + \asymp (\a b. cmp a b = Greater)\ + using irreflp_greater by (auto dest: asym_greater) lemma trans_equiv_less: - "cmp a c = Less" if "cmp a b = Equiv" and "cmp b c = Less" + \cmp a c = Less\ if \cmp a b = Equiv\ and \cmp b c = Less\ using that by (metis (full_types) comp.exhaust greater_iff_sym_less trans_equiv trans_less) lemma trans_less_equiv: - "cmp a c = Less" if "cmp a b = Less" and "cmp b c = Equiv" + \cmp a c = Less\ if \cmp a b = Less\ and \cmp b c = Equiv\ using that by (metis (full_types) comp.exhaust greater_iff_sym_less trans_equiv trans_less) lemma trans_equiv_greater: - "cmp a c = Greater" if "cmp a b = Equiv" and "cmp b c = Greater" + \cmp a c = Greater\ if \cmp a b = Equiv\ and \cmp b c = Greater\ using that by (simp add: sym [of a b] greater_iff_sym_less trans_less_equiv) lemma trans_greater_equiv: - "cmp a c = Greater" if "cmp a b = Greater" and "cmp b c = Equiv" + \cmp a c = Greater\ if \cmp a b = Greater\ and \cmp b c = Equiv\ using that by (simp add: sym [of b c] greater_iff_sym_less trans_equiv_less) lemma transp_less: - "transp (\a b. cmp a b = Less)" + \transp (\a b. cmp a b = Less)\ by (rule transpI) (fact trans_less) lemma transp_greater: - "transp (\a b. cmp a b = Greater)" + \transp (\a b. cmp a b = Greater)\ by (rule transpI) (fact trans_greater) text \The reflexive part\ lemma reflp_not_less: - "reflp (\a b. cmp a b \ Less)" + \reflp (\a b. cmp a b \ Less)\ by (rule reflpI) simp lemma reflp_not_greater: - "reflp (\a b. cmp a b \ Greater)" + \reflp (\a b. cmp a b \ Greater)\ by (rule reflpI) simp lemma quasisym_not_less: - "cmp a b = Equiv" if "cmp a b \ Less" and "cmp b a \ Less" + \cmp a b = Equiv\ if \cmp a b \ Less\ and \cmp b a \ Less\ using that comp.exhaust greater_iff_sym_less by auto lemma quasisym_not_greater: - "cmp a b = Equiv" if "cmp a b \ Greater" and "cmp b a \ Greater" + \cmp a b = Equiv\ if \cmp a b \ Greater\ and \cmp b a \ Greater\ using that comp.exhaust greater_iff_sym_less by auto lemma trans_not_less: - "cmp a c \ Less" if "cmp a b \ Less" "cmp b c \ Less" + \cmp a c \ Less\ if \cmp a b \ Less\ \cmp b c \ Less\ using that by (metis comp.exhaust greater_iff_sym_less trans_equiv trans_less) lemma trans_not_greater: - "cmp a c \ Greater" if "cmp a b \ Greater" "cmp b c \ Greater" + \cmp a c \ Greater\ if \cmp a b \ Greater\ \cmp b c \ Greater\ using that greater_iff_sym_less trans_not_less by blast lemma transp_not_less: - "transp (\a b. cmp a b \ Less)" + \transp (\a b. cmp a b \ Less)\ by (rule transpI) (fact trans_not_less) lemma transp_not_greater: - "transp (\a b. cmp a b \ Greater)" + \transp (\a b. cmp a b \ Greater)\ by (rule transpI) (fact trans_not_greater) text \Substitution under equivalences\ lemma equiv_subst_left: - "cmp z y = comp \ cmp x y = comp" if "cmp z x = Equiv" for comp + \cmp z y = comp \ cmp x y = comp\ if \cmp z x = Equiv\ for comp proof - - from that have "cmp x z = Equiv" + from that have \cmp x z = Equiv\ by (simp add: sym) with that show ?thesis by (cases comp) (auto intro: trans_equiv trans_equiv_less trans_equiv_greater) qed lemma equiv_subst_right: - "cmp x z = comp \ cmp x y = comp" if "cmp z y = Equiv" for comp + \cmp x z = comp \ cmp x y = comp\ if \cmp z y = Equiv\ for comp proof - - from that have "cmp y z = Equiv" + from that have \cmp y z = Equiv\ by (simp add: sym) with that show ?thesis by (cases comp) (auto intro: trans_equiv trans_less_equiv trans_greater_equiv) @@ -160,10 +160,10 @@ end -typedef 'a comparator = "{cmp :: 'a \ 'a \ comp. comparator cmp}" +typedef 'a comparator = \{cmp :: 'a \ 'a \ comp. comparator cmp}\ morphisms compare Abs_comparator proof - - have "comparator (\_ _. Equiv)" + have \comparator (\_ _. Equiv)\ by standard simp_all then show ?thesis by auto @@ -171,17 +171,17 @@ setup_lifting type_definition_comparator -global_interpretation compare: comparator "compare cmp" +global_interpretation compare: comparator \compare cmp\ using compare [of cmp] by simp -lift_definition flat :: "'a comparator" - is "\_ _. Equiv" by standard simp_all +lift_definition flat :: \'a comparator\ + is \\_ _. Equiv\ by standard simp_all instantiation comparator :: (linorder) default begin -lift_definition default_comparator :: "'a comparator" - is "\x y. if x < y then Less else if x > y then Greater else Equiv" +lift_definition default_comparator :: \'a comparator\ + is \\x y. if x < y then Less else if x > y then Greater else Equiv\ by standard (auto split: if_splits) instance .. @@ -193,8 +193,8 @@ instantiation comparator :: (enum) equal begin -lift_definition equal_comparator :: "'a comparator \ 'a comparator \ bool" - is "\f g. \x \ set Enum.enum. f x = g x" . +lift_definition equal_comparator :: \'a comparator \ 'a comparator \ bool\ + is \\f g. \x \ set Enum.enum. f x = g x\ . instance by (standard; transfer) (auto simp add: enum_UNIV) @@ -202,23 +202,23 @@ end lemma [code]: - "HOL.equal cmp1 cmp2 \ Enum.enum_all (\x. compare cmp1 x = compare cmp2 x)" + \HOL.equal cmp1 cmp2 \ Enum.enum_all (\x. compare cmp1 x = compare cmp2 x)\ by transfer (simp add: enum_UNIV) lemma [code nbe]: - "HOL.equal (cmp :: 'a::enum comparator) cmp \ True" + \HOL.equal (cmp :: 'a::enum comparator) cmp \ True\ by (fact equal_refl) instantiation comparator :: ("{linorder, typerep}") full_exhaustive begin definition full_exhaustive_comparator :: - "('a comparator \ (unit \ term) \ (bool \ term list) option) - \ natural \ (bool \ term list) option" - where "full_exhaustive_comparator f s = + \('a comparator \ (unit \ term) \ (bool \ term list) option) + \ natural \ (bool \ term list) option\ + where \full_exhaustive_comparator f s = Quickcheck_Exhaustive.orelse (f (flat, (\u. Code_Evaluation.Const (STR ''Comparator.flat'') TYPEREP('a comparator)))) - (f (default, (\u. Code_Evaluation.Const (STR ''HOL.default_class.default'') TYPEREP('a comparator))))" + (f (default, (\u. Code_Evaluation.Const (STR ''HOL.default_class.default'') TYPEREP('a comparator))))\ instance .. @@ -227,67 +227,67 @@ subsection \Fundamental comparator combinators\ -lift_definition reversed :: "'a comparator \ 'a comparator" - is "\cmp a b. cmp b a" +lift_definition reversed :: \'a comparator \ 'a comparator\ + is \\cmp a b. cmp b a\ proof - - fix cmp :: "'a \ 'a \ comp" - assume "comparator cmp" + fix cmp :: \'a \ 'a \ comp\ + assume \comparator cmp\ then interpret comparator cmp . - show "comparator (\a b. cmp b a)" + show \comparator (\a b. cmp b a)\ by standard (auto intro: trans_equiv trans_less simp: greater_iff_sym_less) qed -lift_definition key :: "('b \ 'a) \ 'a comparator \ 'b comparator" - is "\f cmp a b. cmp (f a) (f b)" +lift_definition key :: \('b \ 'a) \ 'a comparator \ 'b comparator\ + is \\f cmp a b. cmp (f a) (f b)\ proof - - fix cmp :: "'a \ 'a \ comp" and f :: "'b \ 'a" - assume "comparator cmp" + fix cmp :: \'a \ 'a \ comp\ and f :: \'b \ 'a\ + assume \comparator cmp\ then interpret comparator cmp . - show "comparator (\a b. cmp (f a) (f b))" + show \comparator (\a b. cmp (f a) (f b))\ by standard (auto intro: trans_equiv trans_less simp: greater_iff_sym_less) qed subsection \Direct implementations for linear orders on selected types\ -definition comparator_bool :: "bool comparator" - where [simp, code_abbrev]: "comparator_bool = default" +definition comparator_bool :: \bool comparator\ + where [simp, code_abbrev]: \comparator_bool = default\ lemma compare_comparator_bool [code abstract]: - "compare comparator_bool = (\p q. + \compare comparator_bool = (\p q. if p then if q then Equiv else Greater - else if q then Less else Equiv)" + else if q then Less else Equiv)\ by (auto simp add: fun_eq_iff) (transfer; simp)+ -definition raw_comparator_nat :: "nat \ nat \ comp" - where [simp]: "raw_comparator_nat = compare default" +definition raw_comparator_nat :: \nat \ nat \ comp\ + where [simp]: \raw_comparator_nat = compare default\ lemma default_comparator_nat [simp, code]: - "raw_comparator_nat (0::nat) 0 = Equiv" - "raw_comparator_nat (Suc m) 0 = Greater" - "raw_comparator_nat 0 (Suc n) = Less" - "raw_comparator_nat (Suc m) (Suc n) = raw_comparator_nat m n" + \raw_comparator_nat (0::nat) 0 = Equiv\ + \raw_comparator_nat (Suc m) 0 = Greater\ + \raw_comparator_nat 0 (Suc n) = Less\ + \raw_comparator_nat (Suc m) (Suc n) = raw_comparator_nat m n\ by (transfer; simp)+ -definition comparator_nat :: "nat comparator" - where [simp, code_abbrev]: "comparator_nat = default" +definition comparator_nat :: \nat comparator\ + where [simp, code_abbrev]: \comparator_nat = default\ lemma compare_comparator_nat [code abstract]: - "compare comparator_nat = raw_comparator_nat" + \compare comparator_nat = raw_comparator_nat\ by simp -definition comparator_linordered_group :: "'a::linordered_ab_group_add comparator" - where [simp, code_abbrev]: "comparator_linordered_group = default" +definition comparator_linordered_group :: \'a::linordered_ab_group_add comparator\ + where [simp, code_abbrev]: \comparator_linordered_group = default\ lemma comparator_linordered_group [code abstract]: - "compare comparator_linordered_group = (\a b. + \compare comparator_linordered_group = (\a b. let c = a - b in if c < 0 then Less - else if c = 0 then Equiv else Greater)" + else if c = 0 then Equiv else Greater)\ proof (rule ext)+ fix a b :: 'a - show "compare comparator_linordered_group a b = + show \compare comparator_linordered_group a b = (let c = a - b in if c < 0 then Less - else if c = 0 then Equiv else Greater)" + else if c = 0 then Equiv else Greater)\ by (simp add: Let_def not_less) (transfer; auto) qed diff -r 667c67b1e8f1 -r f1ff9123c62a src/HOL/Library/Sorting_Algorithms.thy --- a/src/HOL/Library/Sorting_Algorithms.thy Mon Mar 31 19:17:51 2025 +0200 +++ b/src/HOL/Library/Sorting_Algorithms.thy Sun Mar 30 20:20:26 2025 +0200 @@ -8,43 +8,43 @@ section \Stably sorted lists\ -abbreviation (input) stable_segment :: "'a comparator \ 'a \ 'a list \ 'a list" - where "stable_segment cmp x \ filter (\y. compare cmp x y = Equiv)" +abbreviation (input) stable_segment :: \'a comparator \ 'a \ 'a list \ 'a list\ + where \stable_segment cmp x \ filter (\y. compare cmp x y = Equiv)\ -fun sorted :: "'a comparator \ 'a list \ bool" - where sorted_Nil: "sorted cmp [] \ True" - | sorted_single: "sorted cmp [x] \ True" - | sorted_rec: "sorted cmp (y # x # xs) \ compare cmp y x \ Greater \ sorted cmp (x # xs)" +fun sorted :: \'a comparator \ 'a list \ bool\ + where sorted_Nil: \sorted cmp [] \ True\ + | sorted_single: \sorted cmp [x] \ True\ + | sorted_rec: \sorted cmp (y # x # xs) \ compare cmp y x \ Greater \ sorted cmp (x # xs)\ lemma sorted_ConsI: - "sorted cmp (x # xs)" if "sorted cmp xs" - and "\y ys. xs = y # ys \ compare cmp x y \ Greater" + \sorted cmp (x # xs)\ if \sorted cmp xs\ + and \\y ys. xs = y # ys \ compare cmp x y \ Greater\ using that by (cases xs) simp_all lemma sorted_Cons_imp_sorted: - "sorted cmp xs" if "sorted cmp (x # xs)" + \sorted cmp xs\ if \sorted cmp (x # xs)\ using that by (cases xs) simp_all lemma sorted_Cons_imp_not_less: - "compare cmp y x \ Greater" if "sorted cmp (y # xs)" - and "x \ set xs" + \compare cmp y x \ Greater\ if \sorted cmp (y # xs)\ + and \x \ set xs\ using that by (induction xs arbitrary: y) (auto dest: compare.trans_not_greater) lemma sorted_induct [consumes 1, case_names Nil Cons, induct pred: sorted]: - "P xs" if "sorted cmp xs" and "P []" - and *: "\x xs. sorted cmp xs \ P xs - \ (\y. y \ set xs \ compare cmp x y \ Greater) \ P (x # xs)" + \P xs\ if \sorted cmp xs\ and \P []\ + and *: \\x xs. sorted cmp xs \ P xs + \ (\y. y \ set xs \ compare cmp x y \ Greater) \ P (x # xs)\ using \sorted cmp xs\ proof (induction xs) case Nil show ?case by (rule \P []\) next case (Cons x xs) - from \sorted cmp (x # xs)\ have "sorted cmp xs" + from \sorted cmp (x # xs)\ have \sorted cmp xs\ by (cases xs) simp_all - moreover have "P xs" using \sorted cmp xs\ + moreover have \P xs\ using \sorted cmp xs\ by (rule Cons.IH) - moreover have "compare cmp x y \ Greater" if "y \ set xs" for y + moreover have \compare cmp x y \ Greater\ if \y \ set xs\ for y using that \sorted cmp (x # xs)\ proof (induction xs) case Nil then show ?case @@ -58,9 +58,9 @@ by simp next case (Cons w ws) - with Cons.prems have "compare cmp z w \ Greater" "compare cmp x z \ Greater" + with Cons.prems have \compare cmp z w \ Greater\ \compare cmp x z \ Greater\ by auto - then have "compare cmp x w \ Greater" + then have \compare cmp x w \ Greater\ by (auto dest: compare.trans_not_greater) with Cons show ?thesis using Cons.prems Cons.IH by auto @@ -71,28 +71,28 @@ qed lemma sorted_induct_remove1 [consumes 1, case_names Nil minimum]: - "P xs" if "sorted cmp xs" and "P []" - and *: "\x xs. sorted cmp xs \ P (remove1 x xs) + \P xs\ if \sorted cmp xs\ and \P []\ + and *: \\x xs. sorted cmp xs \ P (remove1 x xs) \ x \ set xs \ hd (stable_segment cmp x xs) = x \ (\y. y \ set xs \ compare cmp x y \ Greater) - \ P xs" + \ P xs\ using \sorted cmp xs\ proof (induction xs) case Nil show ?case by (rule \P []\) next case (Cons x xs) - then have "sorted cmp (x # xs)" + then have \sorted cmp (x # xs)\ by (simp add: sorted_ConsI) moreover note Cons.IH - moreover have "\y. compare cmp x y = Greater \ y \ set xs \ False" + moreover have \\y. compare cmp x y = Greater \ y \ set xs \ False\ using Cons.hyps by simp ultimately show ?case - by (auto intro!: * [of "x # xs" x]) blast + by (auto intro!: * [of \x # xs\ x]) blast qed lemma sorted_remove1: - "sorted cmp (remove1 x xs)" if "sorted cmp xs" -proof (cases "x \ set xs") + \sorted cmp (remove1 x xs)\ if \sorted cmp xs\ +proof (cases \x \ set xs\) case False with that show ?thesis by (simp add: remove1_idem) @@ -104,21 +104,21 @@ by simp next case (Cons y ys) - show ?case proof (cases "x = y") + show ?case proof (cases \x = y\) case True with Cons.hyps show ?thesis by simp next case False - then have "sorted cmp (remove1 x ys)" + then have \sorted cmp (remove1 x ys)\ using Cons.IH Cons.prems by auto - then have "sorted cmp (y # remove1 x ys)" + then have \sorted cmp (y # remove1 x ys)\ proof (rule sorted_ConsI) fix z zs - assume "remove1 x ys = z # zs" - with \x \ y\ have "z \ set ys" + assume \remove1 x ys = z # zs\ + with \x \ y\ have \z \ set ys\ using notin_set_remove1 [of z ys x] by auto - then show "compare cmp y z \ Greater" + then show \compare cmp y z \ Greater\ by (rule Cons.hyps(2)) qed with False show ?thesis @@ -128,7 +128,7 @@ qed lemma sorted_stable_segment: - "sorted cmp (stable_segment cmp x xs)" + \sorted cmp (stable_segment cmp x xs)\ proof (induction xs) case Nil show ?case @@ -141,22 +141,22 @@ qed -primrec insort :: "'a comparator \ 'a \ 'a list \ 'a list" - where "insort cmp y [] = [y]" - | "insort cmp y (x # xs) = (if compare cmp y x \ Greater +primrec insort :: \'a comparator \ 'a \ 'a list \ 'a list\ + where \insort cmp y [] = [y]\ + | \insort cmp y (x # xs) = (if compare cmp y x \ Greater then y # x # xs - else x # insort cmp y xs)" + else x # insort cmp y xs)\ lemma mset_insort [simp]: - "mset (insort cmp x xs) = add_mset x (mset xs)" + \mset (insort cmp x xs) = add_mset x (mset xs)\ by (induction xs) simp_all lemma length_insort [simp]: - "length (insort cmp x xs) = Suc (length xs)" + \length (insort cmp x xs) = Suc (length xs)\ by (induction xs) simp_all lemma sorted_insort: - "sorted cmp (insort cmp x xs)" if "sorted cmp xs" + \sorted cmp (insort cmp x xs)\ if \sorted cmp xs\ using that proof (induction xs) case Nil then show ?case @@ -168,37 +168,37 @@ qed lemma stable_insort_equiv: - "stable_segment cmp y (insort cmp x xs) = x # stable_segment cmp y xs" - if "compare cmp y x = Equiv" + \stable_segment cmp y (insort cmp x xs) = x # stable_segment cmp y xs\ + if \compare cmp y x = Equiv\ proof (induction xs) case Nil from that show ?case by simp next case (Cons z xs) - moreover from that have "compare cmp y z = Equiv \ compare cmp z x = Equiv" + moreover from that have \compare cmp y z = Equiv \ compare cmp z x = Equiv\ by (auto intro: compare.trans_equiv simp add: compare.sym) ultimately show ?case using that by (auto simp add: compare.greater_iff_sym_less) qed lemma stable_insort_not_equiv: - "stable_segment cmp y (insort cmp x xs) = stable_segment cmp y xs" - if "compare cmp y x \ Equiv" + \stable_segment cmp y (insort cmp x xs) = stable_segment cmp y xs\ + if \compare cmp y x \ Equiv\ using that by (induction xs) simp_all lemma remove1_insort_same_eq [simp]: - "remove1 x (insort cmp x xs) = xs" + \remove1 x (insort cmp x xs) = xs\ by (induction xs) simp_all lemma insort_eq_ConsI: - "insort cmp x xs = x # xs" - if "sorted cmp xs" "\y. y \ set xs \ compare cmp x y \ Greater" + \insort cmp x xs = x # xs\ + if \sorted cmp xs\ \\y. y \ set xs \ compare cmp x y \ Greater\ using that by (induction xs) (simp_all add: compare.greater_iff_sym_less) lemma remove1_insort_not_same_eq [simp]: - "remove1 y (insort cmp x xs) = insort cmp x (remove1 y xs)" - if "sorted cmp xs" "x \ y" + \remove1 y (insort cmp x xs) = insort cmp x (remove1 y xs)\ + if \sorted cmp xs\ \x \ y\ using that proof (induction xs) case Nil then show ?case @@ -206,13 +206,13 @@ next case (Cons z zs) show ?case - proof (cases "compare cmp x z = Greater") + proof (cases \compare cmp x z = Greater\) case True with Cons show ?thesis by simp next case False - then have "compare cmp x y \ Greater" if "y \ set zs" for y + then have \compare cmp x y \ Greater\ if \y \ set zs\ for y using that Cons.hyps by (auto dest: compare.trans_not_greater) with Cons show ?thesis @@ -221,25 +221,25 @@ qed lemma insort_remove1_same_eq: - "insort cmp x (remove1 x xs) = xs" - if "sorted cmp xs" and "x \ set xs" and "hd (stable_segment cmp x xs) = x" + \insort cmp x (remove1 x xs) = xs\ + if \sorted cmp xs\ and \x \ set xs\ and \hd (stable_segment cmp x xs) = x\ using that proof (induction xs) case Nil then show ?case by simp next case (Cons y ys) - then have "compare cmp x y \ Less" + then have \compare cmp x y \ Less\ by (auto simp add: compare.greater_iff_sym_less) - then consider "compare cmp x y = Greater" | "compare cmp x y = Equiv" - by (cases "compare cmp x y") auto + then consider \compare cmp x y = Greater\ | \compare cmp x y = Equiv\ + by (cases \compare cmp x y\) auto then show ?case proof cases case 1 with Cons.prems Cons.IH show ?thesis by auto next case 2 - with Cons.prems have "x = y" + with Cons.prems have \x = y\ by simp with Cons.hyps show ?thesis by (simp add: insort_eq_ConsI) @@ -247,8 +247,8 @@ qed lemma sorted_append_iff: - "sorted cmp (xs @ ys) \ sorted cmp xs \ sorted cmp ys - \ (\x \ set xs. \y \ set ys. compare cmp x y \ Greater)" (is "?P \ ?R \ ?S \ ?Q") + \sorted cmp (xs @ ys) \ sorted cmp xs \ sorted cmp ys + \ (\x \ set xs. \y \ set ys. compare cmp x y \ Greater)\ (is \?P \ ?R \ ?S \ ?Q\) proof assume ?P have ?R @@ -260,10 +260,10 @@ moreover have ?Q using \?P\ by (induction xs) (auto simp add: sorted_Cons_imp_not_less, simp add: sorted_Cons_imp_sorted) - ultimately show "?R \ ?S \ ?Q" + ultimately show \?R \ ?S \ ?Q\ by simp next - assume "?R \ ?S \ ?Q" + assume \?R \ ?S \ ?Q\ then have ?R ?S ?Q by simp_all then show ?P @@ -271,65 +271,65 @@ (auto simp add: append_eq_Cons_conv intro!: sorted_ConsI) qed -definition sort :: "'a comparator \ 'a list \ 'a list" - where "sort cmp xs = foldr (insort cmp) xs []" +definition sort :: \'a comparator \ 'a list \ 'a list\ + where \sort cmp xs = foldr (insort cmp) xs []\ lemma sort_simps [simp]: - "sort cmp [] = []" - "sort cmp (x # xs) = insort cmp x (sort cmp xs)" + \sort cmp [] = []\ + \sort cmp (x # xs) = insort cmp x (sort cmp xs)\ by (simp_all add: sort_def) lemma mset_sort [simp]: - "mset (sort cmp xs) = mset xs" + \mset (sort cmp xs) = mset xs\ by (induction xs) simp_all lemma length_sort [simp]: - "length (sort cmp xs) = length xs" + \length (sort cmp xs) = length xs\ by (induction xs) simp_all lemma sorted_sort [simp]: - "sorted cmp (sort cmp xs)" + \sorted cmp (sort cmp xs)\ by (induction xs) (simp_all add: sorted_insort) lemma stable_sort: - "stable_segment cmp x (sort cmp xs) = stable_segment cmp x xs" + \stable_segment cmp x (sort cmp xs) = stable_segment cmp x xs\ by (induction xs) (simp_all add: stable_insort_equiv stable_insort_not_equiv) lemma sort_remove1_eq [simp]: - "sort cmp (remove1 x xs) = remove1 x (sort cmp xs)" + \sort cmp (remove1 x xs) = remove1 x (sort cmp xs)\ by (induction xs) simp_all lemma set_insort [simp]: - "set (insort cmp x xs) = insert x (set xs)" + \set (insort cmp x xs) = insert x (set xs)\ by (induction xs) auto lemma set_sort [simp]: - "set (sort cmp xs) = set xs" + \set (sort cmp xs) = set xs\ by (induction xs) auto lemma sort_eqI: - "sort cmp ys = xs" - if permutation: "mset ys = mset xs" - and sorted: "sorted cmp xs" - and stable: "\y. y \ set ys \ - stable_segment cmp y ys = stable_segment cmp y xs" + \sort cmp ys = xs\ + if permutation: \mset ys = mset xs\ + and sorted: \sorted cmp xs\ + and stable: \\y. y \ set ys \ + stable_segment cmp y ys = stable_segment cmp y xs\ proof - - have stable': "stable_segment cmp y ys = - stable_segment cmp y xs" for y - proof (cases "\x\set ys. compare cmp y x = Equiv") + have stable': \stable_segment cmp y ys = + stable_segment cmp y xs\ for y + proof (cases \\x\set ys. compare cmp y x = Equiv\) case True - then obtain z where "z \ set ys" and "compare cmp y z = Equiv" + then obtain z where \z \ set ys\ and \compare cmp y z = Equiv\ by auto - then have "compare cmp y x = Equiv \ compare cmp z x = Equiv" for x + then have \compare cmp y x = Equiv \ compare cmp z x = Equiv\ for x by (meson compare.sym compare.trans_equiv) - moreover have "stable_segment cmp z ys = - stable_segment cmp z xs" + moreover have \stable_segment cmp z ys = + stable_segment cmp z xs\ using \z \ set ys\ by (rule stable) ultimately show ?thesis by simp next case False - moreover from permutation have "set ys = set xs" + moreover from permutation have \set ys = set xs\ by (rule mset_eq_setD) ultimately show ?thesis by simp @@ -341,40 +341,40 @@ by simp next case (minimum x xs) - from \mset ys = mset xs\ have ys: "set ys = set xs" + from \mset ys = mset xs\ have ys: \set ys = set xs\ by (rule mset_eq_setD) - then have "compare cmp x y \ Greater" if "y \ set ys" for y + then have \compare cmp x y \ Greater\ if \y \ set ys\ for y using that minimum.hyps by simp - from minimum.prems have stable: "stable_segment cmp x ys = stable_segment cmp x xs" + from minimum.prems have stable: \stable_segment cmp x ys = stable_segment cmp x xs\ by simp - have "sort cmp (remove1 x ys) = remove1 x xs" + have \sort cmp (remove1 x ys) = remove1 x xs\ by (rule minimum.IH) (simp_all add: minimum.prems filter_remove1) - then have "remove1 x (sort cmp ys) = remove1 x xs" + then have \remove1 x (sort cmp ys) = remove1 x xs\ by simp - then have "insort cmp x (remove1 x (sort cmp ys)) = - insort cmp x (remove1 x xs)" + then have \insort cmp x (remove1 x (sort cmp ys)) = + insort cmp x (remove1 x xs)\ by simp - also from minimum.hyps ys stable have "insort cmp x (remove1 x (sort cmp ys)) = sort cmp ys" + also from minimum.hyps ys stable have \insort cmp x (remove1 x (sort cmp ys)) = sort cmp ys\ by (simp add: stable_sort insort_remove1_same_eq) - also from minimum.hyps have "insort cmp x (remove1 x xs) = xs" + also from minimum.hyps have \insort cmp x (remove1 x xs) = xs\ by (simp add: insort_remove1_same_eq) finally show ?case . qed qed lemma filter_insort: - "filter P (insort cmp x xs) = insort cmp x (filter P xs)" - if "sorted cmp xs" and "P x" + \filter P (insort cmp x xs) = insort cmp x (filter P xs)\ + if \sorted cmp xs\ and \P x\ using that by (induction xs) (auto simp add: compare.trans_not_greater insort_eq_ConsI) lemma filter_insort_triv: - "filter P (insort cmp x xs) = filter P xs" - if "\ P x" + \filter P (insort cmp x xs) = filter P xs\ + if \\ P x\ using that by (induction xs) simp_all lemma filter_sort: - "filter P (sort cmp xs) = sort cmp (filter P xs)" + \filter P (sort cmp xs) = sort cmp (filter P xs)\ by (induction xs) (auto simp add: filter_insort filter_insort_triv) @@ -382,80 +382,80 @@ subsection \Quicksort\ -definition quicksort :: "'a comparator \ 'a list \ 'a list" - where quicksort_is_sort [simp]: "quicksort = sort" +definition quicksort :: \'a comparator \ 'a list \ 'a list\ + where quicksort_is_sort [simp]: \quicksort = sort\ lemma sort_by_quicksort: - "sort = quicksort" + \sort = quicksort\ by simp lemma sort_by_quicksort_rec: - "sort cmp xs = sort cmp [x\xs. compare cmp x (xs ! (length xs div 2)) = Less] + \sort cmp xs = sort cmp [x\xs. compare cmp x (xs ! (length xs div 2)) = Less] @ stable_segment cmp (xs ! (length xs div 2)) xs - @ sort cmp [x\xs. compare cmp x (xs ! (length xs div 2)) = Greater]" (is "_ = ?rhs") + @ sort cmp [x\xs. compare cmp x (xs ! (length xs div 2)) = Greater]\ (is \_ = ?rhs\) proof (rule sort_eqI) - show "mset xs = mset ?rhs" + show \mset xs = mset ?rhs\ by (rule multiset_eqI) (auto simp add: compare.sym intro: comp.exhaust) next - show "sorted cmp ?rhs" + show \sorted cmp ?rhs\ by (auto simp add: sorted_append_iff sorted_stable_segment compare.equiv_subst_right dest: compare.trans_greater) next - let ?pivot = "xs ! (length xs div 2)" + let ?pivot = \xs ! (length xs div 2)\ fix l - have "compare cmp x ?pivot = comp \ compare cmp l x = Equiv - \ compare cmp l ?pivot = comp \ compare cmp l x = Equiv" for x comp + have \compare cmp x ?pivot = comp \ compare cmp l x = Equiv + \ compare cmp l ?pivot = comp \ compare cmp l x = Equiv\ for x comp proof - - have "compare cmp x ?pivot = comp \ compare cmp l ?pivot = comp" - if "compare cmp l x = Equiv" + have \compare cmp x ?pivot = comp \ compare cmp l ?pivot = comp\ + if \compare cmp l x = Equiv\ using that by (simp add: compare.equiv_subst_left compare.sym) then show ?thesis by blast qed - then show "stable_segment cmp l xs = stable_segment cmp l ?rhs" + then show \stable_segment cmp l xs = stable_segment cmp l ?rhs\ by (simp add: stable_sort compare.sym [of _ ?pivot]) - (cases "compare cmp l ?pivot", simp_all) + (cases \compare cmp l ?pivot\, simp_all) qed context begin -qualified definition partition :: "'a comparator \ 'a \ 'a list \ 'a list \ 'a list \ 'a list" - where "partition cmp pivot xs = - ([x \ xs. compare cmp x pivot = Less], stable_segment cmp pivot xs, [x \ xs. compare cmp x pivot = Greater])" +qualified definition partition :: \'a comparator \ 'a \ 'a list \ 'a list \ 'a list \ 'a list\ + where \partition cmp pivot xs = + ([x \ xs. compare cmp x pivot = Less], stable_segment cmp pivot xs, [x \ xs. compare cmp x pivot = Greater])\ qualified lemma partition_code [code]: - "partition cmp pivot [] = ([], [], [])" - "partition cmp pivot (x # xs) = + \partition cmp pivot [] = ([], [], [])\ + \partition cmp pivot (x # xs) = (let (lts, eqs, gts) = partition cmp pivot xs in case compare cmp x pivot of Less \ (x # lts, eqs, gts) | Equiv \ (lts, x # eqs, gts) - | Greater \ (lts, eqs, x # gts))" + | Greater \ (lts, eqs, x # gts))\ using comp.exhaust by (auto simp add: partition_def Let_def compare.sym [of _ pivot]) lemma quicksort_code [code]: - "quicksort cmp xs = + \quicksort cmp xs = (case xs of [] \ [] | [x] \ xs | [x, y] \ (if compare cmp x y \ Greater then xs else [y, x]) | _ \ let (lts, eqs, gts) = partition cmp (xs ! (length xs div 2)) xs - in quicksort cmp lts @ eqs @ quicksort cmp gts)" -proof (cases "length xs \ 3") + in quicksort cmp lts @ eqs @ quicksort cmp gts)\ +proof (cases \length xs \ 3\) case False - then have "length xs \ {0, 1, 2}" + then have \length xs \ {0, 1, 2}\ by (auto simp add: not_le le_less less_antisym) - then consider "xs = []" | x where "xs = [x]" | x y where "xs = [x, y]" + then consider \xs = []\ | x where \xs = [x]\ | x y where \xs = [x, y]\ by (auto simp add: length_Suc_conv numeral_2_eq_2) then show ?thesis by cases simp_all next case True - then obtain x y z zs where "xs = x # y # z # zs" + then obtain x y z zs where \xs = x # y # z # zs\ by (metis le_0_eq length_0_conv length_Cons list.exhaust not_less_eq_eq numeral_3_eq_3) - moreover have "quicksort cmp xs = + moreover have \quicksort cmp xs = (let (lts, eqs, gts) = partition cmp (xs ! (length xs div 2)) xs - in quicksort cmp lts @ eqs @ quicksort cmp gts)" + in quicksort cmp lts @ eqs @ quicksort cmp gts)\ using sort_by_quicksort_rec [of cmp xs] by (simp add: partition_def) ultimately show ?thesis by simp @@ -466,38 +466,38 @@ subsection \Mergesort\ -definition mergesort :: "'a comparator \ 'a list \ 'a list" - where mergesort_is_sort [simp]: "mergesort = sort" +definition mergesort :: \'a comparator \ 'a list \ 'a list\ + where mergesort_is_sort [simp]: \mergesort = sort\ lemma sort_by_mergesort: - "sort = mergesort" + \sort = mergesort\ by simp context - fixes cmp :: "'a comparator" + fixes cmp :: \'a comparator\ begin -qualified function merge :: "'a list \ 'a list \ 'a list" - where "merge [] ys = ys" - | "merge xs [] = xs" - | "merge (x # xs) (y # ys) = (if compare cmp x y = Greater - then y # merge (x # xs) ys else x # merge xs (y # ys))" +qualified function merge :: \'a list \ 'a list \ 'a list\ + where \merge [] ys = ys\ + | \merge xs [] = xs\ + | \merge (x # xs) (y # ys) = (if compare cmp x y = Greater + then y # merge (x # xs) ys else x # merge xs (y # ys))\ by pat_completeness auto qualified termination by lexicographic_order lemma mset_merge: - "mset (merge xs ys) = mset xs + mset ys" + \mset (merge xs ys) = mset xs + mset ys\ by (induction xs ys rule: merge.induct) simp_all lemma merge_eq_Cons_imp: - "xs \ [] \ z = hd xs \ ys \ [] \ z = hd ys" - if "merge xs ys = z # zs" + \xs \ [] \ z = hd xs \ ys \ [] \ z = hd ys\ + if \merge xs ys = z # zs\ using that by (induction xs ys rule: merge.induct) (auto split: if_splits) lemma filter_merge: - "filter P (merge xs ys) = merge (filter P xs) (filter P ys)" - if "sorted cmp xs" and "sorted cmp ys" + \filter P (merge xs ys) = merge (filter P xs) (filter P ys)\ + if \sorted cmp xs\ and \sorted cmp ys\ using that proof (induction xs ys rule: merge.induct) case (1 ys) then show ?case @@ -509,47 +509,47 @@ next case (3 x xs y ys) show ?case - proof (cases "compare cmp x y = Greater") + proof (cases \compare cmp x y = Greater\) case True - with 3 have hyp: "filter P (merge (x # xs) ys) = - merge (filter P (x # xs)) (filter P ys)" + with 3 have hyp: \filter P (merge (x # xs) ys) = + merge (filter P (x # xs)) (filter P ys)\ by (simp add: sorted_Cons_imp_sorted) show ?thesis - proof (cases "\ P x \ P y") + proof (cases \\ P x \ P y\) case False with \compare cmp x y = Greater\ show ?thesis by (auto simp add: hyp) next case True from \compare cmp x y = Greater\ "3.prems" - have *: "compare cmp z y = Greater" if "z \ set (filter P xs)" for z + have *: \compare cmp z y = Greater\ if \z \ set (filter P xs)\ for z using that by (auto dest: compare.trans_not_greater sorted_Cons_imp_not_less) from \compare cmp x y = Greater\ show ?thesis - by (cases "filter P xs") (simp_all add: hyp *) + by (cases \filter P xs\) (simp_all add: hyp *) qed next case False - with 3 have hyp: "filter P (merge xs (y # ys)) = - merge (filter P xs) (filter P (y # ys))" + with 3 have hyp: \filter P (merge xs (y # ys)) = + merge (filter P xs) (filter P (y # ys))\ by (simp add: sorted_Cons_imp_sorted) show ?thesis - proof (cases "P x \ \ P y") + proof (cases \P x \ \ P y\) case False with \compare cmp x y \ Greater\ show ?thesis by (auto simp add: hyp) next case True from \compare cmp x y \ Greater\ "3.prems" - have *: "compare cmp x z \ Greater" if "z \ set (filter P ys)" for z + have *: \compare cmp x z \ Greater\ if \z \ set (filter P ys)\ for z using that by (auto dest: compare.trans_not_greater sorted_Cons_imp_not_less) from \compare cmp x y \ Greater\ show ?thesis - by (cases "filter P ys") (simp_all add: hyp *) + by (cases \filter P ys\) (simp_all add: hyp *) qed qed qed lemma sorted_merge: - "sorted cmp (merge xs ys)" if "sorted cmp xs" and "sorted cmp ys" + \sorted cmp (merge xs ys)\ if \sorted cmp xs\ and \sorted cmp ys\ using that proof (induction xs ys rule: merge.induct) case (1 ys) then show ?case @@ -561,15 +561,15 @@ next case (3 x xs y ys) show ?case - proof (cases "compare cmp x y = Greater") + proof (cases \compare cmp x y = Greater\) case True - with 3 have "sorted cmp (merge (x # xs) ys)" + with 3 have \sorted cmp (merge (x # xs) ys)\ by (simp add: sorted_Cons_imp_sorted) - then have "sorted cmp (y # merge (x # xs) ys)" + then have \sorted cmp (y # merge (x # xs) ys)\ proof (rule sorted_ConsI) fix z zs - assume "merge (x # xs) ys = z # zs" - with 3(4) True show "compare cmp y z \ Greater" + assume \merge (x # xs) ys = z # zs\ + with 3(4) True show \compare cmp y z \ Greater\ by (clarsimp simp add: sorted_Cons_imp_sorted dest!: merge_eq_Cons_imp) (auto simp add: compare.asym_greater sorted_Cons_imp_not_less) qed @@ -577,13 +577,13 @@ by simp next case False - with 3 have "sorted cmp (merge xs (y # ys))" + with 3 have \sorted cmp (merge xs (y # ys))\ by (simp add: sorted_Cons_imp_sorted) - then have "sorted cmp (x # merge xs (y # ys))" + then have \sorted cmp (x # merge xs (y # ys))\ proof (rule sorted_ConsI) fix z zs - assume "merge xs (y # ys) = z # zs" - with 3(3) False show "compare cmp x z \ Greater" + assume \merge xs (y # ys) = z # zs\ + with 3(3) False show \compare cmp x z \ Greater\ by (clarsimp simp add: sorted_Cons_imp_sorted dest!: merge_eq_Cons_imp) (auto simp add: compare.asym_greater sorted_Cons_imp_not_less) qed @@ -593,45 +593,45 @@ qed lemma merge_eq_appendI: - "merge xs ys = xs @ ys" - if "\x y. x \ set xs \ y \ set ys \ compare cmp x y \ Greater" + \merge xs ys = xs @ ys\ + if \\x y. x \ set xs \ y \ set ys \ compare cmp x y \ Greater\ using that by (induction xs ys rule: merge.induct) simp_all lemma merge_stable_segments: - "merge (stable_segment cmp l xs) (stable_segment cmp l ys) = - stable_segment cmp l xs @ stable_segment cmp l ys" + \merge (stable_segment cmp l xs) (stable_segment cmp l ys) = + stable_segment cmp l xs @ stable_segment cmp l ys\ by (rule merge_eq_appendI) (auto dest: compare.trans_equiv_greater) lemma sort_by_mergesort_rec: - "sort cmp xs = + \sort cmp xs = merge (sort cmp (take (length xs div 2) xs)) - (sort cmp (drop (length xs div 2) xs))" (is "_ = ?rhs") + (sort cmp (drop (length xs div 2) xs))\ (is \_ = ?rhs\) proof (rule sort_eqI) - have "mset (take (length xs div 2) xs) + mset (drop (length xs div 2) xs) = - mset (take (length xs div 2) xs @ drop (length xs div 2) xs)" + have \mset (take (length xs div 2) xs) + mset (drop (length xs div 2) xs) = + mset (take (length xs div 2) xs @ drop (length xs div 2) xs)\ by (simp only: mset_append) - then show "mset xs = mset ?rhs" + then show \mset xs = mset ?rhs\ by (simp add: mset_merge) next - show "sorted cmp ?rhs" + show \sorted cmp ?rhs\ by (simp add: sorted_merge) next fix l - have "stable_segment cmp l (take (length xs div 2) xs) @ stable_segment cmp l (drop (length xs div 2) xs) - = stable_segment cmp l xs" + have \stable_segment cmp l (take (length xs div 2) xs) @ stable_segment cmp l (drop (length xs div 2) xs) + = stable_segment cmp l xs\ by (simp only: filter_append [symmetric] append_take_drop_id) - have "merge (stable_segment cmp l (take (length xs div 2) xs)) + have \merge (stable_segment cmp l (take (length xs div 2) xs)) (stable_segment cmp l (drop (length xs div 2) xs)) = - stable_segment cmp l (take (length xs div 2) xs) @ stable_segment cmp l (drop (length xs div 2) xs)" + stable_segment cmp l (take (length xs div 2) xs) @ stable_segment cmp l (drop (length xs div 2) xs)\ by (rule merge_eq_appendI) (auto simp add: compare.trans_equiv_greater) - also have "\ = stable_segment cmp l xs" + also have \\ = stable_segment cmp l xs\ by (simp only: filter_append [symmetric] append_take_drop_id) - finally show "stable_segment cmp l xs = stable_segment cmp l ?rhs" + finally show \stable_segment cmp l xs = stable_segment cmp l ?rhs\ by (simp add: stable_sort filter_merge) qed lemma mergesort_code [code]: - "mergesort cmp xs = + \mergesort cmp xs = (case xs of [] \ [] | [x] \ xs @@ -641,25 +641,25 @@ half = length xs div 2; ys = take half xs; zs = drop half xs - in merge (mergesort cmp ys) (mergesort cmp zs))" -proof (cases "length xs \ 3") + in merge (mergesort cmp ys) (mergesort cmp zs))\ +proof (cases \length xs \ 3\) case False - then have "length xs \ {0, 1, 2}" + then have \length xs \ {0, 1, 2}\ by (auto simp add: not_le le_less less_antisym) - then consider "xs = []" | x where "xs = [x]" | x y where "xs = [x, y]" + then consider \xs = []\ | x where \xs = [x]\ | x y where \xs = [x, y]\ by (auto simp add: length_Suc_conv numeral_2_eq_2) then show ?thesis by cases simp_all next case True - then obtain x y z zs where "xs = x # y # z # zs" + then obtain x y z zs where \xs = x # y # z # zs\ by (metis le_0_eq length_0_conv length_Cons list.exhaust not_less_eq_eq numeral_3_eq_3) - moreover have "mergesort cmp xs = + moreover have \mergesort cmp xs = (let half = length xs div 2; ys = take half xs; zs = drop half xs - in merge (mergesort cmp ys) (mergesort cmp zs))" + in merge (mergesort cmp ys) (mergesort cmp zs))\ using sort_by_mergesort_rec [of xs] by (simp add: Let_def) ultimately show ?thesis by simp