author  kleing 
Thu, 13 Dec 2007 06:51:22 +0100  
changeset 25610  72e1563aee09 
parent 25595  6c48275f9c76 
child 25622  6067d838041a 
permissions  rwrr 
10249  1 
(* Title: HOL/Library/Multiset.thy 
2 
ID: $Id$ 

15072  3 
Author: Tobias Nipkow, Markus Wenzel, Lawrence C Paulson, Norbert Voelker 
10249  4 
*) 
5 

14706  6 
header {* Multisets *} 
10249  7 

15131  8 
theory Multiset 
25595  9 
imports List 
15131  10 
begin 
10249  11 

12 
subsection {* The type of multisets *} 

13 

25162  14 
typedef 'a multiset = "{f::'a => nat. finite {x . f x > 0}}" 
10249  15 
proof 
11464  16 
show "(\<lambda>x. 0::nat) \<in> ?multiset" by simp 
10249  17 
qed 
18 

19 
lemmas multiset_typedef [simp] = 

10277  20 
Abs_multiset_inverse Rep_multiset_inverse Rep_multiset 
21 
and [simp] = Rep_multiset_inject [symmetric] 

10249  22 

19086  23 
definition 
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

24 
Mempty :: "'a multiset" ("{#}") where 
19086  25 
"{#} = Abs_multiset (\<lambda>a. 0)" 
10249  26 

21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

27 
definition 
25507  28 
single :: "'a => 'a multiset" where 
29 
"single a = Abs_multiset (\<lambda>b. if b = a then 1 else 0)" 

10249  30 

21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

31 
definition 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

32 
count :: "'a multiset => 'a => nat" where 
19086  33 
"count = Rep_multiset" 
10249  34 

21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

35 
definition 
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

36 
MCollect :: "'a multiset => ('a => bool) => 'a multiset" where 
19086  37 
"MCollect M P = Abs_multiset (\<lambda>x. if P x then Rep_multiset M x else 0)" 
38 

19363  39 
abbreviation 
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

40 
Melem :: "'a => 'a multiset => bool" ("(_/ :# _)" [50, 51] 50) where 
25610  41 
"a :# M == 0 < count M a" 
42 

43 
notation (xsymbols) Melem (infix "\<in>#" 50) 

10249  44 

45 
syntax 

46 
"_MCollect" :: "pttrn => 'a multiset => bool => 'a multiset" ("(1{# _ : _./ _#})") 

47 
translations 

20770  48 
"{#x:M. P#}" == "CONST MCollect M (\<lambda>x. P)" 
10249  49 

19086  50 
definition 
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

51 
set_of :: "'a multiset => 'a set" where 
19086  52 
"set_of M = {x. x :# M}" 
10249  53 

25571
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

54 
instantiation multiset :: (type) "{plus, minus, zero, size}" 
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

55 
begin 
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

56 

c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

57 
definition 
11464  58 
union_def: "M + N == Abs_multiset (\<lambda>a. Rep_multiset M a + Rep_multiset N a)" 
25571
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

59 

c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

60 
definition 
11464  61 
diff_def: "M  N == Abs_multiset (\<lambda>a. Rep_multiset M a  Rep_multiset N a)" 
25571
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

62 

c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

63 
definition 
11701
3d51fbf81c17
sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
wenzelm
parents:
11655
diff
changeset

64 
Zero_multiset_def [simp]: "0 == {#}" 
25571
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

65 

c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

66 
definition 
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

67 
size_def: "size M == setsum (count M) (set_of M)" 
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

68 

c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

69 
instance .. 
c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

70 

c9e39eafc7a0
instantiation target rather than legacy instance
haftmann
parents:
25507
diff
changeset

71 
end 
10249  72 

19086  73 
definition 
21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

74 
multiset_inter :: "'a multiset \<Rightarrow> 'a multiset \<Rightarrow> 'a multiset" (infixl "#\<inter>" 70) where 
19086  75 
"multiset_inter A B = A  (A  B)" 
15869  76 

25507  77 
syntax  "Multiset Enumeration" 
78 
"@multiset" :: "args => 'a multiset" ("{#(_)#}") 

79 

80 
translations 

81 
"{#x, xs#}" == "{#x#} + {#xs#}" 

82 
"{#x#}" == "CONST single x" 

83 

10249  84 

85 
text {* 

86 
\medskip Preservation of the representing set @{term multiset}. 

87 
*} 

88 

11464  89 
lemma const0_in_multiset [simp]: "(\<lambda>a. 0) \<in> multiset" 
17161  90 
by (simp add: multiset_def) 
10249  91 

11701
3d51fbf81c17
sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
wenzelm
parents:
11655
diff
changeset

92 
lemma only1_in_multiset [simp]: "(\<lambda>b. if b = a then 1 else 0) \<in> multiset" 
17161  93 
by (simp add: multiset_def) 
10249  94 

95 
lemma union_preserves_multiset [simp]: 

11464  96 
"M \<in> multiset ==> N \<in> multiset ==> (\<lambda>a. M a + N a) \<in> multiset" 
17161  97 
apply (simp add: multiset_def) 
98 
apply (drule (1) finite_UnI) 

10249  99 
apply (simp del: finite_Un add: Un_def) 
100 
done 

101 

102 
lemma diff_preserves_multiset [simp]: 

11464  103 
"M \<in> multiset ==> (\<lambda>a. M a  N a) \<in> multiset" 
17161  104 
apply (simp add: multiset_def) 
10249  105 
apply (rule finite_subset) 
17161  106 
apply auto 
10249  107 
done 
108 

109 

110 
subsection {* Algebraic properties of multisets *} 

111 

112 
subsubsection {* Union *} 

113 

17161  114 
lemma union_empty [simp]: "M + {#} = M \<and> {#} + M = M" 
115 
by (simp add: union_def Mempty_def) 

10249  116 

17161  117 
lemma union_commute: "M + N = N + (M::'a multiset)" 
118 
by (simp add: union_def add_ac) 

119 

120 
lemma union_assoc: "(M + N) + K = M + (N + (K::'a multiset))" 

121 
by (simp add: union_def add_ac) 

10249  122 

17161  123 
lemma union_lcomm: "M + (N + K) = N + (M + (K::'a multiset))" 
124 
proof  

125 
have "M + (N + K) = (N + K) + M" 

126 
by (rule union_commute) 

127 
also have "\<dots> = N + (K + M)" 

128 
by (rule union_assoc) 

129 
also have "K + M = M + K" 

130 
by (rule union_commute) 

131 
finally show ?thesis . 

132 
qed 

10249  133 

17161  134 
lemmas union_ac = union_assoc union_commute union_lcomm 
10249  135 

14738  136 
instance multiset :: (type) comm_monoid_add 
17200  137 
proof 
14722
8e739a6eaf11
replaced applystyle proof for instance Multiset :: plus_ac0 by recommended Isar proof style
obua
parents:
14706
diff
changeset

138 
fix a b c :: "'a multiset" 
8e739a6eaf11
replaced applystyle proof for instance Multiset :: plus_ac0 by recommended Isar proof style
obua
parents:
14706
diff
changeset

139 
show "(a + b) + c = a + (b + c)" by (rule union_assoc) 
8e739a6eaf11
replaced applystyle proof for instance Multiset :: plus_ac0 by recommended Isar proof style
obua
parents:
14706
diff
changeset

140 
show "a + b = b + a" by (rule union_commute) 
8e739a6eaf11
replaced applystyle proof for instance Multiset :: plus_ac0 by recommended Isar proof style
obua
parents:
14706
diff
changeset

141 
show "0 + a = a" by simp 
8e739a6eaf11
replaced applystyle proof for instance Multiset :: plus_ac0 by recommended Isar proof style
obua
parents:
14706
diff
changeset

142 
qed 
10277  143 

10249  144 

145 
subsubsection {* Difference *} 

146 

17161  147 
lemma diff_empty [simp]: "M  {#} = M \<and> {#}  M = {#}" 
148 
by (simp add: Mempty_def diff_def) 

10249  149 

17161  150 
lemma diff_union_inverse2 [simp]: "M + {#a#}  {#a#} = M" 
151 
by (simp add: union_def diff_def) 

10249  152 

153 

154 
subsubsection {* Count of elements *} 

155 

17161  156 
lemma count_empty [simp]: "count {#} a = 0" 
157 
by (simp add: count_def Mempty_def) 

10249  158 

17161  159 
lemma count_single [simp]: "count {#b#} a = (if b = a then 1 else 0)" 
160 
by (simp add: count_def single_def) 

10249  161 

17161  162 
lemma count_union [simp]: "count (M + N) a = count M a + count N a" 
163 
by (simp add: count_def union_def) 

10249  164 

17161  165 
lemma count_diff [simp]: "count (M  N) a = count M a  count N a" 
166 
by (simp add: count_def diff_def) 

