src/HOL/Library/Multiset.thy
changeset 18730 843da46f89ac
parent 18258 836491e9b7d5
child 19086 1b3780be6cc2
equal deleted inserted replaced
18729:216e31270509 18730:843da46f89ac
   289    apply auto
   289    apply auto
   290   apply (drule_tac a = a in mk_disjoint_insert, auto)
   290   apply (drule_tac a = a in mk_disjoint_insert, auto)
   291   done
   291   done
   292 
   292 
   293 lemma rep_multiset_induct_aux:
   293 lemma rep_multiset_induct_aux:
   294   assumes "P (\<lambda>a. (0::nat))"
   294   assumes 1: "P (\<lambda>a. (0::nat))"
   295     and "!!f b. f \<in> multiset ==> P f ==> P (f (b := f b + 1))"
   295     and 2: "!!f b. f \<in> multiset ==> P f ==> P (f (b := f b + 1))"
   296   shows "\<forall>f. f \<in> multiset --> setsum f {x. 0 < f x} = n --> P f"
   296   shows "\<forall>f. f \<in> multiset --> setsum f {x. 0 < f x} = n --> P f"
   297 proof -
   297   apply (unfold multiset_def)
   298   note premises = prems [unfolded multiset_def]
   298   apply (induct_tac n, simp, clarify)
   299   show ?thesis
   299    apply (subgoal_tac "f = (\<lambda>a.0)")
   300     apply (unfold multiset_def)
   300     apply simp
   301     apply (induct_tac n, simp, clarify)
   301     apply (rule 1)
   302      apply (subgoal_tac "f = (\<lambda>a.0)")
   302    apply (rule ext, force, clarify)
   303       apply simp
   303   apply (frule setsum_SucD, clarify)
   304       apply (rule premises)
   304   apply (rename_tac a)
   305      apply (rule ext, force, clarify)
   305   apply (subgoal_tac "finite {x. 0 < (f (a := f a - 1)) x}")
   306     apply (frule setsum_SucD, clarify)
   306    prefer 2
   307     apply (rename_tac a)
   307    apply (rule finite_subset)
   308     apply (subgoal_tac "finite {x. 0 < (f (a := f a - 1)) x}")
   308     prefer 2
   309      prefer 2
   309     apply assumption
   310      apply (rule finite_subset)
   310    apply simp
   311       prefer 2
   311    apply blast
   312       apply assumption
   312   apply (subgoal_tac "f = (f (a := f a - 1))(a := (f (a := f a - 1)) a + 1)")
   313      apply simp
   313    prefer 2
   314      apply blast
   314    apply (rule ext)
   315     apply (subgoal_tac "f = (f (a := f a - 1))(a := (f (a := f a - 1)) a + 1)")
   315    apply (simp (no_asm_simp))
   316      prefer 2
   316    apply (erule ssubst, rule 2 [unfolded multiset_def], blast)
   317      apply (rule ext)
   317   apply (erule allE, erule impE, erule_tac [2] mp, blast)
   318      apply (simp (no_asm_simp))
   318   apply (simp (no_asm_simp) add: setsum_decr del: fun_upd_apply One_nat_def)
   319      apply (erule ssubst, rule premises, blast)
   319   apply (subgoal_tac "{x. x \<noteq> a --> 0 < f x} = {x. 0 < f x}")
   320     apply (erule allE, erule impE, erule_tac [2] mp, blast)
   320    prefer 2
   321     apply (simp (no_asm_simp) add: setsum_decr del: fun_upd_apply One_nat_def)
   321    apply blast
   322     apply (subgoal_tac "{x. x \<noteq> a --> 0 < f x} = {x. 0 < f x}")
   322   apply (subgoal_tac "{x. x \<noteq> a \<and> 0 < f x} = {x. 0 < f x} - {a}")
   323      prefer 2
   323    prefer 2
   324      apply blast
   324    apply blast
   325     apply (subgoal_tac "{x. x \<noteq> a \<and> 0 < f x} = {x. 0 < f x} - {a}")
   325   apply (simp add: le_imp_diff_is_add setsum_diff1_nat cong: conj_cong)
   326      prefer 2
   326   done
   327      apply blast
       
   328     apply (simp add: le_imp_diff_is_add setsum_diff1_nat cong: conj_cong)
       
   329     done
       
   330 qed
       
   331 
   327 
   332 theorem rep_multiset_induct:
   328 theorem rep_multiset_induct:
   333   "f \<in> multiset ==> P (\<lambda>a. 0) ==>
   329   "f \<in> multiset ==> P (\<lambda>a. 0) ==>
   334     (!!f b. f \<in> multiset ==> P f ==> P (f (b := f b + 1))) ==> P f"
   330     (!!f b. f \<in> multiset ==> P f ==> P (f (b := f b + 1))) ==> P f"
   335   using rep_multiset_induct_aux by blast
   331   using rep_multiset_induct_aux by blast
   454         then show "N \<in> ?W" by (simp only: N)
   450         then show "N \<in> ?W" by (simp only: N)
   455       next
   451       next
   456         fix K
   452         fix K
   457         assume N: "N = M0 + K"
   453         assume N: "N = M0 + K"
   458         assume "\<forall>b. b :# K --> (b, a) \<in> r"
   454         assume "\<forall>b. b :# K --> (b, a) \<in> r"
   459 	then have "M0 + K \<in> ?W"
   455         then have "M0 + K \<in> ?W"
   460         proof (induct K)
   456         proof (induct K)
   461 	  case empty
   457           case empty
   462           from M0 show "M0 + {#} \<in> ?W" by simp
   458           from M0 show "M0 + {#} \<in> ?W" by simp
   463 	next
   459         next
   464 	  case (add K x)
   460           case (add K x)
   465 	  from add.prems have "(x, a) \<in> r" by simp
   461           from add.prems have "(x, a) \<in> r" by simp
   466           with wf_hyp have "\<forall>M \<in> ?W. M + {#x#} \<in> ?W" by blast
   462           with wf_hyp have "\<forall>M \<in> ?W. M + {#x#} \<in> ?W" by blast
   467 	  moreover from add have "M0 + K \<in> ?W" by simp
   463           moreover from add have "M0 + K \<in> ?W" by simp
   468           ultimately have "(M0 + K) + {#x#} \<in> ?W" ..
   464           ultimately have "(M0 + K) + {#x#} \<in> ?W" ..
   469           then show "M0 + (K + {#x#}) \<in> ?W" by (simp only: union_assoc)
   465           then show "M0 + (K + {#x#}) \<in> ?W" by (simp only: union_assoc)
   470         qed
   466         qed
   471 	then show "N \<in> ?W" by (simp only: N)
   467         then show "N \<in> ?W" by (simp only: N)
   472       qed
   468       qed
   473     qed
   469     qed
   474   } note tedious_reasoning = this
   470   } note tedious_reasoning = this
   475 
   471 
   476   assume wf: "wf r"
   472   assume wf: "wf r"
   600 defs (overloaded)
   596 defs (overloaded)
   601   less_multiset_def: "M' < M == (M', M) \<in> mult {(x', x). x' < x}"
   597   less_multiset_def: "M' < M == (M', M) \<in> mult {(x', x). x' < x}"
   602   le_multiset_def: "M' <= M == M' = M \<or> M' < (M::'a multiset)"
   598   le_multiset_def: "M' <= M == M' = M \<or> M' < (M::'a multiset)"
   603 
   599 
   604 lemma trans_base_order: "trans {(x', x). x' < (x::'a::order)}"
   600 lemma trans_base_order: "trans {(x', x). x' < (x::'a::order)}"
   605   apply (unfold trans_def)
   601   unfolding trans_def by (blast intro: order_less_trans)
   606   apply (blast intro: order_less_trans)
       
   607   done
       
   608 
   602 
   609 text {*
   603 text {*
   610  \medskip Irreflexivity.
   604  \medskip Irreflexivity.
   611 *}
   605 *}
   612 
   606 
   645 theorem mult_less_asym:
   639 theorem mult_less_asym:
   646     "M < N ==> (\<not> P ==> N < (M::'a::order multiset)) ==> P"
   640     "M < N ==> (\<not> P ==> N < (M::'a::order multiset)) ==> P"
   647   by (insert mult_less_not_sym, blast)
   641   by (insert mult_less_not_sym, blast)
   648 
   642 
   649 theorem mult_le_refl [iff]: "M <= (M::'a::order multiset)"
   643 theorem mult_le_refl [iff]: "M <= (M::'a::order multiset)"
   650 by (unfold le_multiset_def, auto)
   644   unfolding le_multiset_def by auto
   651 
   645 
   652 text {* Anti-symmetry. *}
   646 text {* Anti-symmetry. *}
   653 
   647 
   654 theorem mult_le_antisym:
   648 theorem mult_le_antisym:
   655     "M <= N ==> N <= M ==> M = (N::'a::order multiset)"
   649     "M <= N ==> N <= M ==> M = (N::'a::order multiset)"
   656   apply (unfold le_multiset_def)
   650   unfolding le_multiset_def by (blast dest: mult_less_not_sym)
   657   apply (blast dest: mult_less_not_sym)
       
   658   done
       
   659 
   651 
   660 text {* Transitivity. *}
   652 text {* Transitivity. *}
   661 
   653 
   662 theorem mult_le_trans:
   654 theorem mult_le_trans:
   663     "K <= M ==> M <= N ==> K <= (N::'a::order multiset)"
   655     "K <= M ==> M <= N ==> K <= (N::'a::order multiset)"
   664   apply (unfold le_multiset_def)
   656   unfolding le_multiset_def by (blast intro: mult_less_trans)
   665   apply (blast intro: mult_less_trans)
       
   666   done
       
   667 
   657 
   668 theorem mult_less_le: "(M < N) = (M <= N \<and> M \<noteq> (N::'a::order multiset))"
   658 theorem mult_less_le: "(M < N) = (M <= N \<and> M \<noteq> (N::'a::order multiset))"
   669 by (unfold le_multiset_def, auto)
   659   unfolding le_multiset_def by auto
   670 
   660 
   671 text {* Partial order. *}
   661 text {* Partial order. *}
   672 
   662 
   673 instance multiset :: (order) order
   663 instance multiset :: (order) order
   674   apply intro_classes
   664   apply intro_classes
   707   apply (blast intro!: union_less_mono1 union_less_mono2 mult_less_trans)
   697   apply (blast intro!: union_less_mono1 union_less_mono2 mult_less_trans)
   708   done
   698   done
   709 
   699 
   710 lemma union_le_mono:
   700 lemma union_le_mono:
   711     "A <= C ==> B <= D ==> A + B <= C + (D::'a::order multiset)"
   701     "A <= C ==> B <= D ==> A + B <= C + (D::'a::order multiset)"
   712   apply (unfold le_multiset_def)
   702   unfolding le_multiset_def
   713   apply (blast intro: union_less_mono union_less_mono1 union_less_mono2)
   703   by (blast intro: union_less_mono union_less_mono1 union_less_mono2)
   714   done
       
   715 
   704 
   716 lemma empty_leI [iff]: "{#} <= (M::'a::order multiset)"
   705 lemma empty_leI [iff]: "{#} <= (M::'a::order multiset)"
   717   apply (unfold le_multiset_def less_multiset_def)
   706   apply (unfold le_multiset_def less_multiset_def)
   718   apply (case_tac "M = {#}")
   707   apply (case_tac "M = {#}")
   719    prefer 2
   708    prefer 2
   754   by (induct xs) auto
   743   by (induct xs) auto
   755 
   744 
   756 lemma multiset_of_append [simp]:
   745 lemma multiset_of_append [simp]:
   757     "multiset_of (xs @ ys) = multiset_of xs + multiset_of ys"
   746     "multiset_of (xs @ ys) = multiset_of xs + multiset_of ys"
   758   by (induct xs fixing: ys) (auto simp: union_ac)
   747   by (induct xs fixing: ys) (auto simp: union_ac)
   759   
   748 
   760 lemma surj_multiset_of: "surj multiset_of"
   749 lemma surj_multiset_of: "surj multiset_of"
   761   apply (unfold surj_def, rule allI)
   750   apply (unfold surj_def, rule allI)
   762   apply (rule_tac M=y in multiset_induct, auto)
   751   apply (rule_tac M=y in multiset_induct, auto)
   763   apply (rule_tac x = "x # xa" in exI, auto)
   752   apply (rule_tac x = "x # xa" in exI, auto)
   764   done
   753   done
   814 
   803 
   815 defs
   804 defs
   816   mset_le_def: "xs \<le># ys == (\<forall>a. count xs a \<le> count ys a)"
   805   mset_le_def: "xs \<le># ys == (\<forall>a. count xs a \<le> count ys a)"
   817 
   806 
   818 lemma mset_le_refl[simp]: "xs \<le># xs"
   807 lemma mset_le_refl[simp]: "xs \<le># xs"
   819   by (unfold mset_le_def) auto
   808   unfolding mset_le_def by auto
   820 
   809 
   821 lemma mset_le_trans: "\<lbrakk> xs \<le># ys; ys \<le># zs \<rbrakk> \<Longrightarrow> xs \<le># zs"
   810 lemma mset_le_trans: "\<lbrakk> xs \<le># ys; ys \<le># zs \<rbrakk> \<Longrightarrow> xs \<le># zs"
   822   by (unfold mset_le_def) (fast intro: order_trans)
   811   unfolding mset_le_def by (fast intro: order_trans)
   823 
   812 
   824 lemma mset_le_antisym: "\<lbrakk> xs\<le># ys; ys \<le># xs\<rbrakk> \<Longrightarrow> xs = ys"
   813 lemma mset_le_antisym: "\<lbrakk> xs\<le># ys; ys \<le># xs\<rbrakk> \<Longrightarrow> xs = ys"
   825   apply (unfold mset_le_def)
   814   apply (unfold mset_le_def)
   826   apply (rule multiset_eq_conv_count_eq[THEN iffD2])
   815   apply (rule multiset_eq_conv_count_eq[THEN iffD2])
   827   apply (blast intro: order_antisym)
   816   apply (blast intro: order_antisym)
   832   apply (unfold mset_le_def, rule iffI, rule_tac x = "ys - xs" in exI)
   821   apply (unfold mset_le_def, rule iffI, rule_tac x = "ys - xs" in exI)
   833   apply (auto intro: multiset_eq_conv_count_eq [THEN iffD2])
   822   apply (auto intro: multiset_eq_conv_count_eq [THEN iffD2])
   834   done
   823   done
   835 
   824 
   836 lemma mset_le_mono_add_right_cancel[simp]: "(xs + zs \<le># ys + zs) = (xs \<le># ys)"
   825 lemma mset_le_mono_add_right_cancel[simp]: "(xs + zs \<le># ys + zs) = (xs \<le># ys)"
   837   by (unfold mset_le_def) auto
   826   unfolding mset_le_def by auto
   838 
   827 
   839 lemma mset_le_mono_add_left_cancel[simp]: "(zs + xs \<le># zs + ys) = (xs \<le># ys)"
   828 lemma mset_le_mono_add_left_cancel[simp]: "(zs + xs \<le># zs + ys) = (xs \<le># ys)"
   840   by (unfold mset_le_def) auto
   829   unfolding mset_le_def by auto
   841 
   830 
   842 lemma mset_le_mono_add: "\<lbrakk> xs \<le># ys; vs \<le># ws \<rbrakk> \<Longrightarrow> xs + vs \<le># ys + ws"
   831 lemma mset_le_mono_add: "\<lbrakk> xs \<le># ys; vs \<le># ws \<rbrakk> \<Longrightarrow> xs + vs \<le># ys + ws"
   843   apply (unfold mset_le_def)
   832   apply (unfold mset_le_def)
   844   apply auto
   833   apply auto
   845   apply (erule_tac x=a in allE)+
   834   apply (erule_tac x=a in allE)+
   846   apply auto
   835   apply auto
   847   done
   836   done
   848 
   837 
   849 lemma mset_le_add_left[simp]: "xs \<le># xs + ys"
   838 lemma mset_le_add_left[simp]: "xs \<le># xs + ys"
   850   by (unfold mset_le_def) auto
   839   unfolding mset_le_def by auto
   851 
   840 
   852 lemma mset_le_add_right[simp]: "ys \<le># xs + ys"
   841 lemma mset_le_add_right[simp]: "ys \<le># xs + ys"
   853   by (unfold mset_le_def) auto
   842   unfolding mset_le_def by auto
   854 
   843 
   855 lemma multiset_of_remdups_le: "multiset_of (remdups x) \<le># multiset_of x"
   844 lemma multiset_of_remdups_le: "multiset_of (remdups x) \<le># multiset_of x"
   856   apply (induct x)
   845   apply (induct x)
   857    apply auto
   846    apply auto
   858   apply (rule mset_le_trans)
   847   apply (rule mset_le_trans)