src/HOL/Library/Multiset_Permutations.thy
changeset 63965 d510b816ea41
child 64267 b9a1486e79be
equal deleted inserted replaced
63954:fb03766658f4 63965:d510b816ea41
       
     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