|
1 (* |
|
2 File: Multiset_Permutations.thy |
|
3 Author: Manuel Eberl (TU München) |
|
4 |
|
5 Defines the set of permutations of a given multiset (or set), i.e. the set of all lists whose |
|
6 entries correspond to the multiset (resp. set). |
|
7 *) |
|
8 section \<open>Permutations of a Multiset\<close> |
|
9 theory Multiset_Permutations |
|
10 imports |
|
11 Complex_Main |
|
12 "~~/src/HOL/Library/Multiset" |
|
13 "~~/src/HOL/Library/Permutations" |
|
14 begin |
|
15 |
|
16 (* TODO Move *) |
|
17 lemma mset_tl: "xs \<noteq> [] \<Longrightarrow> mset (tl xs) = mset xs - {#hd xs#}" |
|
18 by (cases xs) simp_all |
|
19 |
|
20 lemma mset_set_image_inj: |
|
21 assumes "inj_on f A" |
|
22 shows "mset_set (f ` A) = image_mset f (mset_set A)" |
|
23 proof (cases "finite A") |
|
24 case True |
|
25 from this and assms show ?thesis by (induction A) auto |
|
26 qed (insert assms, simp add: finite_image_iff) |
|
27 |
|
28 lemma multiset_remove_induct [case_names empty remove]: |
|
29 assumes "P {#}" "\<And>A. A \<noteq> {#} \<Longrightarrow> (\<And>x. x \<in># A \<Longrightarrow> P (A - {#x#})) \<Longrightarrow> P A" |
|
30 shows "P A" |
|
31 proof (induction A rule: full_multiset_induct) |
|
32 case (less A) |
|
33 hence IH: "P B" if "B \<subset># A" for B using that by blast |
|
34 show ?case |
|
35 proof (cases "A = {#}") |
|
36 case True |
|
37 thus ?thesis by (simp add: assms) |
|
38 next |
|
39 case False |
|
40 hence "P (A - {#x#})" if "x \<in># A" for x |
|
41 using that by (intro IH) (simp add: mset_subset_diff_self) |
|
42 from False and this show "P A" by (rule assms) |
|
43 qed |
|
44 qed |
|
45 |
|
46 lemma map_list_bind: "map g (List.bind xs f) = List.bind xs (map g \<circ> f)" |
|
47 by (simp add: List.bind_def map_concat) |
|
48 |
|
49 lemma mset_eq_mset_set_imp_distinct: |
|
50 "finite A \<Longrightarrow> mset_set A = mset xs \<Longrightarrow> distinct xs" |
|
51 proof (induction xs arbitrary: A) |
|
52 case (Cons x xs A) |
|
53 from Cons.prems(2) have "x \<in># mset_set A" by simp |
|
54 with Cons.prems(1) have [simp]: "x \<in> A" by simp |
|
55 from Cons.prems have "x \<notin># mset_set (A - {x})" by simp |
|
56 also from Cons.prems have "mset_set (A - {x}) = mset_set A - {#x#}" |
|
57 by (subst mset_set_Diff) simp_all |
|
58 also have "mset_set A = mset (x#xs)" by (simp add: Cons.prems) |
|
59 also have "\<dots> - {#x#} = mset xs" by simp |
|
60 finally have [simp]: "x \<notin> set xs" by (simp add: in_multiset_in_set) |
|
61 from Cons.prems show ?case by (auto intro!: Cons.IH[of "A - {x}"] simp: mset_set_Diff) |
|
62 qed simp_all |
|
63 (* END TODO *) |
|
64 |
|
65 |
|
66 subsection \<open>Permutations of a multiset\<close> |
|
67 |
|
68 definition permutations_of_multiset :: "'a multiset \<Rightarrow> 'a list set" where |
|
69 "permutations_of_multiset A = {xs. mset xs = A}" |
|
70 |
|
71 lemma permutations_of_multisetI: "mset xs = A \<Longrightarrow> xs \<in> permutations_of_multiset A" |
|
72 by (simp add: permutations_of_multiset_def) |
|
73 |
|
74 lemma permutations_of_multisetD: "xs \<in> permutations_of_multiset A \<Longrightarrow> mset xs = A" |
|
75 by (simp add: permutations_of_multiset_def) |
|
76 |
|
77 lemma permutations_of_multiset_Cons_iff: |
|
78 "x # xs \<in> permutations_of_multiset A \<longleftrightarrow> x \<in># A \<and> xs \<in> permutations_of_multiset (A - {#x#})" |
|
79 by (auto simp: permutations_of_multiset_def) |
|
80 |
|
81 lemma permutations_of_multiset_empty [simp]: "permutations_of_multiset {#} = {[]}" |
|
82 unfolding permutations_of_multiset_def by simp |
|
83 |
|
84 lemma permutations_of_multiset_nonempty: |
|
85 assumes nonempty: "A \<noteq> {#}" |
|
86 shows "permutations_of_multiset A = |
|
87 (\<Union>x\<in>set_mset A. (op # x) ` permutations_of_multiset (A - {#x#}))" (is "_ = ?rhs") |
|
88 proof safe |
|
89 fix xs assume "xs \<in> permutations_of_multiset A" |
|
90 hence mset_xs: "mset xs = A" by (simp add: permutations_of_multiset_def) |
|
91 hence "xs \<noteq> []" by (auto simp: nonempty) |
|
92 then obtain x xs' where xs: "xs = x # xs'" by (cases xs) simp_all |
|
93 with mset_xs have "x \<in> set_mset A" "xs' \<in> permutations_of_multiset (A - {#x#})" |
|
94 by (auto simp: permutations_of_multiset_def) |
|
95 with xs show "xs \<in> ?rhs" by auto |
|
96 qed (auto simp: permutations_of_multiset_def) |
|
97 |
|
98 lemma permutations_of_multiset_singleton [simp]: "permutations_of_multiset {#x#} = {[x]}" |
|
99 by (simp add: permutations_of_multiset_nonempty) |
|
100 |
|
101 lemma permutations_of_multiset_doubleton: |
|
102 "permutations_of_multiset {#x,y#} = {[x,y], [y,x]}" |
|
103 by (simp add: permutations_of_multiset_nonempty insert_commute) |
|
104 |
|
105 lemma rev_permutations_of_multiset [simp]: |
|
106 "rev ` permutations_of_multiset A = permutations_of_multiset A" |
|
107 proof |
|
108 have "rev ` rev ` permutations_of_multiset A \<subseteq> rev ` permutations_of_multiset A" |
|
109 unfolding permutations_of_multiset_def by auto |
|
110 also have "rev ` rev ` permutations_of_multiset A = permutations_of_multiset A" |
|
111 by (simp add: image_image) |
|
112 finally show "permutations_of_multiset A \<subseteq> rev ` permutations_of_multiset A" . |
|
113 next |
|
114 show "rev ` permutations_of_multiset A \<subseteq> permutations_of_multiset A" |
|
115 unfolding permutations_of_multiset_def by auto |
|
116 qed |
|
117 |
|
118 lemma length_finite_permutations_of_multiset: |
|
119 "xs \<in> permutations_of_multiset A \<Longrightarrow> length xs = size A" |
|
120 by (auto simp: permutations_of_multiset_def) |
|
121 |
|
122 lemma permutations_of_multiset_lists: "permutations_of_multiset A \<subseteq> lists (set_mset A)" |
|
123 by (auto simp: permutations_of_multiset_def) |
|
124 |
|
125 lemma finite_permutations_of_multiset [simp]: "finite (permutations_of_multiset A)" |
|
126 proof (rule finite_subset) |
|
127 show "permutations_of_multiset A \<subseteq> {xs. set xs \<subseteq> set_mset A \<and> length xs = size A}" |
|
128 by (auto simp: permutations_of_multiset_def) |
|
129 show "finite {xs. set xs \<subseteq> set_mset A \<and> length xs = size A}" |
|
130 by (rule finite_lists_length_eq) simp_all |
|
131 qed |
|
132 |
|
133 lemma permutations_of_multiset_not_empty [simp]: "permutations_of_multiset A \<noteq> {}" |
|
134 proof - |
|
135 from ex_mset[of A] guess xs .. |
|
136 thus ?thesis by (auto simp: permutations_of_multiset_def) |
|
137 qed |
|
138 |
|
139 lemma permutations_of_multiset_image: |
|
140 "permutations_of_multiset (image_mset f A) = map f ` permutations_of_multiset A" |
|
141 proof safe |
|
142 fix xs assume A: "xs \<in> permutations_of_multiset (image_mset f A)" |
|
143 from ex_mset[of A] obtain ys where ys: "mset ys = A" .. |
|
144 with A have "mset xs = mset (map f ys)" |
|
145 by (simp add: permutations_of_multiset_def) |
|
146 from mset_eq_permutation[OF this] guess \<sigma> . note \<sigma> = this |
|
147 with ys have "xs = map f (permute_list \<sigma> ys)" |
|
148 by (simp add: permute_list_map) |
|
149 moreover from \<sigma> ys have "permute_list \<sigma> ys \<in> permutations_of_multiset A" |
|
150 by (simp add: permutations_of_multiset_def) |
|
151 ultimately show "xs \<in> map f ` permutations_of_multiset A" by blast |
|
152 qed (auto simp: permutations_of_multiset_def) |
|
153 |
|
154 |
|
155 subsection \<open>Cardinality of permutations\<close> |
|
156 |
|
157 text \<open> |
|
158 In this section, we prove some basic facts about the number of permutations of a multiset. |
|
159 \<close> |
|
160 |
|
161 context |
|
162 begin |
|
163 |
|
164 private lemma multiset_setprod_fact_insert: |
|
165 "(\<Prod>y\<in>set_mset (A+{#x#}). fact (count (A+{#x#}) y)) = |
|
166 (count A x + 1) * (\<Prod>y\<in>set_mset A. fact (count A y))" |
|
167 proof - |
|
168 have "(\<Prod>y\<in>set_mset (A+{#x#}). fact (count (A+{#x#}) y)) = |
|
169 (\<Prod>y\<in>set_mset (A+{#x#}). (if y = x then count A x + 1 else 1) * fact (count A y))" |
|
170 by (intro setprod.cong) simp_all |
|
171 also have "\<dots> = (count A x + 1) * (\<Prod>y\<in>set_mset (A+{#x#}). fact (count A y))" |
|
172 by (simp add: setprod.distrib setprod.delta) |
|
173 also have "(\<Prod>y\<in>set_mset (A+{#x#}). fact (count A y)) = (\<Prod>y\<in>set_mset A. fact (count A y))" |
|
174 by (intro setprod.mono_neutral_right) (auto simp: not_in_iff) |
|
175 finally show ?thesis . |
|
176 qed |
|
177 |
|
178 private lemma multiset_setprod_fact_remove: |
|
179 "x \<in># A \<Longrightarrow> (\<Prod>y\<in>set_mset A. fact (count A y)) = |
|
180 count A x * (\<Prod>y\<in>set_mset (A-{#x#}). fact (count (A-{#x#}) y))" |
|
181 using multiset_setprod_fact_insert[of "A - {#x#}" x] by simp |
|
182 |
|
183 lemma card_permutations_of_multiset_aux: |
|
184 "card (permutations_of_multiset A) * (\<Prod>x\<in>set_mset A. fact (count A x)) = fact (size A)" |
|
185 proof (induction A rule: multiset_remove_induct) |
|
186 case (remove A) |
|
187 have "card (permutations_of_multiset A) = |
|
188 card (\<Union>x\<in>set_mset A. op # x ` permutations_of_multiset (A - {#x#}))" |
|
189 by (simp add: permutations_of_multiset_nonempty remove.hyps) |
|
190 also have "\<dots> = (\<Sum>x\<in>set_mset A. card (permutations_of_multiset (A - {#x#})))" |
|
191 by (subst card_UN_disjoint) (auto simp: card_image) |
|
192 also have "\<dots> * (\<Prod>x\<in>set_mset A. fact (count A x)) = |
|
193 (\<Sum>x\<in>set_mset A. card (permutations_of_multiset (A - {#x#})) * |
|
194 (\<Prod>y\<in>set_mset A. fact (count A y)))" |
|
195 by (subst setsum_distrib_right) simp_all |
|
196 also have "\<dots> = (\<Sum>x\<in>set_mset A. count A x * fact (size A - 1))" |
|
197 proof (intro setsum.cong refl) |
|
198 fix x assume x: "x \<in># A" |
|
199 have "card (permutations_of_multiset (A - {#x#})) * (\<Prod>y\<in>set_mset A. fact (count A y)) = |
|
200 count A x * (card (permutations_of_multiset (A - {#x#})) * |
|
201 (\<Prod>y\<in>set_mset (A - {#x#}). fact (count (A - {#x#}) y)))" (is "?lhs = _") |
|
202 by (subst multiset_setprod_fact_remove[OF x]) simp_all |
|
203 also note remove.IH[OF x] |
|
204 also from x have "size (A - {#x#}) = size A - 1" by (simp add: size_Diff_submset) |
|
205 finally show "?lhs = count A x * fact (size A - 1)" . |
|
206 qed |
|
207 also have "(\<Sum>x\<in>set_mset A. count A x * fact (size A - 1)) = |
|
208 size A * fact (size A - 1)" |
|
209 by (simp add: setsum_distrib_right size_multiset_overloaded_eq) |
|
210 also from remove.hyps have "\<dots> = fact (size A)" |
|
211 by (cases "size A") auto |
|
212 finally show ?case . |
|
213 qed simp_all |
|
214 |
|
215 theorem card_permutations_of_multiset: |
|
216 "card (permutations_of_multiset A) = fact (size A) div (\<Prod>x\<in>set_mset A. fact (count A x))" |
|
217 "(\<Prod>x\<in>set_mset A. fact (count A x) :: nat) dvd fact (size A)" |
|
218 by (simp_all add: card_permutations_of_multiset_aux[of A, symmetric]) |
|
219 |
|
220 lemma card_permutations_of_multiset_insert_aux: |
|
221 "card (permutations_of_multiset (A + {#x#})) * (count A x + 1) = |
|
222 (size A + 1) * card (permutations_of_multiset A)" |
|
223 proof - |
|
224 note card_permutations_of_multiset_aux[of "A + {#x#}"] |
|
225 also have "fact (size (A + {#x#})) = (size A + 1) * fact (size A)" by simp |
|
226 also note multiset_setprod_fact_insert[of A x] |
|
227 also note card_permutations_of_multiset_aux[of A, symmetric] |
|
228 finally have "card (permutations_of_multiset (A + {#x#})) * (count A x + 1) * |
|
229 (\<Prod>y\<in>set_mset A. fact (count A y)) = |
|
230 (size A + 1) * card (permutations_of_multiset A) * |
|
231 (\<Prod>x\<in>set_mset A. fact (count A x))" by (simp only: mult_ac) |
|
232 thus ?thesis by (subst (asm) mult_right_cancel) simp_all |
|
233 qed |
|
234 |
|
235 lemma card_permutations_of_multiset_remove_aux: |
|
236 assumes "x \<in># A" |
|
237 shows "card (permutations_of_multiset A) * count A x = |
|
238 size A * card (permutations_of_multiset (A - {#x#}))" |
|
239 proof - |
|
240 from assms have A: "A - {#x#} + {#x#} = A" by simp |
|
241 from assms have B: "size A = size (A - {#x#}) + 1" |
|
242 by (subst A [symmetric], subst size_union) simp |
|
243 show ?thesis |
|
244 using card_permutations_of_multiset_insert_aux[of "A - {#x#}" x, unfolded A] assms |
|
245 by (simp add: B) |
|
246 qed |
|
247 |
|
248 lemma real_card_permutations_of_multiset_remove: |
|
249 assumes "x \<in># A" |
|
250 shows "real (card (permutations_of_multiset (A - {#x#}))) = |
|
251 real (card (permutations_of_multiset A) * count A x) / real (size A)" |
|
252 using assms by (subst card_permutations_of_multiset_remove_aux[OF assms]) auto |
|
253 |
|
254 lemma real_card_permutations_of_multiset_remove': |
|
255 assumes "x \<in># A" |
|
256 shows "real (card (permutations_of_multiset A)) = |
|
257 real (size A * card (permutations_of_multiset (A - {#x#}))) / real (count A x)" |
|
258 using assms by (subst card_permutations_of_multiset_remove_aux[OF assms, symmetric]) simp |
|
259 |
|
260 end |
|
261 |
|
262 |
|
263 |
|
264 subsection \<open>Permutations of a set\<close> |
|
265 |
|
266 definition permutations_of_set :: "'a set \<Rightarrow> 'a list set" where |
|
267 "permutations_of_set A = {xs. set xs = A \<and> distinct xs}" |
|
268 |
|
269 lemma permutations_of_set_altdef: |
|
270 "finite A \<Longrightarrow> permutations_of_set A = permutations_of_multiset (mset_set A)" |
|
271 by (auto simp add: permutations_of_set_def permutations_of_multiset_def mset_set_set |
|
272 in_multiset_in_set [symmetric] mset_eq_mset_set_imp_distinct) |
|
273 |
|
274 lemma permutations_of_setI [intro]: |
|
275 assumes "set xs = A" "distinct xs" |
|
276 shows "xs \<in> permutations_of_set A" |
|
277 using assms unfolding permutations_of_set_def by simp |
|
278 |
|
279 lemma permutations_of_setD: |
|
280 assumes "xs \<in> permutations_of_set A" |
|
281 shows "set xs = A" "distinct xs" |
|
282 using assms unfolding permutations_of_set_def by simp_all |
|
283 |
|
284 lemma permutations_of_set_lists: "permutations_of_set A \<subseteq> lists A" |
|
285 unfolding permutations_of_set_def by auto |
|
286 |
|
287 lemma permutations_of_set_empty [simp]: "permutations_of_set {} = {[]}" |
|
288 by (auto simp: permutations_of_set_def) |
|
289 |
|
290 lemma UN_set_permutations_of_set [simp]: |
|
291 "finite A \<Longrightarrow> (\<Union>xs\<in>permutations_of_set A. set xs) = A" |
|
292 using finite_distinct_list by (auto simp: permutations_of_set_def) |
|
293 |
|
294 lemma permutations_of_set_infinite: |
|
295 "\<not>finite A \<Longrightarrow> permutations_of_set A = {}" |
|
296 by (auto simp: permutations_of_set_def) |
|
297 |
|
298 lemma permutations_of_set_nonempty: |
|
299 "A \<noteq> {} \<Longrightarrow> permutations_of_set A = |
|
300 (\<Union>x\<in>A. (\<lambda>xs. x # xs) ` permutations_of_set (A - {x}))" |
|
301 by (cases "finite A") |
|
302 (simp_all add: permutations_of_multiset_nonempty mset_set_empty_iff mset_set_Diff |
|
303 permutations_of_set_altdef permutations_of_set_infinite) |
|
304 |
|
305 lemma permutations_of_set_singleton [simp]: "permutations_of_set {x} = {[x]}" |
|
306 by (subst permutations_of_set_nonempty) auto |
|
307 |
|
308 lemma permutations_of_set_doubleton: |
|
309 "x \<noteq> y \<Longrightarrow> permutations_of_set {x,y} = {[x,y], [y,x]}" |
|
310 by (subst permutations_of_set_nonempty) |
|
311 (simp_all add: insert_Diff_if insert_commute) |
|
312 |
|
313 lemma rev_permutations_of_set [simp]: |
|
314 "rev ` permutations_of_set A = permutations_of_set A" |
|
315 by (cases "finite A") (simp_all add: permutations_of_set_altdef permutations_of_set_infinite) |
|
316 |
|
317 lemma length_finite_permutations_of_set: |
|
318 "xs \<in> permutations_of_set A \<Longrightarrow> length xs = card A" |
|
319 by (auto simp: permutations_of_set_def distinct_card) |
|
320 |
|
321 lemma finite_permutations_of_set [simp]: "finite (permutations_of_set A)" |
|
322 by (cases "finite A") (simp_all add: permutations_of_set_infinite permutations_of_set_altdef) |
|
323 |
|
324 lemma permutations_of_set_empty_iff [simp]: |
|
325 "permutations_of_set A = {} \<longleftrightarrow> \<not>finite A" |
|
326 unfolding permutations_of_set_def using finite_distinct_list[of A] by auto |
|
327 |
|
328 lemma card_permutations_of_set [simp]: |
|
329 "finite A \<Longrightarrow> card (permutations_of_set A) = fact (card A)" |
|
330 by (simp add: permutations_of_set_altdef card_permutations_of_multiset del: One_nat_def) |
|
331 |
|
332 lemma permutations_of_set_image_inj: |
|
333 assumes inj: "inj_on f A" |
|
334 shows "permutations_of_set (f ` A) = map f ` permutations_of_set A" |
|
335 by (cases "finite A") |
|
336 (simp_all add: permutations_of_set_infinite permutations_of_set_altdef |
|
337 permutations_of_multiset_image mset_set_image_inj inj finite_image_iff) |
|
338 |
|
339 lemma permutations_of_set_image_permutes: |
|
340 "\<sigma> permutes A \<Longrightarrow> map \<sigma> ` permutations_of_set A = permutations_of_set A" |
|
341 by (subst permutations_of_set_image_inj [symmetric]) |
|
342 (simp_all add: permutes_inj_on permutes_image) |
|
343 |
|
344 |
|
345 subsection \<open>Code generation\<close> |
|
346 |
|
347 text \<open> |
|
348 First, we give code an implementation for permutations of lists. |
|
349 \<close> |
|
350 |
|
351 declare length_remove1 [termination_simp] |
|
352 |
|
353 fun permutations_of_list_impl where |
|
354 "permutations_of_list_impl xs = (if xs = [] then [[]] else |
|
355 List.bind (remdups xs) (\<lambda>x. map (op # x) (permutations_of_list_impl (remove1 x xs))))" |
|
356 |
|
357 fun permutations_of_list_impl_aux where |
|
358 "permutations_of_list_impl_aux acc xs = (if xs = [] then [acc] else |
|
359 List.bind (remdups xs) (\<lambda>x. permutations_of_list_impl_aux (x#acc) (remove1 x xs)))" |
|
360 |
|
361 declare permutations_of_list_impl_aux.simps [simp del] |
|
362 declare permutations_of_list_impl.simps [simp del] |
|
363 |
|
364 lemma permutations_of_list_impl_Nil [simp]: |
|
365 "permutations_of_list_impl [] = [[]]" |
|
366 by (simp add: permutations_of_list_impl.simps) |
|
367 |
|
368 lemma permutations_of_list_impl_nonempty: |
|
369 "xs \<noteq> [] \<Longrightarrow> permutations_of_list_impl xs = |
|
370 List.bind (remdups xs) (\<lambda>x. map (op # x) (permutations_of_list_impl (remove1 x xs)))" |
|
371 by (subst permutations_of_list_impl.simps) simp_all |
|
372 |
|
373 lemma set_permutations_of_list_impl: |
|
374 "set (permutations_of_list_impl xs) = permutations_of_multiset (mset xs)" |
|
375 by (induction xs rule: permutations_of_list_impl.induct) |
|
376 (subst permutations_of_list_impl.simps, |
|
377 simp_all add: permutations_of_multiset_nonempty set_list_bind) |
|
378 |
|
379 lemma distinct_permutations_of_list_impl: |
|
380 "distinct (permutations_of_list_impl xs)" |
|
381 by (induction xs rule: permutations_of_list_impl.induct, |
|
382 subst permutations_of_list_impl.simps) |
|
383 (auto intro!: distinct_list_bind simp: distinct_map o_def disjoint_family_on_def) |
|
384 |
|
385 lemma permutations_of_list_impl_aux_correct': |
|
386 "permutations_of_list_impl_aux acc xs = |
|
387 map (\<lambda>xs. rev xs @ acc) (permutations_of_list_impl xs)" |
|
388 by (induction acc xs rule: permutations_of_list_impl_aux.induct, |
|
389 subst permutations_of_list_impl_aux.simps, subst permutations_of_list_impl.simps) |
|
390 (auto simp: map_list_bind intro!: list_bind_cong) |
|
391 |
|
392 lemma permutations_of_list_impl_aux_correct: |
|
393 "permutations_of_list_impl_aux [] xs = map rev (permutations_of_list_impl xs)" |
|
394 by (simp add: permutations_of_list_impl_aux_correct') |
|
395 |
|
396 lemma distinct_permutations_of_list_impl_aux: |
|
397 "distinct (permutations_of_list_impl_aux acc xs)" |
|
398 by (simp add: permutations_of_list_impl_aux_correct' distinct_map |
|
399 distinct_permutations_of_list_impl inj_on_def) |
|
400 |
|
401 lemma set_permutations_of_list_impl_aux: |
|
402 "set (permutations_of_list_impl_aux [] xs) = permutations_of_multiset (mset xs)" |
|
403 by (simp add: permutations_of_list_impl_aux_correct set_permutations_of_list_impl) |
|
404 |
|
405 declare set_permutations_of_list_impl_aux [symmetric, code] |
|
406 |
|
407 value [code] "permutations_of_multiset {#1,2,3,4::int#}" |
|
408 |
|
409 |
|
410 |
|
411 text \<open> |
|
412 Now we turn to permutations of sets. We define an auxiliary version with an |
|
413 accumulator to avoid having to map over the results. |
|
414 \<close> |
|
415 function permutations_of_set_aux where |
|
416 "permutations_of_set_aux acc A = |
|
417 (if \<not>finite A then {} else if A = {} then {acc} else |
|
418 (\<Union>x\<in>A. permutations_of_set_aux (x#acc) (A - {x})))" |
|
419 by auto |
|
420 termination by (relation "Wellfounded.measure (card \<circ> snd)") (simp_all add: card_gt_0_iff) |
|
421 |
|
422 lemma permutations_of_set_aux_altdef: |
|
423 "permutations_of_set_aux acc A = (\<lambda>xs. rev xs @ acc) ` permutations_of_set A" |
|
424 proof (cases "finite A") |
|
425 assume "finite A" |
|
426 thus ?thesis |
|
427 proof (induction A arbitrary: acc rule: finite_psubset_induct) |
|
428 case (psubset A acc) |
|
429 show ?case |
|
430 proof (cases "A = {}") |
|
431 case False |
|
432 note [simp del] = permutations_of_set_aux.simps |
|
433 from psubset.hyps False |
|
434 have "permutations_of_set_aux acc A = |
|
435 (\<Union>y\<in>A. permutations_of_set_aux (y#acc) (A - {y}))" |
|
436 by (subst permutations_of_set_aux.simps) simp_all |
|
437 also have "\<dots> = (\<Union>y\<in>A. (\<lambda>xs. rev xs @ acc) ` (\<lambda>xs. y # xs) ` permutations_of_set (A - {y}))" |
|
438 by (intro SUP_cong refl, subst psubset) (auto simp: image_image) |
|
439 also from False have "\<dots> = (\<lambda>xs. rev xs @ acc) ` permutations_of_set A" |
|
440 by (subst (2) permutations_of_set_nonempty) (simp_all add: image_UN) |
|
441 finally show ?thesis . |
|
442 qed simp_all |
|
443 qed |
|
444 qed (simp_all add: permutations_of_set_infinite) |
|
445 |
|
446 declare permutations_of_set_aux.simps [simp del] |
|
447 |
|
448 lemma permutations_of_set_aux_correct: |
|
449 "permutations_of_set_aux [] A = permutations_of_set A" |
|
450 by (simp add: permutations_of_set_aux_altdef) |
|
451 |
|
452 |
|
453 text \<open> |
|
454 In another refinement step, we define a version on lists. |
|
455 \<close> |
|
456 declare length_remove1 [termination_simp] |
|
457 |
|
458 fun permutations_of_set_aux_list where |
|
459 "permutations_of_set_aux_list acc xs = |
|
460 (if xs = [] then [acc] else |
|
461 List.bind xs (\<lambda>x. permutations_of_set_aux_list (x#acc) (List.remove1 x xs)))" |
|
462 |
|
463 definition permutations_of_set_list where |
|
464 "permutations_of_set_list xs = permutations_of_set_aux_list [] xs" |
|
465 |
|
466 declare permutations_of_set_aux_list.simps [simp del] |
|
467 |
|
468 lemma permutations_of_set_aux_list_refine: |
|
469 assumes "distinct xs" |
|
470 shows "set (permutations_of_set_aux_list acc xs) = permutations_of_set_aux acc (set xs)" |
|
471 using assms |
|
472 by (induction acc xs rule: permutations_of_set_aux_list.induct) |
|
473 (subst permutations_of_set_aux_list.simps, |
|
474 subst permutations_of_set_aux.simps, |
|
475 simp_all add: set_list_bind cong: SUP_cong) |
|
476 |
|
477 |
|
478 text \<open> |
|
479 The permutation lists contain no duplicates if the inputs contain no duplicates. |
|
480 Therefore, these functions can easily be used when working with a representation of |
|
481 sets by distinct lists. |
|
482 The same approach should generalise to any kind of set implementation that supports |
|
483 a monadic bind operation, and since the results are disjoint, merging should be cheap. |
|
484 \<close> |
|
485 lemma distinct_permutations_of_set_aux_list: |
|
486 "distinct xs \<Longrightarrow> distinct (permutations_of_set_aux_list acc xs)" |
|
487 by (induction acc xs rule: permutations_of_set_aux_list.induct) |
|
488 (subst permutations_of_set_aux_list.simps, |
|
489 auto intro!: distinct_list_bind simp: disjoint_family_on_def |
|
490 permutations_of_set_aux_list_refine permutations_of_set_aux_altdef) |
|
491 |
|
492 lemma distinct_permutations_of_set_list: |
|
493 "distinct xs \<Longrightarrow> distinct (permutations_of_set_list xs)" |
|
494 by (simp add: permutations_of_set_list_def distinct_permutations_of_set_aux_list) |
|
495 |
|
496 lemma permutations_of_list: |
|
497 "permutations_of_set (set xs) = set (permutations_of_set_list (remdups xs))" |
|
498 by (simp add: permutations_of_set_aux_correct [symmetric] |
|
499 permutations_of_set_aux_list_refine permutations_of_set_list_def) |
|
500 |
|
501 lemma permutations_of_list_code [code]: |
|
502 "permutations_of_set (set xs) = set (permutations_of_set_list (remdups xs))" |
|
503 "permutations_of_set (List.coset xs) = |
|
504 Code.abort (STR ''Permutation of set complement not supported'') |
|
505 (\<lambda>_. permutations_of_set (List.coset xs))" |
|
506 by (simp_all add: permutations_of_list) |
|
507 |
|
508 value [code] "permutations_of_set (set ''abcd'')" |
|
509 |
|
510 end |