10249  167 

168 

169 
subsubsection {* Set of elements *} 

170 

17161  171 
lemma set_of_empty [simp]: "set_of {#} = {}" 
172 
by (simp add: set_of_def) 

10249  173 

17161  174 
lemma set_of_single [simp]: "set_of {#b#} = {b}" 
175 
by (simp add: set_of_def) 

10249  176 

17161  177 
lemma set_of_union [simp]: "set_of (M + N) = set_of M \<union> set_of N" 
178 
by (auto simp add: set_of_def) 

10249  179 

17161  180 
lemma set_of_eq_empty_iff [simp]: "(set_of M = {}) = (M = {#})" 
181 
by (auto simp add: set_of_def Mempty_def count_def expand_fun_eq) 

10249  182 

17161  183 
lemma mem_set_of_iff [simp]: "(x \<in> set_of M) = (x :# M)" 
184 
by (auto simp add: set_of_def) 

10249  185 

186 

187 
subsubsection {* Size *} 

188 

17161  189 
lemma size_empty [simp]: "size {#} = 0" 
190 
by (simp add: size_def) 

10249  191 

17161  192 
lemma size_single [simp]: "size {#b#} = 1" 
193 
by (simp add: size_def) 

10249  194 

17161  195 
lemma finite_set_of [iff]: "finite (set_of M)" 
196 
using Rep_multiset [of M] 

197 
by (simp add: multiset_def set_of_def count_def) 

10249  198 

17161  199 
lemma setsum_count_Int: 
11464  200 
"finite A ==> setsum (count N) (A \<inter> set_of N) = setsum (count N) A" 
18258  201 
apply (induct rule: finite_induct) 
17161  202 
apply simp 
10249  203 
apply (simp add: Int_insert_left set_of_def) 
204 
done 

205 

17161  206 
lemma size_union [simp]: "size (M + N::'a multiset) = size M + size N" 
10249  207 
apply (unfold size_def) 
11464  208 
apply (subgoal_tac "count (M + N) = (\<lambda>a. count M a + count N a)") 
10249  209 
prefer 2 
15072  210 
apply (rule ext, simp) 
15402  211 
apply (simp (no_asm_simp) add: setsum_Un_nat setsum_addf setsum_count_Int) 
10249  212 
apply (subst Int_commute) 
213 
apply (simp (no_asm_simp) add: setsum_count_Int) 

214 
done 

215 

17161  216 
lemma size_eq_0_iff_empty [iff]: "(size M = 0) = (M = {#})" 
15072  217 
apply (unfold size_def Mempty_def count_def, auto) 
10249  218 
apply (simp add: set_of_def count_def expand_fun_eq) 
219 
done 

220 

17161  221 
lemma size_eq_Suc_imp_elem: "size M = Suc n ==> \<exists>a. a :# M" 
10249  222 
apply (unfold size_def) 
15072  223 
apply (drule setsum_SucD, auto) 
10249  224 
done 
225 

226 
subsubsection {* Equality of multisets *} 

227 

17161  228 
lemma multiset_eq_conv_count_eq: "(M = N) = (\<forall>a. count M a = count N a)" 
229 
by (simp add: count_def expand_fun_eq) 

10249  230 

17161  231 
lemma single_not_empty [simp]: "{#a#} \<noteq> {#} \<and> {#} \<noteq> {#a#}" 
232 
by (simp add: single_def Mempty_def expand_fun_eq) 

10249  233 

17161  234 
lemma single_eq_single [simp]: "({#a#} = {#b#}) = (a = b)" 
235 
by (auto simp add: single_def expand_fun_eq) 

10249  236 

17161  237 
lemma union_eq_empty [iff]: "(M + N = {#}) = (M = {#} \<and> N = {#})" 
238 
by (auto simp add: union_def Mempty_def expand_fun_eq) 

10249  239 

17161  240 
lemma empty_eq_union [iff]: "({#} = M + N) = (M = {#} \<and> N = {#})" 
241 
by (auto simp add: union_def Mempty_def expand_fun_eq) 

10249  242 

17161  243 
lemma union_right_cancel [simp]: "(M + K = N + K) = (M = (N::'a multiset))" 
244 
by (simp add: union_def expand_fun_eq) 

10249  245 

17161  246 
lemma union_left_cancel [simp]: "(K + M = K + N) = (M = (N::'a multiset))" 
247 
by (simp add: union_def expand_fun_eq) 

10249  248 

17161  249 
lemma union_is_single: 
11464  250 
"(M + N = {#a#}) = (M = {#a#} \<and> N={#} \<or> M = {#} \<and> N = {#a#})" 
15072  251 
apply (simp add: Mempty_def single_def union_def add_is_1 expand_fun_eq) 
10249  252 
apply blast 
253 
done 

254 

17161  255 
lemma single_is_union: 
15072  256 
"({#a#} = M + N) = ({#a#} = M \<and> N = {#} \<or> M = {#} \<and> {#a#} = N)" 
10249  257 
apply (unfold Mempty_def single_def union_def) 
11464  258 
apply (simp add: add_is_1 one_is_add expand_fun_eq) 
10249  259 
apply (blast dest: sym) 
260 
done 

261 

