diff -r 3d4c3eec5143 -r 9f089287687b src/HOL/Library/Multiset.thy --- a/src/HOL/Library/Multiset.thy Fri Oct 07 17:57:17 2016 +0200 +++ b/src/HOL/Library/Multiset.thy Fri Oct 07 17:58:36 2016 +0200 @@ -522,7 +522,6 @@ interpretation subset_mset: ordered_ab_semigroup_add_imp_le "op +" "op -" "op \#" "op \#" by standard (auto simp add: subset_mset_def subseteq_mset_def multiset_eq_iff intro: order_trans antisym) - \ \FIXME: avoid junk stemming from type class interpretation\ interpretation subset_mset: ordered_ab_semigroup_monoid_add_imp_le "op +" 0 "op -" "op \#" "op <#" by standard @@ -644,27 +643,21 @@ "A - C \# B \ A \# B + C" by (simp add: subseteq_mset_def le_diff_conv) -lemma subset_eq_empty[simp]: "M \# {#} \ M = {#}" - by auto - lemma multi_psub_of_add_self [simp]: "A \# add_mset x A" by (auto simp: subset_mset_def subseteq_mset_def) -lemma multi_psub_self[simp]: "(A::'a multiset) \# A = False" +lemma multi_psub_self: "A \# A = False" by simp lemma mset_subset_add_mset [simp]: "add_mset x N \# add_mset x M \ N \# M" unfolding add_mset_add_single[of _ N] add_mset_add_single[of _ M] by (fact subset_mset.add_less_cancel_right) -lemma mset_subset_empty_nonempty: "{#} \# S \ S \ {#}" - by (fact subset_mset.zero_less_iff_neq_zero) - lemma mset_subset_diff_self: "c \# B \ B - {#c#} \# B" by (auto simp: subset_mset_def elim: mset_add) -subsubsection \Intersection\ +subsubsection \Intersection and bounded union\ definition inf_subset_mset :: "'a multiset \ 'a multiset \ 'a multiset" (infixl "\#" 70) where multiset_inter_def: "inf_subset_mset A B = A - (A - B)" @@ -678,6 +671,25 @@ qed \ \FIXME: avoid junk stemming from type class interpretation\ +definition sup_subset_mset :: "'a multiset \ 'a multiset \ 'a multiset"(infixl "\#" 70) + where "sup_subset_mset A B = A + (B - A)" \ \FIXME irregular fact name\ + +interpretation subset_mset: semilattice_sup sup_subset_mset "op \#" "op \#" +proof - + have [simp]: "m \ n \ q \ n \ m + (q - m) \ n" for m n q :: nat + by arith + show "class.semilattice_sup op \# op \# op \#" + by standard (auto simp add: sup_subset_mset_def subseteq_mset_def) +qed + \ \FIXME: avoid junk stemming from type class interpretation\ + +interpretation subset_mset: bounded_lattice_bot "op \#" "op \#" "op \#" + "op \#" "{#}" + by standard auto + + +subsubsection \Additional intersection facts\ + lemma multiset_inter_count [simp]: fixes A B :: "'a multiset" shows "count (A \# B) x = min (count A x) (count B x)" @@ -752,12 +764,6 @@ "{#} = A \# add_mset b B \ b \# A \ {#} = A \# B" by (auto simp: disjunct_not_in) -lemma empty_inter[simp]: "{#} \# M = {#}" - by (simp add: multiset_eq_iff) - -lemma inter_empty[simp]: "M \# {#} = {#}" - by (simp add: multiset_eq_iff) - lemma inter_add_left1: "\ x \# N \ (add_mset x M) \# N = M \# N" by (simp add: multiset_eq_iff not_in_iff) @@ -813,23 +819,7 @@ by (auto simp add: subseteq_mset_def) -subsubsection \Bounded union\ - -definition sup_subset_mset :: "'a multiset \ 'a multiset \ 'a multiset"(infixl "\#" 70) - where "sup_subset_mset A B = A + (B - A)" \ \FIXME irregular fact name\ - -interpretation subset_mset: semilattice_sup sup_subset_mset "op \#" "op \#" -proof - - have [simp]: "m \ n \ q \ n \ m + (q - m) \ n" for m n q :: nat - by arith - show "class.semilattice_sup op \# op \# op \#" - by standard (auto simp add: sup_subset_mset_def subseteq_mset_def) -qed - \ \FIXME: avoid junk stemming from type class interpretation\ - -interpretation subset_mset: bounded_lattice_bot "op \#" "op \#" "op \#" - "op \#" "{#}" - by standard auto +subsubsection \Additional bounded union facts\ lemma sup_subset_mset_count [simp]: \ \FIXME irregular fact name\ "count (A \# B) x = max (count A x) (count B x)" @@ -840,12 +830,6 @@ by (simp only: set_eq_iff count_greater_zero_iff [symmetric] sup_subset_mset_count) (auto simp add: not_in_iff elim: mset_add) -lemma empty_sup: "{#} \# M = M" - by (fact subset_mset.sup_bot.left_neutral) - -lemma sup_empty: "M \# {#} = M" - by (fact subset_mset.sup_bot.right_neutral) - lemma sup_union_left1 [simp]: "\ x \# N \ (add_mset x M) \# N = add_mset x (M \# N)" by (simp add: multiset_eq_iff not_in_iff) @@ -881,7 +865,7 @@ subsubsection \Subset is an order\ -interpretation subset_mset: order "op \#" "op <#" by unfold_locales auto +interpretation subset_mset: order "op \#" "op \#" by unfold_locales subsection \Replicate and repeat operations\ @@ -1051,8 +1035,6 @@ end -lemma bdd_below_multiset [simp]: "subset_mset.bdd_below A" - by (intro subset_mset.bdd_belowI[of _ "{#}"]) simp_all lemma bdd_above_multiset_imp_bdd_above_count: assumes "subset_mset.bdd_above (A :: 'a multiset set)" @@ -1465,7 +1447,7 @@ lemma mset_subset_size: "(A::'a multiset) \# B \ size A < size B" proof (induct A arbitrary: B) case (empty M) - then have "M \ {#}" by (simp add: mset_subset_empty_nonempty) + then have "M \ {#}" by (simp add: subset_mset.zero_less_iff_neq_zero) then obtain M' x where "M = add_mset x M'" by (blast dest: multi_nonempty_split) then show ?case by simp @@ -1750,8 +1732,8 @@ lemma mset_zero_iff_right[simp]: "({#} = mset x) = (x = [])" by (induct x) auto -lemma set_mset_mset[simp]: "set_mset (mset x) = set x" -by (induct x) auto +lemma set_mset_mset[simp]: "set_mset (mset xs) = set xs" + by (induct xs) auto lemma set_mset_comp_mset [simp]: "set_mset \ mset = set" by (simp add: fun_eq_iff) @@ -2921,12 +2903,7 @@ subsubsection \Monotonicity of multiset union\ lemma mult1_union: "(B, D) \ mult1 r \ (C + B, C + D) \ mult1 r" -apply (unfold mult1_def) -apply auto -apply (rule_tac x = a in exI) -apply (rule_tac x = "C + M0" in exI) -apply (simp add: add.assoc) -done + by (force simp: mult1_def) lemma union_le_mono2: "B < D \ C + B < C + (D::'a::preorder multiset)" apply (unfold less_multiset_def mult_def) @@ -3266,7 +3243,7 @@ (subset_eq_mset_impl xs ys = Some False \ mset xs = mset ys)" proof (induct xs arbitrary: ys) case (Nil ys) - show ?case by (auto simp: mset_subset_empty_nonempty) + show ?case by (auto simp: subset_mset.zero_less_iff_neq_zero) next case (Cons x xs ys) show ?case