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) |