17161  262 
lemma add_eq_conv_diff: 
10249  263 
"(M + {#a#} = N + {#b#}) = 
15072  264 
(M = N \<and> a = b \<or> M = N  {#a#} + {#b#} \<and> N = M  {#b#} + {#a#})" 
24035  265 
using [[simproc del: neq]] 
10249  266 
apply (unfold single_def union_def diff_def) 
267 
apply (simp (no_asm) add: expand_fun_eq) 

15072  268 
apply (rule conjI, force, safe, simp_all) 
13601  269 
apply (simp add: eq_sym_conv) 
10249  270 
done 
271 

15869  272 
declare Rep_multiset_inject [symmetric, simp del] 
273 

23611  274 
instance multiset :: (type) cancel_ab_semigroup_add 
275 
proof 

276 
fix a b c :: "'a multiset" 

277 
show "a + b = a + c \<Longrightarrow> b = c" by simp 

278 
qed 

15869  279 

25610  280 
lemma insert_DiffM: 
281 
"x \<in># M \<Longrightarrow> {#x#} + (M  {#x#}) = M" 

282 
by (clarsimp simp: multiset_eq_conv_count_eq) 

283 

284 
lemma insert_DiffM2[simp]: 

285 
"x \<in># M \<Longrightarrow> M  {#x#} + {#x#} = M" 

286 
by (clarsimp simp: multiset_eq_conv_count_eq) 

287 

288 
lemma multi_union_self_other_eq: 

289 
"(A::'a multiset) + X = A + Y \<Longrightarrow> X = Y" 

290 
by (induct A arbitrary: X Y, auto) 

291 

292 
lemma multi_self_add_other_not_self[simp]: "(A = A + {#x#}) = False" 

293 
proof  

294 
{ 

295 
assume a: "A = A + {#x#}" 

296 
have "A = A + {#}" by simp 

297 
hence "A + {#} = A + {#x#}" using a by auto 

298 
hence "{#} = {#x#}" 

299 
by  (drule multi_union_self_other_eq) 

300 
hence False by auto 

301 
} 

302 
thus ?thesis by blast 

303 
qed 

304 

305 
lemma insert_noteq_member: 

306 
assumes BC: "B + {#b#} = C + {#c#}" 

307 
and bnotc: "b \<noteq> c" 

308 
shows "c \<in># B" 

309 
proof  

310 
have "c \<in># C + {#c#}" by simp 

311 
have nc: "\<not> c \<in># {#b#}" using bnotc by simp 

312 
hence "c \<in># B + {#b#}" using BC by simp 

313 
thus "c \<in># B" using nc by simp 

314 
qed 

315 

316 

15869  317 
subsubsection {* Intersection *} 
318 

319 
lemma multiset_inter_count: 

17161  320 
"count (A #\<inter> B) x = min (count A x) (count B x)" 
321 
by (simp add: multiset_inter_def min_def) 

15869  322 

323 
lemma multiset_inter_commute: "A #\<inter> B = B #\<inter> A" 

17200  324 
by (simp add: multiset_eq_conv_count_eq multiset_inter_count 
21214
a91bab12b2bd
adjusted two lemma names due to name change in interpretation
haftmann
parents:
20770
diff
changeset

325 
min_max.inf_commute) 
15869  326 

327 
lemma multiset_inter_assoc: "A #\<inter> (B #\<inter> C) = A #\<inter> B #\<inter> C" 

17200  328 
by (simp add: multiset_eq_conv_count_eq multiset_inter_count 
21214
a91bab12b2bd
adjusted two lemma names due to name change in interpretation
haftmann
parents:
20770
diff
changeset

329 
min_max.inf_assoc) 
15869  330 

331 
lemma multiset_inter_left_commute: "A #\<inter> (B #\<inter> C) = B #\<inter> (A #\<inter> C)" 

332 
by (simp add: multiset_eq_conv_count_eq multiset_inter_count min_def) 

333 

17161  334 
lemmas multiset_inter_ac = 
335 
multiset_inter_commute 

336 
multiset_inter_assoc 

337 
multiset_inter_left_commute 

15869  338 

339 
lemma multiset_union_diff_commute: "B #\<inter> C = {#} \<Longrightarrow> A + B  C = A  C + B" 

17200  340 
apply (simp add: multiset_eq_conv_count_eq multiset_inter_count min_def 
17161  341 
split: split_if_asm) 
15869  342 
apply clarsimp 
17161  343 
apply (erule_tac x = a in allE) 
15869  344 
apply auto 
345 
done 

346 

10249  347 

348 
subsection {* Induction over multisets *} 

349 

350 
lemma setsum_decr: 

11701
3d51fbf81c17
sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
wenzelm
parents:
11655
diff
changeset

351 
"finite F ==> (0::nat) < f a ==> 
15072  352 
setsum (f (a := f a  1)) F = (if a\<in>F then setsum f F  1 else setsum f F)" 
18258  353 
apply (induct rule: finite_induct) 
354 
apply auto 

15072  355 
apply (drule_tac a = a in mk_disjoint_insert, auto) 
10249  356 
done 
357 

10313  358 
lemma rep_multiset_induct_aux: 
18730  359 
assumes 1: "P (\<lambda>a. (0::nat))" 
360 
and 2: "!!f b. f \<in> multiset ==> P f ==> P (f (b := f b + 1))" 

25134
3d4953e88449
Eliminated most of the neq0_conv occurrences. As a result, many
nipkow
parents:
24035
diff
changeset

361 
shows "\<forall>f. f \<in> multiset > setsum f {x. f x \<noteq> 0} = n > P f" 
18730  362 
apply (unfold multiset_def) 
363 
apply (induct_tac n, simp, clarify) 

364 
apply (subgoal_tac "f = (\<lambda>a.0)") 

365 
apply simp 

366 
apply (rule 1) 

367 
apply (rule ext, force, clarify) 

368 
apply (frule setsum_SucD, clarify) 

369 
apply (rename_tac a) 

25162  370 
apply (subgoal_tac "finite {x. (f (a := f a  1)) x > 0}") 
18730  371 
prefer 2 
372 
apply (rule finite_subset) 

373 
prefer 2 

374 
apply assumption 

375 
apply simp 

376 
apply blast 

377 
apply (subgoal_tac "f = (f (a := f a  1))(a := (f (a := f a  1)) a + 1)") 

378 
prefer 2 

379 
apply (rule ext) 

380 
apply (simp (no_asm_simp)) 

381 
apply (erule ssubst, rule 2 [unfolded multiset_def], blast) 

382 
apply (erule allE, erule impE, erule_tac [2] mp, blast) 

383 
apply (simp (no_asm_simp) add: setsum_decr del: fun_upd_apply One_nat_def) 

25134
3d4953e88449
Eliminated most of the neq0_conv occurrences. As a result, many
nipkow
parents:
24035
diff
changeset

384 
apply (subgoal_tac "{x. x \<noteq> a > f x \<noteq> 0} = {x. f x \<noteq> 0}") 
18730  385 
prefer 2 
386 
apply blast 

25134
3d4953e88449
Eliminated most of the neq0_conv occurrences. As a result, many
nipkow
parents:
24035
diff
changeset

387 
apply (subgoal_tac "{x. x \<noteq> a \<and> f x \<noteq> 0} = {x. f x \<noteq> 0}  {a}") 
18730  388 
prefer 2 
389 
apply blast 

390 
apply (simp add: le_imp_diff_is_add setsum_diff1_nat cong: conj_cong) 

391 
done 

10249  392 

10313  393 
theorem rep_multiset_induct: 
11464  394 
"f \<in> multiset ==> P (\<lambda>a. 0) ==> 
11701
3d51fbf81c17
sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
wenzelm
parents:
11655
diff
changeset

395 
(!!f b. f \<in> multiset ==> P f ==> P (f (b := f b + 1))) ==> P f" 
17161  396 
using rep_multiset_induct_aux by blast 
10249  397 

18258  398 
theorem multiset_induct [case_names empty add, induct type: multiset]: 
399 
assumes empty: "P {#}" 

400 
and add: "!!M x. P M ==> P (M + {#x#})" 

17161  401 
shows "P M" 
10249  402 
proof  
403 
note defns = union_def single_def Mempty_def 

404 
show ?thesis 

405 
apply (rule Rep_multiset_inverse [THEN subst]) 

10313  406 
apply (rule Rep_multiset [THEN rep_multiset_induct]) 
18258  407 
apply (rule empty [unfolded defns]) 
15072  408 
apply (subgoal_tac "f(b := f b + 1) = (\<lambda>a. f a + (if a=b then 1 else 0))") 
10249  409 
prefer 2 
410 
apply (simp add: expand_fun_eq) 

411 
apply (erule ssubst) 

17200  412 
apply (erule Abs_multiset_inverse [THEN subst]) 
18258  413 
apply (erule add [unfolded defns, simplified]) 
10249  414 
done 
415 
qed 

416 

25610  417 
lemma empty_multiset_count: 
418 
"(\<forall>x. count A x = 0) = (A = {#})" 

419 
apply (rule iffI) 

420 
apply (induct A, simp) 

421 
apply (erule_tac x=x in allE) 

422 
apply auto 

423 
done 

424 

425 
subsection {* Case splits *} 

426 

427 
lemma multi_nonempty_split: "M \<noteq> {#} \<Longrightarrow> \<exists>A a. M = A + {#a#}" 

428 
by (induct M, auto) 

429 

430 
lemma multiset_cases [cases type, case_names empty add]: 

431 
assumes em: "M = {#} \<Longrightarrow> P" 

432 
assumes add: "\<And>N x. M = N + {#x#} \<Longrightarrow> P" 

433 
shows "P" 

434 
proof (cases "M = {#}") 

435 
assume "M = {#}" thus ?thesis using em by simp 

436 
next 

437 
assume "M \<noteq> {#}" 

438 
then obtain M' m where "M = M' + {#m#}" 

439 
by (blast dest: multi_nonempty_split) 

440 
thus ?thesis using add by simp 

441 
qed 

442 

443 
lemma multi_member_split: "x \<in># M \<Longrightarrow> \<exists>A. M = A + {#x#}" 

444 
apply (cases M, simp) 

445 
apply (rule_tac x="M  {#x#}" in exI, simp) 

446 
done 

447 

10249  448 
lemma MCollect_preserves_multiset: 
11464  449 
"M \<in> multiset ==> (\<lambda>x. if P x then M x else 0) \<in> multiset" 
10249  450 
apply (simp add: multiset_def) 
15072  451 
apply (rule finite_subset, auto) 
10249  452 
done 
453 

17161  454 
lemma count_MCollect [simp]: 
10249  455 
"count {# x:M. P x #} a = (if P a then count M a else 0)" 
15072  456 
by (simp add: count_def MCollect_def MCollect_preserves_multiset) 
10249  457 

17161  458 
lemma set_of_MCollect [simp]: "set_of {# x:M. P x #} = set_of M \<inter> {x. P x}" 
459 
by (auto simp add: set_of_def) 

10249  460 

17161  461 
lemma multiset_partition: "M = {# x:M. P x #} + {# x:M. \<not> P x #}" 
462 
by (subst multiset_eq_conv_count_eq, auto) 

10249  463 

17161  464 
lemma add_eq_conv_ex: 
465 
"(M + {#a#} = N + {#b#}) = 

466 
(M = N \<and> a = b \<or> (\<exists>K. M = K + {#b#} \<and> N = K + {#a#}))" 

15072  467 
by (auto simp add: add_eq_conv_diff) 
10249  468 

15869  469 
declare multiset_typedef [simp del] 
10249  470 

25610  471 
lemma nonempty_has_size: "(S \<noteq> {#}) = (0 < size S)" 
472 
apply (rule iffI) 

473 
apply (case_tac "size S = 0") 

474 
apply clarsimp 

475 
apply (subst (asm) neq0_conv) 

476 
apply auto 

477 
done 

478 

479 
lemma multi_drop_mem_not_eq: "c \<in># B \<Longrightarrow> B  {#c#} \<noteq> B" 

480 
by (cases "B={#}", auto dest: multi_member_split) 

17161  481 

10249  482 
subsection {* Multiset orderings *} 
483 

484 
subsubsection {* Wellfoundedness *} 

485 

19086  486 
definition 
23751  487 
mult1 :: "('a \<times> 'a) set => ('a multiset \<times> 'a multiset) set" where 
19086  488 
"mult1 r = 
23751  489 
{(N, M). \<exists>a M0 K. M = M0 + {#a#} \<and> N = M0 + K \<and> 
490 
(\<forall>b. b :# K > (b, a) \<in> r)}" 

10249  491 

21404
eb85850d3eb7
more robust syntax for definition/abbreviation/notation;
wenzelm
parents:
21214
diff
changeset

492 
definition 
23751  493 
mult :: "('a \<times> 'a) set => ('a multiset \<times> 'a multiset) set" where 
494 
"mult r = (mult1 r)\<^sup>+" 

10249  495 

23751  496 
lemma not_less_empty [iff]: "(M, {#}) \<notin> mult1 r" 
10277  497 
by (simp add: mult1_def) 
10249  498 

23751  499 
lemma less_add: "(N, M0 + {#a#}) \<in> mult1 r ==> 
500 
(\<exists>M. (M, M0) \<in> mult1 r \<and> N = M + {#a#}) \<or> 

501 
(\<exists>K. (\<forall>b. b :# K > (b, a) \<in> r) \<and> N = M0 + K)" 

19582  502 
(is "_ \<Longrightarrow> ?case1 (mult1 r) \<or> ?case2") 
10249  503 
proof (unfold mult1_def) 
23751  504 
let ?r = "\<lambda>K a. \<forall>b. b :# K > (b, a) \<in> r" 
11464  505 
let ?R = "\<lambda>N M. \<exists>a M0 K. M = M0 + {#a#} \<and> N = M0 + K \<and> ?r K a" 
23751  506 
let ?case1 = "?case1 {(N, M). ?R N M}" 
10249  507 

23751  508 
assume "(N, M0 + {#a#}) \<in> {(N, M). ?R N M}" 
18258  509 
then have "\<exists>a' M0' K. 
11464  510 
M0 + {#a#} = M0' + {#a'#} \<and> N = M0' + K \<and> ?r K a'" by simp 
18258  511 
then show "?case1 \<or> ?case2" 
10249  512 
proof (elim exE conjE) 
513 
fix a' M0' K 

514 
assume N: "N = M0' + K" and r: "?r K a'" 

515 
assume "M0 + {#a#} = M0' + {#a'#}" 

18258  516 
then have "M0 = M0' \<and> a = a' \<or> 
11464  517 
(\<exists>K'. M0 = K' + {#a'#} \<and> M0' = K' + {#a#})" 
10249  518 
by (simp only: add_eq_conv_ex) 
18258  519 
then show ?thesis 
10249  520 
proof (elim disjE conjE exE) 
521 
assume "M0 = M0'" "a = a'" 

11464  522 
with N r have "?r K a \<and> N = M0 + K" by simp 
18258  523 
then have ?case2 .. then show ?thesis .. 
10249  524 
next 
525 
fix K' 

526 
assume "M0' = K' + {#a#}" 

527 
with N have n: "N = K' + K + {#a#}" by (simp add: union_ac) 

528 

529 
assume "M0 = K' + {#a'#}" 

530 
with r have "?R (K' + K) M0" by blast 

18258  531 
with n have ?case1 by simp then show ?thesis .. 
10249  532 
qed 
533 
qed 

534 
qed 

535 

23751  536 
lemma all_accessible: "wf r ==> \<forall>M. M \<in> acc (mult1 r)" 
10249  537 
proof 
538 
let ?R = "mult1 r" 

539 
let ?W = "acc ?R" 

540 
{ 

541 
fix M M0 a 

23751  542 
assume M0: "M0 \<in> ?W" 
543 
and wf_hyp: "!!b. (b, a) \<in> r ==> (\<forall>M \<in> ?W. M + {#b#} \<in> ?W)" 

544 
and acc_hyp: "\<forall>M. (M, M0) \<in> ?R > M + {#a#} \<in> ?W" 

545 
have "M0 + {#a#} \<in> ?W" 

546 
proof (rule accI [of "M0 + {#a#}"]) 

10249  547 
fix N 
23751  548 
assume "(N, M0 + {#a#}) \<in> ?R" 
549 
then have "((\<exists>M. (M, M0) \<in> ?R \<and> N = M + {#a#}) \<or> 

550 
(\<exists>K. (\<forall>b. b :# K > (b, a) \<in> r) \<and> N = M0 + K))" 

10249  551 
by (rule less_add) 
23751  552 
then show "N \<in> ?W" 
10249  553 
proof (elim exE disjE conjE) 
23751  554 
fix M assume "(M, M0) \<in> ?R" and N: "N = M + {#a#}" 
555 
from acc_hyp have "(M, M0) \<in> ?R > M + {#a#} \<in> ?W" .. 

556 
from this and `(M, M0) \<in> ?R` have "M + {#a#} \<in> ?W" .. 

557 
then show "N \<in> ?W" by (simp only: N) 

10249  558 
next 
559 
fix K 

560 
assume N: "N = M0 + K" 

23751  561 
assume "\<forall>b. b :# K > (b, a) \<in> r" 
562 
then have "M0 + K \<in> ?W" 

10249  563 
proof (induct K) 
18730  564 
case empty 
23751  565 
from M0 show "M0 + {#} \<in> ?W" by simp 
18730  566 
next 
567 
case (add K x) 

23751  568 
from add.prems have "(x, a) \<in> r" by simp 
569 
with wf_hyp have "\<forall>M \<in> ?W. M + {#x#} \<in> ?W" by blast 

570 
moreover from add have "M0 + K \<in> ?W" by simp 

571 
ultimately have "(M0 + K) + {#x#} \<in> ?W" .. 

572 
then show "M0 + (K + {#x#}) \<in> ?W" by (simp only: union_assoc) 

10249  573 
qed 
23751  574 
then show "N \<in> ?W" by (simp only: N) 
10249  575 
qed 
576 
qed 

577 
} note tedious_reasoning = this 

578 

23751  579 
assume wf: "wf r" 
10249  580 
fix M 
23751  581 
show "M \<in> ?W" 
10249  582 
proof (induct M) 
23751  583 
show "{#} \<in> ?W" 
10249  584 
proof (rule accI) 
23751  585 
fix b assume "(b, {#}) \<in> ?R" 
586 
with not_less_empty show "b \<in> ?W" by contradiction 

10249  587 
qed 
588 

23751  589 
fix M a assume "M \<in> ?W" 
590 
from wf have "\<forall>M \<in> ?W. M + {#a#} \<in> ?W" 

10249  591 
proof induct 
592 
fix a 

23751  593 
assume r: "!!b. (b, a) \<in> r ==> (\<forall>M \<in> ?W. M + {#b#} \<in> ?W)" 
594 
show "\<forall>M \<in> ?W. M + {#a#} \<in> ?W" 

10249  595 
proof 
23751  596 
fix M assume "M \<in> ?W" 
597 
then show "M + {#a#} \<in> ?W" 

23373  598 
by (rule acc_induct) (rule tedious_reasoning [OF _ r]) 
10249  599 
qed 
600 
qed 

23751  601 
from this and `M \<in> ?W` show "M + {#a#} \<in> ?W" .. 
10249  602 
qed 
603 
qed 

604 

23751  605 
theorem wf_mult1: "wf r ==> wf (mult1 r)" 
23373  606 
by (rule acc_wfI) (rule all_accessible) 
10249  607 

23751  608 
theorem wf_mult: "wf r ==> wf (mult r)" 
609 
unfolding mult_def by (rule wf_trancl) (rule wf_mult1) 

10249  610 

611 

612 
subsubsection {* Closurefree presentation *} 

613 

614 
(*Badly needed: a linear arithmetic procedure for multisets*) 

615 

616 
lemma diff_union_single_conv: "a :# J ==> I + J  {#a#} = I + (J  {#a#})" 

23373  617 
by (simp add: multiset_eq_conv_count_eq) 
10249  618 

619 
text {* One direction. *} 

620 

621 
lemma mult_implies_one_step: 

23751  622 
"trans r ==> (M, N) \<in> mult r ==> 
11464  623 
\<exists>I J K. N = I + J \<and> M = I + K \<and> J \<noteq> {#} \<and> 
23751  624 
(\<forall>k \<in> set_of K. \<exists>j \<in> set_of J. (k, j) \<in> r)" 
10249  625 
apply (unfold mult_def mult1_def set_of_def) 
23751  626 
apply (erule converse_trancl_induct, clarify) 
15072  627 
apply (rule_tac x = M0 in exI, simp, clarify) 
23751  628 
apply (case_tac "a :# K") 
10249  629 
apply (rule_tac x = I in exI) 
630 
apply (simp (no_asm)) 

23751  631 
apply (rule_tac x = "(K  {#a#}) + Ka" in exI) 
10249  632 
apply (simp (no_asm_simp) add: union_assoc [symmetric]) 
11464  633 
apply (drule_tac f = "\<lambda>M. M  {#a#}" in arg_cong) 
10249  634 
apply (simp add: diff_union_single_conv) 
635 
apply (simp (no_asm_use) add: trans_def) 

636 
apply blast 

637 
apply (subgoal_tac "a :# I") 

638 
apply (rule_tac x = "I  {#a#}" in exI) 

639 
apply (rule_tac x = "J + {#a#}" in exI) 

640 
apply (rule_tac x = "K + Ka" in exI) 

641 
apply (rule conjI) 

642 
apply (simp add: multiset_eq_conv_count_eq split: nat_diff_split) 

643 
apply (rule conjI) 

15072  644 
apply (drule_tac f = "\<lambda>M. M  {#a#}" in arg_cong, simp) 
10249  645 
apply (simp add: multiset_eq_conv_count_eq split: nat_diff_split) 
646 
apply (simp (no_asm_use) add: trans_def) 

647 
apply blast 

10277  648 
apply (subgoal_tac "a :# (M0 + {#a#})") 
10249  649 
apply simp 
650 
apply (simp (no_asm)) 

651 
done 

652 

653 
lemma elem_imp_eq_diff_union: "a :# M ==> M = M  {#a#} + {#a#}" 

23373  654 
by (simp add: multiset_eq_conv_count_eq) 
10249  655 

11464  656 
lemma size_eq_Suc_imp_eq_union: "size M = Suc n ==> \<exists>a N. M = N + {#a#}" 
10249  657 
apply (erule size_eq_Suc_imp_elem [THEN exE]) 
15072  658 
apply (drule elem_imp_eq_diff_union, auto) 
10249  659 
done 
660 

661 
lemma one_step_implies_mult_aux: 

23751  662 
"trans r ==> 
663 
\<forall>I J K. (size J = n \<and> J \<noteq> {#} \<and> (\<forall>k \<in> set_of K. \<exists>j \<in> set_of J. (k, j) \<in> r)) 

664 
> (I + K, I + J) \<in> mult r" 

15072  665 
apply (induct_tac n, auto) 
666 
apply (frule size_eq_Suc_imp_eq_union, clarify) 

667 
apply (rename_tac "J'", simp) 

668 
apply (erule notE, auto) 

10249  669 
apply (case_tac "J' = {#}") 
670 
apply (simp add: mult_def) 

23751  671 
apply (rule r_into_trancl) 
15072  672 
apply (simp add: mult1_def set_of_def, blast) 
11464  673 
txt {* Now we know @{term "J' \<noteq> {#}"}. *} 
23751  674 
apply (cut_tac M = K and P = "\<lambda>x. (x, a) \<in> r" in multiset_partition) 
11464  675 
apply (erule_tac P = "\<forall>k \<in> set_of K. ?P k" in rev_mp) 
10249  676 
apply (erule ssubst) 
15072  677 
apply (simp add: Ball_def, auto) 
10249  678 
apply (subgoal_tac 
23751  679 
"((I + {# x : K. (x, a) \<in> r #}) + {# x : K. (x, a) \<notin> r #}, 
680 
(I + {# x : K. (x, a) \<in> r #}) + J') \<in> mult r") 

10249  681 
prefer 2 
682 
apply force 

683 
apply (simp (no_asm_use) add: union_assoc [symmetric] mult_def) 

23751  684 
apply (erule trancl_trans) 
685 
apply (rule r_into_trancl) 

10249  686 
apply (simp add: mult1_def set_of_def) 
687 
apply (rule_tac x = a in exI) 

688 
apply (rule_tac x = "I + J'" in exI) 

689 
apply (simp add: union_ac) 

690 
done 

691 

17161  692 
lemma one_step_implies_mult: 
23751  693 
"trans r ==> J \<noteq> {#} ==> \<forall>k \<in> set_of K. \<exists>j \<in> set_of J. (k, j) \<in> r 
694 
==> (I + K, I + J) \<in> mult r" 

23373  695 
using one_step_implies_mult_aux by blast 
10249  696 

697 

698 
subsubsection {* Partialorder properties *} 

699 

12338
de0f4a63baa5
renamed class "term" to "type" (actually "HOL.type");
wenzelm
parents:
11868
diff
changeset

700 
instance multiset :: (type) ord .. 
10249  701 

702 
defs (overloaded) 

23751  703 
less_multiset_def: "M' < M == (M', M) \<in> mult {(x', x). x' < x}" 
11464  704 
le_multiset_def: "M' <= M == M' = M \<or> M' < (M::'a multiset)" 
10249  705 

23751  706 
lemma trans_base_order: "trans {(x', x). x' < (x::'a::order)}" 
18730  707 
unfolding trans_def by (blast intro: order_less_trans) 
10249  708 

709 
text {* 

710 
\medskip Irreflexivity. 

711 
*} 

712 

713 
lemma mult_irrefl_aux: 

18258  714 
"finite A ==> (\<forall>x \<in> A. \<exists>y \<in> A. x < (y::'a::order)) \<Longrightarrow> A = {}" 
23373  715 
by (induct rule: finite_induct) (auto intro: order_less_trans) 
10249  716 

17161  717 
lemma mult_less_not_refl: "\<not> M < (M::'a::order multiset)" 
15072  718 
apply (unfold less_multiset_def, auto) 
719 
apply (drule trans_base_order [THEN mult_implies_one_step], auto) 

10249  720 
apply (drule finite_set_of [THEN mult_irrefl_aux [rule_format (no_asm)]]) 
721 
apply (simp add: set_of_eq_empty_iff) 

722 
done 

723 

724 
lemma mult_less_irrefl [elim!]: "M < (M::'a::order multiset) ==> R" 

23373  725 
using insert mult_less_not_refl by fast 
10249  726 

727 

728 
text {* Transitivity. *} 

729 

730 
theorem mult_less_trans: "K < M ==> M < N ==> K < (N::'a::order multiset)" 

23751  731 
unfolding less_multiset_def mult_def by (blast intro: trancl_trans) 
10249  732 

733 
text {* Asymmetry. *} 

734 

11464  735 
theorem mult_less_not_sym: "M < N ==> \<not> N < (M::'a::order multiset)" 
10249  736 
apply auto 
737 
apply (rule mult_less_not_refl [THEN notE]) 

15072  738 
apply (erule mult_less_trans, assumption) 
10249  739 
done 
740 

741 
theorem mult_less_asym: 

11464  742 
"M < N ==> (\<not> P ==> N < (M::'a::order multiset)) ==> P" 
15072  743 
by (insert mult_less_not_sym, blast) 
10249  744 

745 
theorem mult_le_refl [iff]: "M <= (M::'a::order multiset)" 

18730  746 
unfolding le_multiset_def by auto 
10249  747 

748 
text {* Antisymmetry. *} 

749 

750 
theorem mult_le_antisym: 

751 
"M <= N ==> N <= M ==> M = (N::'a::order multiset)" 

18730  752 
unfolding le_multiset_def by (blast dest: mult_less_not_sym) 
10249  753 

754 
text {* Transitivity. *} 

755 

756 
theorem mult_le_trans: 

757 
"K <= M ==> M <= N ==> K <= (N::'a::order multiset)" 

18730  758 
unfolding le_multiset_def by (blast intro: mult_less_trans) 
10249  759 

11655  760 
theorem mult_less_le: "(M < N) = (M <= N \<and> M \<noteq> (N::'a::order multiset))" 
18730  761 
unfolding le_multiset_def by auto 
10249  762 

10277  763 
text {* Partial order. *} 
764 

765 
instance multiset :: (order) order 

766 
apply intro_classes 

23751  767 
apply (rule mult_less_le) 
768 
apply (rule mult_le_refl) 

769 
apply (erule mult_le_trans, assumption) 

770 
apply (erule mult_le_antisym, assumption) 

10277  771 
done 
772 

10249  773 

774 
subsubsection {* Monotonicity of multiset union *} 

775 

17161  776 
lemma mult1_union: 
23751  777 
"(B, D) \<in> mult1 r ==> trans r ==> (C + B, C + D) \<in> mult1 r" 
15072  778 
apply (unfold mult1_def, auto) 
10249  779 
apply (rule_tac x = a in exI) 
780 
apply (rule_tac x = "C + M0" in exI) 

781 
apply (simp add: union_assoc) 

782 
done 

783 

784 
lemma union_less_mono2: "B < D ==> C + B < C + (D::'a::order multiset)" 

785 
apply (unfold less_multiset_def mult_def) 

23751  786 
apply (erule trancl_induct) 
787 
apply (blast intro: mult1_union transI order_less_trans r_into_trancl) 

788 
apply (blast intro: mult1_union transI order_less_trans r_into_trancl trancl_trans) 

10249  789 
done 
790 

791 
lemma union_less_mono1: "B < D ==> B + C < D + (C::'a::order multiset)" 

792 
apply (subst union_commute [of B C]) 

793 
apply (subst union_commute [of D C]) 

794 
apply (erule union_less_mono2) 

795 
done 

796 

17161  797 
lemma union_less_mono: 
10249  798 
"A < C ==> B < D ==> A + B < C + (D::'a::order multiset)" 
799 
apply (blast intro!: union_less_mono1 union_less_mono2 mult_less_trans) 

800 
done 

801 

17161  802 
lemma union_le_mono: 
10249  803 
"A <= C ==> B <= D ==> A + B <= C + (D::'a::order multiset)" 
18730  804 
unfolding le_multiset_def 
805 
by (blast intro: union_less_mono union_less_mono1 union_less_mono2) 

10249  806 

17161  807 
lemma empty_leI [iff]: "{#} <= (M::'a::order multiset)" 
10249  808 
apply (unfold le_multiset_def less_multiset_def) 
809 
apply (case_tac "M = {#}") 

810 
prefer 2 

23751  811 
apply (subgoal_tac "({#} + {#}, {#} + M) \<in> mult (Collect (split op <))") 
10249  812 
prefer 2 
813 
apply (rule one_step_implies_mult) 

23751  814 
apply (simp only: trans_def, auto) 
10249  815 
done 
816 

17161  817 
lemma union_upper1: "A <= A + (B::'a::order multiset)" 
15072  818 
proof  
17200  819 
have "A + {#} <= A + B" by (blast intro: union_le_mono) 
18258  820 
then show ?thesis by simp 
15072  821 
qed 
822 

17161  823 
lemma union_upper2: "B <= A + (B::'a::order multiset)" 
18258  824 
by (subst union_commute) (rule union_upper1) 
15072  825 

23611  826 
instance multiset :: (order) pordered_ab_semigroup_add 
827 
apply intro_classes 

828 
apply(erule union_le_mono[OF mult_le_refl]) 

829 
done 

15072  830 

17200  831 
subsection {* Link with lists *} 
15072  832 

17200  833 
consts 
15072  834 
multiset_of :: "'a list \<Rightarrow> 'a multiset" 
835 
primrec 

836 
"multiset_of [] = {#}" 

837 
"multiset_of (a # x) = multiset_of x + {# a #}" 

838 

839 
lemma multiset_of_zero_iff[simp]: "(multiset_of x = {#}) = (x = [])" 

18258  840 
by (induct x) auto 
15072  841 

842 
lemma multiset_of_zero_iff_right[simp]: "({#} = multiset_of x) = (x = [])" 

18258  843 
by (induct x) auto 
15072  844 

845 
lemma set_of_multiset_of[simp]: "set_of(multiset_of x) = set x" 

18258  846 
by (induct x) auto 
15867  847 

848 
lemma mem_set_multiset_eq: "x \<in> set xs = (x :# multiset_of xs)" 

849 
by (induct xs) auto 

15072  850 

18258  851 
lemma multiset_of_append [simp]: 
852 
"multiset_of (xs @ ys) = multiset_of xs + multiset_of ys" 

20503  853 
by (induct xs arbitrary: ys) (auto simp: union_ac) 
18730  854 

15072  855 
lemma surj_multiset_of: "surj multiset_of" 
17200  856 
apply (unfold surj_def, rule allI) 
857 
apply (rule_tac M=y in multiset_induct, auto) 

858 
apply (rule_tac x = "x # xa" in exI, auto) 

10249  859 
done 
860 

25162  861 
lemma set_count_greater_0: "set x = {a. count (multiset_of x) a > 0}" 
18258  862 
by (induct x) auto 
15072  863 

17200  864 
lemma distinct_count_atmost_1: 
15072  865 
"distinct x = (! a. count (multiset_of x) a = (if a \<in> set x then 1 else 0))" 
18258  866 
apply (induct x, simp, rule iffI, simp_all) 
17200  867 
apply (rule conjI) 
868 
apply (simp_all add: set_of_multiset_of [THEN sym] del: set_of_multiset_of) 

15072  869 
apply (erule_tac x=a in allE, simp, clarify) 
17200  870 
apply (erule_tac x=aa in allE, simp) 
15072  871 
done 
872 

17200  873 
lemma multiset_of_eq_setD: 
15867  874 
"multiset_of xs = multiset_of ys \<Longrightarrow> set xs = set ys" 
875 
by (rule) (auto simp add:multiset_eq_conv_count_eq set_count_greater_0) 

876 

17200  877 
lemma set_eq_iff_multiset_of_eq_distinct: 
878 
"\<lbrakk>distinct x; distinct y\<rbrakk> 

15072  879 
\<Longrightarrow> (set x = set y) = (multiset_of x = multiset_of y)" 
17200  880 
by (auto simp: multiset_eq_conv_count_eq distinct_count_atmost_1) 
15072  881 

17200  882 
lemma set_eq_iff_multiset_of_remdups_eq: 
15072  883 
"(set x = set y) = (multiset_of (remdups x) = multiset_of (remdups y))" 
17200  884 
apply (rule iffI) 
885 
apply (simp add: set_eq_iff_multiset_of_eq_distinct[THEN iffD1]) 

886 
apply (drule distinct_remdups[THEN distinct_remdups 

887 
[THEN set_eq_iff_multiset_of_eq_distinct[THEN iffD2]]]) 

15072  888 
apply simp 
10249  889 
done 
890 

18258  891 
lemma multiset_of_compl_union [simp]: 
23281  892 
"multiset_of [x\<leftarrow>xs. P x] + multiset_of [x\<leftarrow>xs. \<not>P x] = multiset_of xs" 
15630  893 
by (induct xs) (auto simp: union_ac) 
15072  894 

17200  895 
lemma count_filter: 
23281  896 
"count (multiset_of xs) x = length [y \<leftarrow> xs. y = x]" 
18258  897 
by (induct xs) auto 
15867  898 

899 

15072  900 
subsection {* Pointwise ordering induced by count *} 
901 

19086  902 
definition 
25610  903 
mset_le :: "'a multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" (infix "\<le>#" 50) where 
904 
"(A \<le># B) = (\<forall>a. count A a \<le> count B a)" 

23611  905 
definition 
25610  906 
mset_less :: "'a multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" (infix "<#" 50) where 
907 
"(A <# B) = (A \<le># B \<and> A \<noteq> B)" 

908 

909 
notation mset_le (infix "\<subseteq>#" 50) 

910 
notation mset_less (infix "\<subset>#" 50) 

15072  911 

23611  912 
lemma mset_le_refl[simp]: "A \<le># A" 
18730  913 
unfolding mset_le_def by auto 
15072  914 

23611  915 
lemma mset_le_trans: "\<lbrakk> A \<le># B; B \<le># C \<rbrakk> \<Longrightarrow> A \<le># C" 
18730  916 
unfolding mset_le_def by (fast intro: order_trans) 
15072  917 

23611  918 
lemma mset_le_antisym: "\<lbrakk> A \<le># B; B \<le># A \<rbrakk> \<Longrightarrow> A = B" 
17200  919 
apply (unfold mset_le_def) 
920 
apply (rule multiset_eq_conv_count_eq[THEN iffD2]) 

15072  921 
apply (blast intro: order_antisym) 
922 
done 

923 

17200  924 
lemma mset_le_exists_conv: 
23611  925 
"(A \<le># B) = (\<exists>C. B = A + C)" 
926 
apply (unfold mset_le_def, rule iffI, rule_tac x = "B  A" in exI) 

15072  927 
apply (auto intro: multiset_eq_conv_count_eq [THEN iffD2]) 
928 
done 

929 

23611  930 
lemma mset_le_mono_add_right_cancel[simp]: "(A + C \<le># B + C) = (A \<le># B)" 
18730  931 
unfolding mset_le_def by auto 
15072  932 

23611  933 
lemma mset_le_mono_add_left_cancel[simp]: "(C + A \<le># C + B) = (A \<le># B)" 
18730  934 
unfolding mset_le_def by auto 
15072  935 

23611  936 
lemma mset_le_mono_add: "\<lbrakk> A \<le># B; C \<le># D \<rbrakk> \<Longrightarrow> A + C \<le># B + D" 
17200  937 
apply (unfold mset_le_def) 
938 
apply auto 

15072  939 
apply (erule_tac x=a in allE)+ 
940 
apply auto 

941 
done 

942 

23611  943 
lemma mset_le_add_left[simp]: "A \<le># A + B" 
18730  944 
unfolding mset_le_def by auto 
15072  945 

23611  946 
lemma mset_le_add_right[simp]: "B \<le># A + B" 
18730  947 
unfolding mset_le_def by auto 
15072  948 

23611  949 
lemma multiset_of_remdups_le: "multiset_of (remdups xs) \<le># multiset_of xs" 
950 
apply (induct xs) 

951 
apply auto 

952 
apply (rule mset_le_trans) 

953 
apply auto 

954 
done 

955 

25208  956 
interpretation mset_order: 
957 
order ["op \<le>#" "op <#"] 

958 
by (auto intro: order.intro mset_le_refl mset_le_antisym 

959 
mset_le_trans simp: mset_less_def) 

23611  960 

961 
interpretation mset_order_cancel_semigroup: 

25208  962 
pordered_cancel_ab_semigroup_add ["op \<le>#" "op <#" "op +"] 
963 
by unfold_locales (erule mset_le_mono_add [OF mset_le_refl]) 

23611  964 

965 
interpretation mset_order_semigroup_cancel: 

25208  966 
pordered_ab_semigroup_add_imp_le ["op \<le>#" "op <#" "op +"] 
967 
by (unfold_locales) simp 

15072  968 

25610  969 

970 
lemma mset_lessD: 

971 
"\<lbrakk> A \<subset># B ; x \<in># A \<rbrakk> \<Longrightarrow> x \<in># B" 

972 
apply (clarsimp simp: mset_le_def mset_less_def) 

973 
apply (erule_tac x=x in allE) 

974 
apply auto 

975 
done 

976 

977 
lemma mset_leD: 

978 
"\<lbrakk> A \<subseteq># B ; x \<in># A \<rbrakk> \<Longrightarrow> x \<in># B" 

979 
apply (clarsimp simp: mset_le_def mset_less_def) 

980 
apply (erule_tac x=x in allE) 

981 
apply auto 

982 
done 

983 

984 
lemma mset_less_insertD: 

985 
"(A + {#x#} \<subset># B) \<Longrightarrow> (x \<in># B \<and> A \<subset># B)" 

986 
apply (rule conjI) 

987 
apply (simp add: mset_lessD) 

988 
apply (clarsimp simp: mset_le_def mset_less_def) 

989 
apply safe 

990 
apply (erule_tac x=a in allE) 

991 
apply (auto split: split_if_asm) 

992 
done 

993 

994 
lemma mset_le_insertD: 

995 
"(A + {#x#} \<subseteq># B) \<Longrightarrow> (x \<in># B \<and> A \<subseteq># B)" 

996 
apply (rule conjI) 

997 
apply (simp add: mset_leD) 

998 
apply (force simp: mset_le_def mset_less_def split: split_if_asm) 

999 
done 

1000 

1001 
lemma mset_less_of_empty[simp]: "A \<subset># {#} = False" 

1002 
by (induct A, auto simp: mset_le_def mset_less_def) 

1003 

1004 
lemma multi_psub_of_add_self[simp]: "A \<subset># A + {#x#}" 

1005 
by (clarsimp simp: mset_le_def mset_less_def) 

1006 

1007 
lemma multi_psub_self[simp]: "A \<subset># A = False" 

1008 
by (clarsimp simp: mset_le_def mset_less_def) 

1009 

1010 
lemma mset_less_add_bothsides: 

1011 
"T + {#x#} \<subset># S + {#x#} \<Longrightarrow> T \<subset># S" 

1012 
by (clarsimp simp: mset_le_def mset_less_def) 

1013 

1014 
lemma mset_less_empty_nonempty: "({#} \<subset># S) = (S \<noteq> {#})" 

1015 
by (auto simp: mset_le_def mset_less_def) 

1016 

1017 
lemma mset_less_size: "A \<subset># B \<Longrightarrow> size A < size B" 

1018 
proof (induct A arbitrary: B) 

1019 
case (empty M) 

1020 
hence "M \<noteq> {#}" by (simp add: mset_less_empty_nonempty) 

1021 
then obtain M' x where "M = M' + {#x#}" 

1022 
by (blast dest: multi_nonempty_split) 

1023 
thus ?case by simp 

1024 
next 

1025 
case (add S x T) 

1026 
have IH: "\<And>B. S \<subset># B \<Longrightarrow> size S < size B" by fact 

1027 
have SxsubT: "S + {#x#} \<subset># T" by fact 

1028 
hence "x \<in># T" and "S \<subset># T" by (auto dest: mset_less_insertD) 

1029 
then obtain T' where T: "T = T' + {#x#}" 

1030 
by (blast dest: multi_member_split) 

1031 
hence "S \<subset># T'" using SxsubT 

1032 
by (blast intro: mset_less_add_bothsides) 

1033 
hence "size S < size T'" using IH by simp 

1034 
thus ?case using T by simp 

1035 
qed 

1036 

1037 
lemmas mset_less_trans = mset_order.less_eq_less.less_trans 

1038 

1039 
lemma mset_less_diff_self: "c \<in># B \<Longrightarrow> B  {#c#} \<subset># B" 

1040 
by (auto simp: mset_le_def mset_less_def multi_drop_mem_not_eq) 

1041 

1042 
subsection {* Strong induction and subset induction for multisets *} 

1043 

1044 
subsubsection {* Wellfoundedness of proper subset operator *} 

1045 

1046 
definition 

1047 
mset_less_rel :: "('a multiset * 'a multiset) set" 

1048 
where 

1049 
{* proper multiset subset *} 

1050 
"mset_less_rel \<equiv> {(A,B). A \<subset># B}" 

1051 

1052 
lemma multiset_add_sub_el_shuffle: 

1053 
assumes cinB: "c \<in># B" and bnotc: "b \<noteq> c" 

1054 
shows "B  {#c#} + {#b#} = B + {#b#}  {#c#}" 

1055 
proof  

1056 
from cinB obtain A where B: "B = A + {#c#}" 

1057 
by (blast dest: multi_member_split) 

1058 
have "A + {#b#} = A + {#b#} + {#c#}  {#c#}" by simp 

1059 
hence "A + {#b#} = A + {#c#} + {#b#}  {#c#}" 

1060 
by (simp add: union_ac) 

1061 
thus ?thesis using B by simp 

1062 
qed 

1063 

1064 
lemma wf_mset_less_rel: "wf mset_less_rel" 

1065 
apply (unfold mset_less_rel_def) 

1066 
apply (rule wf_measure [THEN wf_subset, where f1=size]) 

1067 
apply (clarsimp simp: measure_def inv_image_def mset_less_size) 

1068 
done 

1069 

1070 
subsubsection {* The induction rules *} 

1071 

1072 
lemma full_multiset_induct [case_names less]: 

1073 
assumes ih: "\<And>B. \<forall>A. A \<subset># B \<longrightarrow> P A \<Longrightarrow> P B" 

1074 
shows "P B" 

1075 
apply (rule wf_mset_less_rel [THEN wf_induct]) 

1076 
apply (rule ih, auto simp: mset_less_rel_def) 

1077 
done 

1078 

1079 
lemma multi_subset_induct [consumes 2, case_names empty add]: 

1080 
assumes "F \<subseteq># A" 

1081 
and empty: "P {#}" 

1082 
and insert: "\<And>a F. a \<in># A \<Longrightarrow> P F \<Longrightarrow> P (F + {#a#})" 

1083 
shows "P F" 

1084 
proof  

1085 
from `F \<subseteq># A` 

1086 
show ?thesis 

1087 
proof (induct F) 

1088 
show "P {#}" by fact 

1089 
next 

1090 
fix x F 

1091 
assume P: "F \<subseteq># A \<Longrightarrow> P F" and i: "F + {#x#} \<subseteq># A" 

1092 
show "P (F + {#x#})" 

1093 
proof (rule insert) 

1094 
from i show "x \<in># A" by (auto dest: mset_le_insertD) 

1095 
from i have "F \<subseteq># A" by (auto simp: mset_le_insertD) 

1096 
with P show "P F" . 

1097 
qed 

1098 
qed 

1099 
qed 

1100 

1101 
subsection {* Multiset extensionality *} 

1102 

1103 
lemma multi_count_eq: 

1104 
"(\<forall>x. count A x = count B x) = (A = B)" 

1105 
apply (rule iffI) 

1106 
prefer 2 

1107 
apply clarsimp 

1108 
apply (induct A arbitrary: B rule: full_multiset_induct) 

1109 
apply (rename_tac C) 

1110 
apply (case_tac B rule: multiset_cases) 

1111 
apply (simp add: empty_multiset_count) 

1112 
apply simp 

1113 
apply (case_tac "x \<in># C") 

1114 
apply (force dest: multi_member_split) 

1115 
apply (erule_tac x=x in allE) 

1116 
apply simp 

1117 
done 

1118 

1119 
lemmas multi_count_ext = multi_count_eq [THEN iffD1, rule_format] 

1120 

1121 
subsection {* The fold combinator *} 

1122 

1123 
text {* The intended behaviour is 

1124 
@{text "foldM f z {#x\<^isub>1, ..., x\<^isub>n#} = f x\<^isub>1 (\<dots> (f x\<^isub>n z)\<dots>)"} 

1125 
if @{text f} is associativecommutative. 

1126 
*} 

1127 

1128 
(* the graph of foldM, z = the start element, f = folding function, 

1129 
A the multiset, y the result *) 

1130 
inductive 

1131 
foldMG :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a multiset \<Rightarrow> 'b \<Rightarrow> bool" 

1132 
for f :: "'a \<Rightarrow> 'b \<Rightarrow> 'b" 

1133 
and z :: 'b 

1134 
where 

1135 
emptyI [intro]: "foldMG f z {#} z" 

1136 
 insertI [intro]: "foldMG f z A y \<Longrightarrow> foldMG f z (A + {#x#}) (f x y)" 

1137 

1138 
inductive_cases empty_foldMGE [elim!]: "foldMG f z {#} x" 

1139 
inductive_cases insert_foldMGE: "foldMG f z (A + {#}) y" 

1140 

1141 
definition 

1142 
foldM :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a multiset \<Rightarrow> 'b" 

1143 
where 

1144 
"foldM f z A \<equiv> THE x. foldMG f z A x" 

1145 

1146 
lemma Diff1_foldMG: 

1147 
"\<lbrakk> foldMG f z (A  {#x#}) y; x \<in># A \<rbrakk> \<Longrightarrow> foldMG f z A (f x y)" 

1148 
by (frule_tac x=x in foldMG.insertI, auto) 

1149 

1150 
lemma foldMG_nonempty: "\<exists>x. foldMG f z A x" 

1151 
apply (induct A) 

1152 
apply blast 

1153 
apply clarsimp 

1154 
apply (drule_tac x=x in foldMG.insertI) 

1155 
apply auto 

1156 
done 

1157 

1158 
lemma foldM_empty[simp]: "foldM f z {#} = z" 

1159 
by (unfold foldM_def, blast) 

1160 

1161 
locale left_commutative = 

1162 
fixes f :: "'a => 'b => 'b" (infixl "\<cdot>" 70) 

1163 
assumes left_commute: "x \<cdot> (y \<cdot> z) = y \<cdot> (x \<cdot> z)" 

1164 

1165 
lemma (in left_commutative) foldMG_determ: 

1166 
"\<lbrakk>foldMG f z A x; foldMG f z A y\<rbrakk> \<Longrightarrow> y = x" 

1167 
proof (induct arbitrary: x y z rule: full_multiset_induct) 

1168 
case (less M x\<^isub>1 x\<^isub>2 Z) 

1169 
have IH: "\<forall>A. A \<subset># M \<longrightarrow> 

1170 
(\<forall>x x' x''. foldMG op \<cdot> x'' A x \<longrightarrow> foldMG op \<cdot> x'' A x' 

1171 
\<longrightarrow> x' = x)" by fact 

1172 
have Mfoldx\<^isub>1: "foldMG f Z M x\<^isub>1" and Mfoldx\<^isub>2: "foldMG f Z M x\<^isub>2" by fact+ 

1173 
show ?case 

1174 
proof (rule foldMG.cases [OF Mfoldx\<^isub>1]) 

1175 
assume "M = {#}" and "x\<^isub>1 = Z" 

1176 
thus ?case using Mfoldx\<^isub>2 by auto 

1177 
next 

1178 
fix B b u 

1179 
assume "M = B + {#b#}" and "x\<^isub>1 = b \<cdot> u" and Bu: "foldMG op \<cdot> Z B u" 

1180 
hence MBb: "M = B + {#b#}" and x\<^isub>1: "x\<^isub>1 = b \<cdot> u" by auto 

1181 
show ?case 

1182 
proof (rule foldMG.cases [OF Mfoldx\<^isub>2]) 

1183 
assume "M = {#}" "x\<^isub>2 = Z" 

1184 
thus ?case using Mfoldx\<^isub>1 by auto 

1185 
next 

1186 
fix C c v 

1187 
assume "M = C + {#c#}" and "x\<^isub>2 = c \<cdot> v" and Cv: "foldMG op \<cdot> Z C v" 

1188 
hence MCc: "M = C + {#c#}" and x\<^isub>2: "x\<^isub>2 = c \<cdot> v" by auto 

1189 
hence CsubM: "C \<subset># M" by simp 

1190 
from MBb have BsubM: "B \<subset># M" by simp 

1191 
show ?case 

1192 
proof cases 

1193 
assume "b=c" 

1194 
then moreover have "B = C" using MBb MCc by auto 

1195 
ultimately show ?thesis using Bu Cv x\<^isub>1 x\<^isub>2 CsubM IH by auto 

1196 
next 

1197 
assume diff: "b \<noteq> c" 

1198 
let ?D = "B  {#c#}" 

1199 
have cinB: "c \<in># B" and binC: "b \<in># C" using MBb MCc diff 

1200 
by (auto intro: insert_noteq_member dest: sym) 

1201 
have "B  {#c#} \<subset># B" using cinB by (rule mset_less_diff_self) 

1202 
hence DsubM: "?D \<subset># M" using BsubM by (blast intro: mset_less_trans) 

1203 
from MBb MCc have "B + {#b#} = C + {#c#}" by blast 

1204 
hence [simp]: "B + {#b#}  {#c#} = C" 

1205 
using MBb MCc binC cinB by auto 

1206 
have B: "B = ?D + {#c#}" and C: "C = ?D + {#b#}" 

1207 
using MBb MCc diff binC cinB 

1208 
by (auto simp: multiset_add_sub_el_shuffle) 

1209 
then obtain d where Dfoldd: "foldMG f Z ?D d" 

1210 
using foldMG_nonempty by iprover 

1211 
hence "foldMG f Z B (c \<cdot> d)" using cinB 

1212 
by (rule Diff1_foldMG) 

1213 
hence "c \<cdot> d = u" using IH BsubM Bu by blast 

1214 
moreover 

1215 
have "foldMG f Z C (b \<cdot> d)" using binC cinB diff Dfoldd 

1216 
by (auto simp: multiset_add_sub_el_shuffle 

1217 
dest: foldMG.insertI [where x=b]) 

1218 
hence "b \<cdot> d = v" using IH CsubM Cv by blast 

1219 
ultimately show ?thesis using x\<^isub>1 x\<^isub>2 

1220 
by (auto simp: left_commute) 

1221 
qed 

1222 
qed 

1223 
qed 

1224 
qed 

1225 

1226 
lemma (in left_commutative) foldM_insert_aux: " 

1227 
(foldMG f z (A + {#x#}) v) = 

1228 
(\<exists>y. foldMG f z A y \<and> v = f x y)" 

1229 
apply (rule iffI) 

1230 
prefer 2 

1231 
apply blast 

1232 
apply (rule_tac A=A and f=f in foldMG_nonempty [THEN exE, standard]) 

1233 
apply (blast intro: foldMG_determ) 

1234 
done 

1235 

1236 
lemma (in left_commutative) foldM_equality: "foldMG f z A y \<Longrightarrow> foldM f z A = y" 

1237 
by (unfold foldM_def) (blast intro: foldMG_determ) 

1238 

1239 
lemma (in left_commutative) foldM_insert[simp]: 

1240 
"foldM f z (A + {#x#}) = f x (foldM f z A)" 

1241 
apply (simp add: foldM_def foldM_insert_aux union_commute) 

1242 
apply (rule the_equality) 

1243 
apply (auto cong add: conj_cong 

1244 
simp add: foldM_def [symmetric] foldM_equality foldMG_nonempty) 

1245 
done 

1246 

1247 
lemma (in left_commutative) foldM_insert_idem: 

1248 
shows "foldM f z (A + {#a#}) = a \<cdot> foldM f z A" 

1249 
apply (simp add: foldM_def foldM_insert_aux) 

1250 
apply (rule the_equality) 

1251 
apply (auto cong add: conj_cong 

1252 
simp add: foldM_def [symmetric] foldM_equality foldMG_nonempty) 

1253 
done 

1254 

1255 
lemma (in left_commutative) foldM_fusion: 

1256 
includes left_commutative g 

1257 
shows "\<lbrakk>\<And>x y. h (g x y) = f x (h y) \<rbrakk> \<Longrightarrow> h (foldM g w A) = foldM f (h w) A" 

1258 
by (induct A, auto) 

1259 

1260 
lemma (in left_commutative) foldM_commute: 

1261 
"f x (foldM f z A) = foldM f (f x z) A" 

1262 
by (induct A, auto simp: left_commute [of x]) 

1263 

1264 
lemma (in left_commutative) foldM_rec: 

1265 
assumes a: "a \<in># A" 

1266 
shows "foldM f z A = f a (foldM f z (A  {#a#}))" 

1267 
proof  

1268 
from a obtain A' where "A = A' + {#a#}" by (blast dest: multi_member_split) 

1269 
thus ?thesis by simp 

1270 
qed 

1271 

1272 

10249  1273 
end 