diff -r 4453cfb745e5 -r f90e3926e627 src/HOL/Groups_Big.thy --- a/src/HOL/Groups_Big.thy Wed Aug 10 22:05:00 2016 +0200 +++ b/src/HOL/Groups_Big.thy Wed Aug 10 22:05:36 2016 +0200 @@ -1,12 +1,14 @@ (* Title: HOL/Groups_Big.thy - Author: Tobias Nipkow, Lawrence C Paulson and Markus Wenzel - with contributions by Jeremy Avigad + Author: Tobias Nipkow + Author: Lawrence C Paulson + Author: Markus Wenzel + Author: Jeremy Avigad *) section \Big sum and product over finite (non-empty) sets\ theory Groups_Big -imports Finite_Set Power + imports Finite_Set Power begin subsection \Generic monoid operation over a set\ @@ -21,60 +23,53 @@ by (fact comp_comp_fun_commute) definition F :: "('b \ 'a) \ 'b set \ 'a" -where - eq_fold: "F g A = Finite_Set.fold (f \ g) \<^bold>1 A" + where eq_fold: "F g A = Finite_Set.fold (f \ g) \<^bold>1 A" -lemma infinite [simp]: - "\ finite A \ F g A = \<^bold>1" +lemma infinite [simp]: "\ finite A \ F g A = \<^bold>1" by (simp add: eq_fold) -lemma empty [simp]: - "F g {} = \<^bold>1" +lemma empty [simp]: "F g {} = \<^bold>1" by (simp add: eq_fold) -lemma insert [simp]: - assumes "finite A" and "x \ A" - shows "F g (insert x A) = g x \<^bold>* F g A" - using assms by (simp add: eq_fold) +lemma insert [simp]: "finite A \ x \ A \ F g (insert x A) = g x \<^bold>* F g A" + by (simp add: eq_fold) lemma remove: assumes "finite A" and "x \ A" shows "F g A = g x \<^bold>* F g (A - {x})" proof - - from \x \ A\ obtain B where A: "A = insert x B" and "x \ B" + from \x \ A\ obtain B where B: "A = insert x B" and "x \ B" by (auto dest: mk_disjoint_insert) - moreover from \finite A\ A have "finite B" by simp + moreover from \finite A\ B have "finite B" by simp ultimately show ?thesis by simp qed -lemma insert_remove: - assumes "finite A" - shows "F g (insert x A) = g x \<^bold>* F g (A - {x})" - using assms by (cases "x \ A") (simp_all add: remove insert_absorb) +lemma insert_remove: "finite A \ F g (insert x A) = g x \<^bold>* F g (A - {x})" + by (cases "x \ A") (simp_all add: remove insert_absorb) -lemma neutral: - assumes "\x\A. g x = \<^bold>1" - shows "F g A = \<^bold>1" - using assms by (induct A rule: infinite_finite_induct) simp_all +lemma neutral: "\x\A. g x = \<^bold>1 \ F g A = \<^bold>1" + by (induct A rule: infinite_finite_induct) simp_all -lemma neutral_const [simp]: - "F (\_. \<^bold>1) A = \<^bold>1" +lemma neutral_const [simp]: "F (\_. \<^bold>1) A = \<^bold>1" by (simp add: neutral) lemma union_inter: assumes "finite A" and "finite B" shows "F g (A \ B) \<^bold>* F g (A \ B) = F g A \<^bold>* F g B" \ \The reversed orientation looks more natural, but LOOPS as a simprule!\ -using assms proof (induct A) - case empty then show ?case by simp + using assms +proof (induct A) + case empty + then show ?case by simp next - case (insert x A) then show ?case - by (auto simp add: insert_absorb Int_insert_left commute [of _ "g x"] assoc left_commute) + case (insert x A) + then show ?case + by (auto simp: insert_absorb Int_insert_left commute [of _ "g x"] assoc left_commute) qed corollary union_inter_neutral: assumes "finite A" and "finite B" - and I0: "\x \ A \ B. g x = \<^bold>1" + and "\x \ A \ B. g x = \<^bold>1" shows "F g (A \ B) = F g A \<^bold>* F g B" using assms by (simp add: union_inter [symmetric] neutral) @@ -90,7 +85,8 @@ proof - have "A \ B = A - B \ (B - A) \ A \ B" by auto - with assms show ?thesis by simp (subst union_disjoint, auto)+ + with assms show ?thesis + by simp (subst union_disjoint, auto)+ qed lemma subset_diff: @@ -116,9 +112,15 @@ proof - from assms have "\a\A. g a \ \<^bold>1" proof (induct A rule: infinite_finite_induct) + case infinite + then show ?case by simp + next + case empty + then show ?case by simp + next case (insert a A) - then show ?case by simp (rule, simp) - qed simp_all + then show ?case by fastforce + qed with that show thesis by blast qed @@ -127,9 +129,11 @@ shows "F g (h ` A) = F (g \ h) A" proof (cases "finite A") case True - with assms show ?thesis by (simp add: eq_fold fold_image comp_assoc) + with assms show ?thesis + by (simp add: eq_fold fold_image comp_assoc) next - case False with assms have "\ finite (h ` A)" by (blast dest: finite_imageD) + case False + with assms have "\ finite (h ` A)" by (blast dest: finite_imageD) with False show ?thesis by simp qed @@ -143,7 +147,7 @@ lemma strong_cong [cong]: assumes "A = B" "\x. x \ B =simp=> g x = h x" shows "F (\x. g x) A = F (\x. h x) B" - by (rule cong) (insert assms, simp_all add: simp_implies_def) + by (rule cong) (use assms in \simp_all add: simp_implies_def\) lemma reindex_cong: assumes "inj_on l B" @@ -154,55 +158,64 @@ lemma UNION_disjoint: assumes "finite I" and "\i\I. finite (A i)" - and "\i\I. \j\I. i \ j \ A i \ A j = {}" + and "\i\I. \j\I. i \ j \ A i \ A j = {}" shows "F g (UNION I A) = F (\x. F g (A x)) I" -apply (insert assms) -apply (induct rule: finite_induct) -apply simp -apply atomize -apply (subgoal_tac "\i\Fa. x \ i") - prefer 2 apply blast -apply (subgoal_tac "A x Int UNION Fa A = {}") - prefer 2 apply blast -apply (simp add: union_disjoint) -done + apply (insert assms) + apply (induct rule: finite_induct) + apply simp + apply atomize + apply (subgoal_tac "\i\Fa. x \ i") + prefer 2 apply blast + apply (subgoal_tac "A x \ UNION Fa A = {}") + prefer 2 apply blast + apply (simp add: union_disjoint) + done lemma Union_disjoint: assumes "\A\C. finite A" "\A\C. \B\C. A \ B \ A \ B = {}" shows "F g (\C) = (F \ F) g C" -proof cases - assume "finite C" - from UNION_disjoint [OF this assms] - show ?thesis by simp -qed (auto dest: finite_UnionD intro: infinite) +proof (cases "finite C") + case True + from UNION_disjoint [OF this assms] show ?thesis by simp +next + case False + then show ?thesis by (auto dest: finite_UnionD intro: infinite) +qed -lemma distrib: - "F (\x. g x \<^bold>* h x) A = F g A \<^bold>* F h A" +lemma distrib: "F (\x. g x \<^bold>* h x) A = F g A \<^bold>* F h A" by (induct A rule: infinite_finite_induct) (simp_all add: assoc commute left_commute) lemma Sigma: "finite A \ \x\A. finite (B x) \ F (\x. F (g x) (B x)) A = F (case_prod g) (SIGMA x:A. B x)" -apply (subst Sigma_def) -apply (subst UNION_disjoint, assumption, simp) - apply blast -apply (rule cong) -apply rule -apply (simp add: fun_eq_iff) -apply (subst UNION_disjoint, simp, simp) - apply blast -apply (simp add: comp_def) -done + apply (subst Sigma_def) + apply (subst UNION_disjoint) + apply assumption + apply simp + apply blast + apply (rule cong) + apply rule + apply (simp add: fun_eq_iff) + apply (subst UNION_disjoint) + apply simp + apply simp + apply blast + apply (simp add: comp_def) + done lemma related: assumes Re: "R \<^bold>1 \<^bold>1" - and Rop: "\x1 y1 x2 y2. R x1 x2 \ R y1 y2 \ R (x1 \<^bold>* y1) (x2 \<^bold>* y2)" - and fS: "finite S" and Rfg: "\x\S. R (h x) (g x)" + and Rop: "\x1 y1 x2 y2. R x1 x2 \ R y1 y2 \ R (x1 \<^bold>* y1) (x2 \<^bold>* y2)" + and fin: "finite S" + and R_h_g: "\x\S. R (h x) (g x)" shows "R (F h S) (F g S)" - using fS by (rule finite_subset_induct) (insert assms, auto) + using fin by (rule finite_subset_induct) (use assms in auto) lemma mono_neutral_cong_left: - assumes "finite T" and "S \ T" and "\i \ T - S. h i = \<^bold>1" - and "\x. x \ S \ g x = h x" shows "F g S = F h T" + assumes "finite T" + and "S \ T" + and "\i \ T - S. h i = \<^bold>1" + and "\x. x \ S \ g x = h x" + shows "F g S = F h T" proof- have eq: "T = S \ (T - S)" using \S \ T\ by blast have d: "S \ (T - S) = {}" using \S \ T\ by blast @@ -213,16 +226,14 @@ qed lemma mono_neutral_cong_right: - "\ finite T; S \ T; \i \ T - S. g i = \<^bold>1; \x. x \ S \ g x = h x \ - \ F g T = F h S" + "finite T \ S \ T \ \i \ T - S. g i = \<^bold>1 \ (\x. x \ S \ g x = h x) \ + F g T = F h S" by (auto intro!: mono_neutral_cong_left [symmetric]) -lemma mono_neutral_left: - "\ finite T; S \ T; \i \ T - S. g i = \<^bold>1 \ \ F g S = F g T" +lemma mono_neutral_left: "finite T \ S \ T \ \i \ T - S. g i = \<^bold>1 \ F g S = F g T" by (blast intro: mono_neutral_cong_left) -lemma mono_neutral_right: - "\ finite T; S \ T; \i \ T - S. g i = \<^bold>1 \ \ F g T = F g S" +lemma mono_neutral_right: "finite T \ S \ T \ \i \ T - S. g i = \<^bold>1 \ F g T = F g S" by (blast intro!: mono_neutral_left [symmetric]) lemma reindex_bij_betw: "bij_betw h S T \ F (\x. g (h x)) S = F g T" @@ -256,10 +267,9 @@ proof - have [simp]: "finite S \ finite T" using bij_betw_finite[OF bij] fin by auto - show ?thesis - proof cases - assume "finite S" + proof (cases "finite S") + case True with nn have "F (\x. g (h x)) S = F (\x. g (h x)) (S - S')" by (intro mono_neutral_cong_right) auto also have "\ = F g (T - T')" @@ -267,17 +277,20 @@ also have "\ = F g T" using nn \finite S\ by (intro mono_neutral_cong_left) auto finally show ?thesis . - qed simp + next + case False + then show ?thesis by simp + qed qed lemma reindex_nontrivial: assumes "finite A" - and nz: "\x y. x \ A \ y \ A \ x \ y \ h x = h y \ g (h x) = \<^bold>1" + and nz: "\x y. x \ A \ y \ A \ x \ y \ h x = h y \ g (h x) = \<^bold>1" shows "F g (h ` A) = F (g \ h) A" proof (subst reindex_bij_betw_not_neutral [symmetric]) show "bij_betw h (A - {x \ A. (g \ h) x = \<^bold>1}) (h ` A - h ` {x \ A. (g \ h) x = \<^bold>1})" using nz by (auto intro!: inj_onI simp: bij_betw_def) -qed (insert \finite A\, auto) +qed (use \finite A\ in auto) lemma reindex_bij_witness_not_neutral: assumes fin: "finite S'" "finite T'" @@ -305,69 +318,66 @@ lemma delta: assumes fS: "finite S" shows "F (\k. if k = a then b k else \<^bold>1) S = (if a \ S then b a else \<^bold>1)" -proof- - let ?f = "(\k. if k=a then b k else \<^bold>1)" - { assume a: "a \ S" - hence "\k\S. ?f k = \<^bold>1" by simp - hence ?thesis using a by simp } - moreover - { assume a: "a \ S" +proof - + let ?f = "(\k. if k = a then b k else \<^bold>1)" + show ?thesis + proof (cases "a \ S") + case False + then have "\k\S. ?f k = \<^bold>1" by simp + with False show ?thesis by simp + next + case True let ?A = "S - {a}" let ?B = "{a}" - have eq: "S = ?A \ ?B" using a by blast + from True have eq: "S = ?A \ ?B" by blast have dj: "?A \ ?B = {}" by simp from fS have fAB: "finite ?A" "finite ?B" by auto have "F ?f S = F ?f ?A \<^bold>* F ?f ?B" - using union_disjoint [OF fAB dj, of ?f, unfolded eq [symmetric]] - by simp - then have ?thesis using a by simp } - ultimately show ?thesis by blast + using union_disjoint [OF fAB dj, of ?f, unfolded eq [symmetric]] by simp + with True show ?thesis by simp + qed qed lemma delta': - assumes fS: "finite S" + assumes fin: "finite S" shows "F (\k. if a = k then b k else \<^bold>1) S = (if a \ S then b a else \<^bold>1)" - using delta [OF fS, of a b, symmetric] by (auto intro: cong) + using delta [OF fin, of a b, symmetric] by (auto intro: cong) lemma If_cases: fixes P :: "'b \ bool" and g h :: "'b \ 'a" - assumes fA: "finite A" - shows "F (\x. if P x then h x else g x) A = - F h (A \ {x. P x}) \<^bold>* F g (A \ - {x. P x})" + assumes fin: "finite A" + shows "F (\x. if P x then h x else g x) A = F h (A \ {x. P x}) \<^bold>* F g (A \ - {x. P x})" proof - - have a: "A = A \ {x. P x} \ A \ -{x. P x}" - "(A \ {x. P x}) \ (A \ -{x. P x}) = {}" + have a: "A = A \ {x. P x} \ A \ -{x. P x}" "(A \ {x. P x}) \ (A \ -{x. P x}) = {}" by blast+ - from fA - have f: "finite (A \ {x. P x})" "finite (A \ -{x. P x})" by auto + from fin have f: "finite (A \ {x. P x})" "finite (A \ -{x. P x})" by auto let ?g = "\x. if P x then h x else g x" - from union_disjoint [OF f a(2), of ?g] a(1) - show ?thesis + from union_disjoint [OF f a(2), of ?g] a(1) show ?thesis by (subst (1 2) cong) simp_all qed -lemma cartesian_product: - "F (\x. F (g x) B) A = F (case_prod g) (A \ B)" -apply (rule sym) -apply (cases "finite A") - apply (cases "finite B") - apply (simp add: Sigma) - apply (cases "A={}", simp) - apply simp -apply (auto intro: infinite dest: finite_cartesian_productD2) -apply (cases "B = {}") apply (auto intro: infinite dest: finite_cartesian_productD1) -done +lemma cartesian_product: "F (\x. F (g x) B) A = F (case_prod g) (A \ B)" + apply (rule sym) + apply (cases "finite A") + apply (cases "finite B") + apply (simp add: Sigma) + apply (cases "A = {}") + apply simp + apply simp + apply (auto intro: infinite dest: finite_cartesian_productD2) + apply (cases "B = {}") + apply (auto intro: infinite dest: finite_cartesian_productD1) + done lemma inter_restrict: assumes "finite A" shows "F g (A \ B) = F (\x. if x \ B then g x else \<^bold>1) A" proof - let ?g = "\x. if x \ A \ B then g x else \<^bold>1" - have "\i\A - A \ B. (if i \ A \ B then g i else \<^bold>1) = \<^bold>1" - by simp + have "\i\A - A \ B. (if i \ A \ B then g i else \<^bold>1) = \<^bold>1" by simp moreover have "A \ B \ A" by blast - ultimately have "F ?g (A \ B) = F ?g A" using \finite A\ - by (intro mono_neutral_left) auto + ultimately have "F ?g (A \ B) = F ?g A" + using \finite A\ by (intro mono_neutral_left) auto then show ?thesis by simp qed @@ -377,27 +387,28 @@ lemma Union_comp: assumes "\A \ B. finite A" - and "\A1 A2 x. A1 \ B \ A2 \ B \ A1 \ A2 \ x \ A1 \ x \ A2 \ g x = \<^bold>1" + and "\A1 A2 x. A1 \ B \ A2 \ B \ A1 \ A2 \ x \ A1 \ x \ A2 \ g x = \<^bold>1" shows "F g (\B) = (F \ F) g B" -using assms proof (induct B rule: infinite_finite_induct) + using assms +proof (induct B rule: infinite_finite_induct) case (infinite A) then have "\ finite (\A)" by (blast dest: finite_UnionD) with infinite show ?case by simp next - case empty then show ?case by simp + case empty + then show ?case by simp next case (insert A B) then have "finite A" "finite B" "finite (\B)" "A \ B" and "\x\A \ \B. g x = \<^bold>1" - and H: "F g (\B) = (F o F) g B" by auto + and H: "F g (\B) = (F \ F) g B" by auto then have "F g (A \ \B) = F g A \<^bold>* F g (\B)" by (simp add: union_inter_neutral) with \finite B\ \A \ B\ show ?case by (simp add: H) qed -lemma commute: - "F (\i. F (g i) B) A = F (\j. F (\i. g i j) A) B" +lemma commute: "F (\i. F (g i) B) A = F (\j. F (\i. g i j) A) B" unfolding cartesian_product by (rule reindex_bij_witness [where i = "\(i, j). (j, i)" and j = "\(i, j). (j, i)"]) auto @@ -412,13 +423,11 @@ shows "F g (A <+> B) = F (g \ Inl) A \<^bold>* F (g \ Inr) B" proof - have "A <+> B = Inl ` A \ Inr ` B" by auto - moreover from fin have "finite (Inl ` A :: ('b + 'c) set)" "finite (Inr ` B :: ('b + 'c) set)" - by auto - moreover have "Inl ` A \ Inr ` B = ({} :: ('b + 'c) set)" by auto - moreover have "inj_on (Inl :: 'b \ 'b + 'c) A" "inj_on (Inr :: 'c \ 'b + 'c) B" - by (auto intro: inj_onI) - ultimately show ?thesis using fin - by (simp add: union_disjoint reindex) + moreover from fin have "finite (Inl ` A)" "finite (Inr ` B)" by auto + moreover have "Inl ` A \ Inr ` B = {}" by auto + moreover have "inj_on Inl A" "inj_on Inr B" by (auto intro: inj_onI) + ultimately show ?thesis + using fin by (simp add: union_disjoint reindex) qed lemma same_carrier: @@ -427,22 +436,22 @@ assumes trivial: "\a. a \ C - A \ g a = \<^bold>1" "\b. b \ C - B \ h b = \<^bold>1" shows "F g A = F h B \ F g C = F h C" proof - - from \finite C\ subset have - "finite A" and "finite B" and "finite (C - A)" and "finite (C - B)" - by (auto elim: finite_subset) + have "finite A" and "finite B" and "finite (C - A)" and "finite (C - B)" + using \finite C\ subset by (auto elim: finite_subset) from subset have [simp]: "A - (C - A) = A" by auto from subset have [simp]: "B - (C - B) = B" by auto from subset have "C = A \ (C - A)" by auto then have "F g C = F g (A \ (C - A))" by simp also have "\ = F g (A - (C - A)) \<^bold>* F g (C - A - A) \<^bold>* F g (A \ (C - A))" using \finite A\ \finite (C - A)\ by (simp only: union_diff2) - finally have P: "F g C = F g A" using trivial by simp + finally have *: "F g C = F g A" using trivial by simp from subset have "C = B \ (C - B)" by auto then have "F h C = F h (B \ (C - B))" by simp also have "\ = F h (B - (C - B)) \<^bold>* F h (C - B - B) \<^bold>* F h (B \ (C - B))" using \finite B\ \finite (C - B)\ by (simp only: union_diff2) - finally have Q: "F h C = F h B" using trivial by simp - from P Q show ?thesis by simp + finally have "F h C = F h B" + using trivial by simp + with * show ?thesis by simp qed lemma same_carrierI: @@ -462,8 +471,7 @@ begin sublocale setsum: comm_monoid_set plus 0 -defines - setsum = setsum.F .. + defines setsum = setsum.F .. abbreviation Setsum ("\_" [1000] 999) where "\A \ setsum (\x. x) A" @@ -504,27 +512,28 @@ in [(@{const_syntax setsum}, K setsum_tr')] end \ -text \TODO generalization candidates\ +(* TODO generalization candidates *) lemma (in comm_monoid_add) setsum_image_gen: - assumes fS: "finite S" + assumes fin: "finite S" shows "setsum g S = setsum (\y. setsum g {x. x \ S \ f x = y}) (f ` S)" -proof- - { fix x assume "x \ S" then have "{y. y\ f`S \ f x = y} = {f x}" by auto } - hence "setsum g S = setsum (\x. setsum (\y. g x) {y. y\ f`S \ f x = y}) S" +proof - + have "{y. y\ f`S \ f x = y} = {f x}" if "x \ S" for x + using that by auto + then have "setsum g S = setsum (\x. setsum (\y. g x) {y. y\ f`S \ f x = y}) S" by simp also have "\ = setsum (\y. setsum g {x. x \ S \ f x = y}) (f ` S)" - by (rule setsum.commute_restrict [OF fS finite_imageI [OF fS]]) + by (rule setsum.commute_restrict [OF fin finite_imageI [OF fin]]) finally show ?thesis . qed subsubsection \Properties in more restricted classes of structures\ -lemma setsum_Un: "finite A ==> finite B ==> - (setsum f (A Un B) :: 'a :: ab_group_add) = - setsum f A + setsum f B - setsum f (A Int B)" -by (subst setsum.union_inter [symmetric], auto simp add: algebra_simps) +lemma setsum_Un: + "finite A \ finite B \ setsum f (A \ B) = setsum f A + setsum f B - setsum f (A \ B)" + for f :: "'b \ 'a::ab_group_add" + by (subst setsum.union_inter [symmetric]) (auto simp add: algebra_simps) lemma setsum_Un2: assumes "finite (A \ B)" @@ -532,26 +541,30 @@ proof - have "A \ B = A - B \ (B - A) \ A \ B" by auto - with assms show ?thesis by simp (subst setsum.union_disjoint, auto)+ + with assms show ?thesis + by simp (subst setsum.union_disjoint, auto)+ qed -lemma setsum_diff1: "finite A \ - (setsum f (A - {a}) :: ('a::ab_group_add)) = - (if a:A then setsum f A - f a else setsum f A)" -by (erule finite_induct) (auto simp add: insert_Diff_if) +lemma setsum_diff1: + fixes f :: "'b \ 'a::ab_group_add" + assumes "finite A" + shows "setsum f (A - {a}) = (if a \ A then setsum f A - f a else setsum f A)" + using assms by induct (auto simp: insert_Diff_if) lemma setsum_diff: - assumes le: "finite A" "B \ A" - shows "setsum f (A - B) = setsum f A - ((setsum f B)::('a::ab_group_add))" + fixes f :: "'b \ 'a::ab_group_add" + assumes "finite A" "B \ A" + shows "setsum f (A - B) = setsum f A - setsum f B" proof - - from le have finiteB: "finite B" using finite_subset by auto - show ?thesis using finiteB le + from assms(2,1) have "finite B" by (rule finite_subset) + from this \B \ A\ + show ?thesis proof induct case empty - thus ?case by auto + thus ?case by simp next case (insert x F) - thus ?case using le finiteB + with \finite A\ \finite B\ show ?case by (simp add: Diff_insert[where a=x and B=F] setsum_diff1 insert_absorb) qed qed @@ -561,45 +574,52 @@ shows "(\i\K. f i) \ (\i\K. g i)" proof (cases "finite K") case True - thus ?thesis using le + from this le show ?thesis proof induct case empty - thus ?case by simp + then show ?case by simp next case insert - thus ?case using add_mono by fastforce + then show ?case using add_mono by fastforce qed next - case False then show ?thesis by simp + case False + then show ?thesis by simp qed lemma (in strict_ordered_comm_monoid_add) setsum_strict_mono: - assumes "finite A" "A \ {}" and "\x. x \ A \ f x < g x" + assumes "finite A" "A \ {}" + and "\x. x \ A \ f x < g x" shows "setsum f A < setsum g A" using assms proof (induct rule: finite_ne_induct) - case singleton thus ?case by simp + case singleton + then show ?case by simp next - case insert thus ?case by (auto simp: add_strict_mono) + case insert + then show ?case by (auto simp: add_strict_mono) qed lemma setsum_strict_mono_ex1: fixes f g :: "'i \ 'a::ordered_cancel_comm_monoid_add" - assumes "finite A" and "\x\A. f x \ g x" and "\a\A. f a < g a" + assumes "finite A" + and "\x\A. f x \ g x" + and "\a\A. f a < g a" shows "setsum f A < setsum g A" proof- - from assms(3) obtain a where a: "a:A" "f a < g a" by blast - have "setsum f A = setsum f ((A-{a}) \ {a})" - by(simp add:insert_absorb[OF \a:A\]) - also have "\ = setsum f (A-{a}) + setsum f {a}" + from assms(3) obtain a where a: "a \ A" "f a < g a" by blast + have "setsum f A = setsum f ((A - {a}) \ {a})" + by(simp add: insert_absorb[OF \a \ A\]) + also have "\ = setsum f (A - {a}) + setsum f {a}" using \finite A\ by(subst setsum.union_disjoint) auto - also have "setsum f (A-{a}) \ setsum g (A-{a})" - by(rule setsum_mono)(simp add: assms(2)) - also have "setsum f {a} < setsum g {a}" using a by simp - also have "setsum g (A - {a}) + setsum g {a} = setsum g((A-{a}) \ {a})" - using \finite A\ by(subst setsum.union_disjoint[symmetric]) auto - also have "\ = setsum g A" by(simp add:insert_absorb[OF \a:A\]) - finally show ?thesis by (auto simp add: add_right_mono add_strict_left_mono) + also have "setsum f (A - {a}) \ setsum g (A - {a})" + by (rule setsum_mono) (simp add: assms(2)) + also from a have "setsum f {a} < setsum g {a}" by simp + also have "setsum g (A - {a}) + setsum g {a} = setsum g((A - {a}) \ {a})" + using \finite A\ by (subst setsum.union_disjoint[symmetric]) auto + also have "\ = setsum g A" by (simp add: insert_absorb[OF \a \ A\]) + finally show ?thesis + by (auto simp add: add_right_mono add_strict_left_mono) qed lemma setsum_mono_inv: @@ -609,51 +629,67 @@ assumes i: "i \ I" assumes I: "finite I" shows "f i = g i" -proof(rule ccontr) - assume "f i \ g i" +proof (rule ccontr) + assume "\ ?thesis" with le[OF i] have "f i < g i" by simp - hence "\i\I. f i < g i" using i .. - from setsum_strict_mono_ex1[OF I _ this] le have "setsum f I < setsum g I" by blast + with i have "\i\I. f i < g i" .. + from setsum_strict_mono_ex1[OF I _ this] le have "setsum f I < setsum g I" + by blast with eq show False by simp qed -lemma setsum_negf: "(\x\A. - f x::'a::ab_group_add) = - (\x\A. f x)" +lemma setsum_negf: "(\x\A. - f x) = - (\x\A. f x)" + for f :: "'b \ 'a::ab_group_add" proof (cases "finite A") - case True thus ?thesis by (induct set: finite) auto + case True + then show ?thesis by (induct set: finite) auto next - case False thus ?thesis by simp + case False + then show ?thesis by simp qed -lemma setsum_subtractf: "(\x\A. f x - g x::'a::ab_group_add) = (\x\A. f x) - (\x\A. g x)" +lemma setsum_subtractf: "(\x\A. f x - g x) = (\x\A. f x) - (\x\A. g x)" + for f g :: "'b \'a::ab_group_add" using setsum.distrib [of f "- g" A] by (simp add: setsum_negf) lemma setsum_subtractf_nat: - "(\x. x \ A \ g x \ f x) \ (\x\A. f x - g x::nat) = (\x\A. f x) - (\x\A. g x)" - by (induction A rule: infinite_finite_induct) (auto simp: setsum_mono) + "(\x. x \ A \ g x \ f x) \ (\x\A. f x - g x) = (\x\A. f x) - (\x\A. g x)" + for f g :: "'a \ nat" + by (induct A rule: infinite_finite_induct) (auto simp: setsum_mono) -lemma (in ordered_comm_monoid_add) setsum_nonneg: +context ordered_comm_monoid_add +begin + +lemma setsum_nonneg: assumes nn: "\x\A. 0 \ f x" shows "0 \ setsum f A" proof (cases "finite A") - case True thus ?thesis using nn + case True + then show ?thesis + using nn proof induct - case empty then show ?case by simp + case empty + then show ?case by simp next case (insert x F) then have "0 + 0 \ f x + setsum f F" by (blast intro: add_mono) with insert show ?case by simp qed next - case False thus ?thesis by simp + case False + then show ?thesis by simp qed -lemma (in ordered_comm_monoid_add) setsum_nonpos: +lemma setsum_nonpos: assumes np: "\x\A. f x \ 0" shows "setsum f A \ 0" proof (cases "finite A") - case True thus ?thesis using np + case True + then show ?thesis + using np proof induct - case empty then show ?case by simp + case empty + then show ?case by simp next case (insert x F) then have "f x + setsum f F \ 0 + 0" by (blast intro: add_mono) @@ -663,232 +699,259 @@ case False thus ?thesis by simp qed -lemma (in ordered_comm_monoid_add) setsum_nonneg_eq_0_iff: +lemma setsum_nonneg_eq_0_iff: "finite A \ \x\A. 0 \ f x \ setsum f A = 0 \ (\x\A. f x = 0)" - by (induct set: finite, simp) (simp add: add_nonneg_eq_0_iff setsum_nonneg) + by (induct set: finite) (simp_all add: add_nonneg_eq_0_iff setsum_nonneg) -lemma (in ordered_comm_monoid_add) setsum_nonneg_0: +lemma setsum_nonneg_0: "finite s \ (\i. i \ s \ f i \ 0) \ (\ i \ s. f i) = 0 \ i \ s \ f i = 0" by (simp add: setsum_nonneg_eq_0_iff) -lemma (in ordered_comm_monoid_add) setsum_nonneg_leq_bound: +lemma setsum_nonneg_leq_bound: assumes "finite s" "\i. i \ s \ f i \ 0" "(\i \ s. f i) = B" "i \ s" shows "f i \ B" proof - - have "f i \ f i + (\i \ s - {i}. f i)" - using assms by (intro add_increasing2 setsum_nonneg) auto + from assms have "f i \ f i + (\i \ s - {i}. f i)" + by (intro add_increasing2 setsum_nonneg) auto also have "\ = B" using setsum.remove[of s i f] assms by simp finally show ?thesis by auto qed -lemma (in ordered_comm_monoid_add) setsum_mono2: - assumes fin: "finite B" and sub: "A \ B" and nn: "\b. b \ B-A \ 0 \ f b" +lemma setsum_mono2: + assumes fin: "finite B" + and sub: "A \ B" + and nn: "\b. b \ B-A \ 0 \ f b" shows "setsum f A \ setsum f B" proof - have "setsum f A \ setsum f A + setsum f (B-A)" by(simp add: add_increasing2[OF setsum_nonneg] nn Ball_def) - also have "\ = setsum f (A \ (B-A))" using fin finite_subset[OF sub fin] - by (simp add: setsum.union_disjoint del:Un_Diff_cancel) - also have "A \ (B-A) = B" using sub by blast + also from fin finite_subset[OF sub fin] have "\ = setsum f (A \ (B-A))" + by (simp add: setsum.union_disjoint del: Un_Diff_cancel) + also from sub have "A \ (B-A) = B" by blast finally show ?thesis . qed -lemma (in ordered_comm_monoid_add) setsum_le_included: +lemma setsum_le_included: assumes "finite s" "finite t" and "\y\t. 0 \ g y" "(\x\s. \y\t. i y = x \ f x \ g y)" shows "setsum f s \ setsum g t" proof - have "setsum f s \ setsum (\y. setsum g {x. x\t \ i x = y}) s" proof (rule setsum_mono) - fix y assume "y \ s" + fix y + assume "y \ s" with assms obtain z where z: "z \ t" "y = i z" "f y \ g z" by auto with assms show "f y \ setsum g {x \ t. i x = y}" (is "?A y \ ?B y") using order_trans[of "?A (i z)" "setsum g {z}" "?B (i z)", intro] by (auto intro!: setsum_mono2) qed - also have "... \ setsum (\y. setsum g {x. x\t \ i x = y}) (i ` t)" + also have "\ \ setsum (\y. setsum g {x. x\t \ i x = y}) (i ` t)" using assms(2-4) by (auto intro!: setsum_mono2 setsum_nonneg) - also have "... \ setsum g t" + also have "\ \ setsum g t" using assms by (auto simp: setsum_image_gen[symmetric]) finally show ?thesis . qed -lemma (in ordered_comm_monoid_add) setsum_mono3: - "finite B \ A \ B \ \x\B - A. 0 \ f x \ setsum f A \ setsum f B" +lemma setsum_mono3: "finite B \ A \ B \ \x\B - A. 0 \ f x \ setsum f A \ setsum f B" by (rule setsum_mono2) auto +end + lemma (in canonically_ordered_monoid_add) setsum_eq_0_iff [simp]: "finite F \ (setsum f F = 0) = (\a\F. f a = 0)" by (intro ballI setsum_nonneg_eq_0_iff zero_le) lemma setsum_right_distrib: - fixes f :: "'a => ('b::semiring_0)" - shows "r * setsum f A = setsum (%n. r * f n) A" + fixes f :: "'a \ 'b::semiring_0" + shows "r * setsum f A = setsum (\n. r * f n) A" proof (cases "finite A") case True - thus ?thesis + then show ?thesis proof induct - case empty thus ?case by simp + case empty + then show ?case by simp next - case (insert x A) thus ?case by (simp add: distrib_left) + case insert + then show ?case by (simp add: distrib_left) qed next - case False thus ?thesis by simp + case False + then show ?thesis by simp qed -lemma setsum_left_distrib: - "setsum f A * (r::'a::semiring_0) = (\n\A. f n * r)" +lemma setsum_left_distrib: "setsum f A * r = (\n\A. f n * r)" + for r :: "'a::semiring_0" proof (cases "finite A") case True then show ?thesis proof induct - case empty thus ?case by simp + case empty + then show ?case by simp next - case (insert x A) thus ?case by (simp add: distrib_right) + case insert + then show ?case by (simp add: distrib_right) + qed +next + case False + then show ?thesis by simp +qed + +lemma setsum_divide_distrib: "setsum f A / r = (\n\A. f n / r)" + for r :: "'a::field" +proof (cases "finite A") + case True + then show ?thesis + proof induct + case empty + then show ?case by simp + next + case insert + then show ?case by (simp add: add_divide_distrib) qed next - case False thus ?thesis by simp + case False + then show ?thesis by simp qed -lemma setsum_divide_distrib: - "setsum f A / (r::'a::field) = (\n\A. f n / r)" +lemma setsum_abs[iff]: "\setsum f A\ \ setsum (\i. \f i\) A" + for f :: "'a \ 'b::ordered_ab_group_add_abs" +proof (cases "finite A") + case True + then show ?thesis + proof induct + case empty + then show ?case by simp + next + case insert + then show ?case by (auto intro: abs_triangle_ineq order_trans) + qed +next + case False + then show ?thesis by simp +qed + +lemma setsum_abs_ge_zero[iff]: "0 \ setsum (\i. \f i\) A" + for f :: "'a \ 'b::ordered_ab_group_add_abs" + by (simp add: setsum_nonneg) + +lemma abs_setsum_abs[simp]: "\\a\A. \f a\\ = (\a\A. \f a\)" + for f :: "'a \ 'b::ordered_ab_group_add_abs" proof (cases "finite A") case True then show ?thesis proof induct - case empty thus ?case by simp - next - case (insert x A) thus ?case by (simp add: add_divide_distrib) - qed -next - case False thus ?thesis by simp -qed - -lemma setsum_abs[iff]: - fixes f :: "'a => ('b::ordered_ab_group_add_abs)" - shows "\setsum f A\ \ setsum (%i. \f i\) A" -proof (cases "finite A") - case True - thus ?thesis - proof induct - case empty thus ?case by simp - next - case (insert x A) - thus ?case by (auto intro: abs_triangle_ineq order_trans) - qed -next - case False thus ?thesis by simp -qed - -lemma setsum_abs_ge_zero[iff]: - fixes f :: "'a => ('b::ordered_ab_group_add_abs)" - shows "0 \ setsum (%i. \f i\) A" - by (simp add: setsum_nonneg) - -lemma abs_setsum_abs[simp]: - fixes f :: "'a => ('b::ordered_ab_group_add_abs)" - shows "\\a\A. \f a\\ = (\a\A. \f a\)" -proof (cases "finite A") - case True - thus ?thesis - proof induct - case empty thus ?case by simp + case empty + then show ?case by simp next case (insert a A) - hence "\\a\insert a A. \f a\\ = \\f a\ + (\a\A. \f a\)\" by simp - also have "\ = \\f a\ + \\a\A. \f a\\\" using insert by simp - also have "\ = \f a\ + \\a\A. \f a\\" - by (simp del: abs_of_nonneg) - also have "\ = (\a\insert a A. \f a\)" using insert by simp + then have "\\a\insert a A. \f a\\ = \\f a\ + (\a\A. \f a\)\" by simp + also from insert have "\ = \\f a\ + \\a\A. \f a\\\" by simp + also have "\ = \f a\ + \\a\A. \f a\\" by (simp del: abs_of_nonneg) + also from insert have "\ = (\a\insert a A. \f a\)" by simp finally show ?case . qed next - case False thus ?thesis by simp + case False + then show ?thesis by simp qed -lemma setsum_diff1_ring: assumes "finite A" "a \ A" - shows "setsum f (A - {a}) = setsum f A - (f a::'a::ring)" +lemma setsum_diff1_ring: + fixes f :: "'b \ 'a::ring" + assumes "finite A" "a \ A" + shows "setsum f (A - {a}) = setsum f A - (f a)" unfolding setsum.remove [OF assms] by auto lemma setsum_product: - fixes f :: "'a => ('b::semiring_0)" + fixes f :: "'a \ 'b::semiring_0" shows "setsum f A * setsum g B = (\i\A. \j\B. f i * g j)" by (simp add: setsum_right_distrib setsum_left_distrib) (rule setsum.commute) lemma setsum_mult_setsum_if_inj: -fixes f :: "'a => ('b::semiring_0)" -shows "inj_on (%(a,b). f a * g b) (A \ B) ==> - setsum f A * setsum g B = setsum id {f a * g b|a b. a:A & b:B}" -by(auto simp: setsum_product setsum.cartesian_product - intro!: setsum.reindex_cong[symmetric]) + fixes f :: "'a \ 'b::semiring_0" + shows "inj_on (\(a, b). f a * g b) (A \ B) \ + setsum f A * setsum g B = setsum id {f a * g b |a b. a \ A \ b \ B}" + by(auto simp: setsum_product setsum.cartesian_product intro!: setsum.reindex_cong[symmetric]) -lemma setsum_SucD: "setsum f A = Suc n ==> EX a:A. 0 < f a" -apply (case_tac "finite A") - prefer 2 apply simp -apply (erule rev_mp) -apply (erule finite_induct, auto) -done +lemma setsum_SucD: + assumes "setsum f A = Suc n" + shows "\a\A. 0 < f a" +proof (cases "finite A") + case True + from this assms show ?thesis by induct auto +next + case False + with assms show ?thesis by simp +qed -lemma setsum_eq_Suc0_iff: "finite A \ - setsum f A = Suc 0 \ (EX a:A. f a = Suc 0 & (ALL b:A. a\b \ f b = 0))" -apply(erule finite_induct) -apply (auto simp add:add_is_1) -done +lemma setsum_eq_Suc0_iff: + assumes "finite A" + shows "setsum f A = Suc 0 \ (\a\A. f a = Suc 0 \ (\b\A. a \ b \ f b = 0))" + using assms by induct (auto simp add:add_is_1) lemmas setsum_eq_1_iff = setsum_eq_Suc0_iff[simplified One_nat_def[symmetric]] -lemma setsum_Un_nat: "finite A ==> finite B ==> - (setsum f (A Un B) :: nat) = setsum f A + setsum f B - setsum f (A Int B)" +lemma setsum_Un_nat: + "finite A \ finite B \ setsum f (A \ B) = setsum f A + setsum f B - setsum f (A \ B)" + for f :: "'a \ nat" \ \For the natural numbers, we have subtraction.\ -by (subst setsum.union_inter [symmetric], auto simp add: algebra_simps) + by (subst setsum.union_inter [symmetric]) (auto simp: algebra_simps) -lemma setsum_diff1_nat: "(setsum f (A - {a}) :: nat) = - (if a:A then setsum f A - f a else setsum f A)" -apply (case_tac "finite A") - prefer 2 apply simp -apply (erule finite_induct) - apply (auto simp add: insert_Diff_if) -apply (drule_tac a = a in mk_disjoint_insert, auto) -done +lemma setsum_diff1_nat: "setsum f (A - {a}) = (if a \ A then setsum f A - f a else setsum f A)" + for f :: "'a \ nat" +proof (cases "finite A") + case True + then show ?thesis + apply induct + apply (auto simp: insert_Diff_if) + apply (drule mk_disjoint_insert) + apply auto + done +next + case False + then show ?thesis by simp +qed lemma setsum_diff_nat: -assumes "finite B" and "B \ A" -shows "(setsum f (A - B) :: nat) = (setsum f A) - (setsum f B)" -using assms + fixes f :: "'a \ nat" + assumes "finite B" and "B \ A" + shows "setsum f (A - B) = setsum f A - setsum f B" + using assms proof induct - show "setsum f (A - {}) = (setsum f A) - (setsum f {})" by simp + case empty + then show ?case by simp next - fix F x assume finF: "finite F" and xnotinF: "x \ F" - and xFinA: "insert x F \ A" - and IH: "F \ A \ setsum f (A - F) = setsum f A - setsum f F" - from xnotinF xFinA have xinAF: "x \ (A - F)" by simp - from xinAF have A: "setsum f ((A - F) - {x}) = setsum f (A - F) - f x" + case (insert x F) + note IH = \F \ A \ setsum f (A - F) = setsum f A - setsum f F\ + from \x \ F\ \insert x F \ A\ have "x \ A - F" by simp + then have A: "setsum f ((A - F) - {x}) = setsum f (A - F) - f x" by (simp add: setsum_diff1_nat) - from xFinA have "F \ A" by simp + from \insert x F \ A\ have "F \ A" by simp with IH have "setsum f (A - F) = setsum f A - setsum f F" by simp with A have B: "setsum f ((A - F) - {x}) = setsum f A - setsum f F - f x" by simp - from xnotinF have "A - insert x F = (A - F) - {x}" by auto + from \x \ F\ have "A - insert x F = (A - F) - {x}" by auto with B have C: "setsum f (A - insert x F) = setsum f A - setsum f F - f x" by simp - from finF xnotinF have "setsum f (insert x F) = setsum f F + f x" by simp + from \finite F\ \x \ F\ have "setsum f (insert x F) = setsum f F + f x" + by simp with C have "setsum f (A - insert x F) = setsum f A - setsum f (insert x F)" by simp - thus "setsum f (A - insert x F) = setsum f A - setsum f (insert x F)" by simp + then show ?case by simp qed lemma setsum_comp_morphism: assumes "h 0 = 0" and "\x y. h (x + y) = h x + h y" shows "setsum (h \ g) A = h (setsum g A)" proof (cases "finite A") - case False then show ?thesis by (simp add: assms) + case False + then show ?thesis by (simp add: assms) next - case True then show ?thesis by (induct A) (simp_all add: assms) + case True + then show ?thesis by (induct A) (simp_all add: assms) qed -lemma (in comm_semiring_1) dvd_setsum: - "(\a. a \ A \ d dvd f a) \ d dvd setsum f A" +lemma (in comm_semiring_1) dvd_setsum: "(\a. a \ A \ d dvd f a) \ d dvd setsum f A" by (induct A rule: infinite_finite_induct) simp_all lemma (in ordered_comm_monoid_add) setsum_pos: @@ -908,17 +971,18 @@ lemma setsum_cong_Suc: assumes "0 \ A" "\x. Suc x \ A \ f (Suc x) = g (Suc x)" - shows "setsum f A = setsum g A" + shows "setsum f A = setsum g A" proof (rule setsum.cong) - fix x assume "x \ A" - with assms(1) show "f x = g x" by (cases x) (auto intro!: assms(2)) + fix x + assume "x \ A" + with assms(1) show "f x = g x" + by (cases x) (auto intro!: assms(2)) qed simp_all subsubsection \Cardinality as special case of @{const setsum}\ -lemma card_eq_setsum: - "card A = setsum (\x. 1) A" +lemma card_eq_setsum: "card A = setsum (\x. 1) A" proof - have "plus \ (\_. Suc 0) = (\_. Suc)" by (simp add: fun_eq_iff) @@ -926,45 +990,53 @@ by (rule arg_cong) then have "Finite_Set.fold (plus \ (\_. Suc 0)) 0 A = Finite_Set.fold (\_. Suc) 0 A" by (blast intro: fun_cong) - then show ?thesis by (simp add: card.eq_fold setsum.eq_fold) + then show ?thesis + by (simp add: card.eq_fold setsum.eq_fold) qed -lemma setsum_constant [simp]: - "(\x \ A. y) = of_nat (card A) * y" -apply (cases "finite A") -apply (erule finite_induct) -apply (auto simp add: algebra_simps) -done +lemma setsum_constant [simp]: "(\x \ A. y) = of_nat (card A) * y" +proof (cases "finite A") + case True + then show ?thesis by induct (auto simp: algebra_simps) +next + case False + then show ?thesis by simp +qed lemma setsum_Suc: "setsum (\x. Suc(f x)) A = setsum f A + card A" - using setsum.distrib[of f "\_. 1" A] - by simp + using setsum.distrib[of f "\_. 1" A] by simp lemma setsum_bounded_above: - assumes le: "\i. i\A \ f i \ (K::'a::{semiring_1, ordered_comm_monoid_add})" + fixes K :: "'a::{semiring_1,ordered_comm_monoid_add}" + assumes le: "\i. i\A \ f i \ K" shows "setsum f A \ of_nat (card A) * K" proof (cases "finite A") case True - thus ?thesis using le setsum_mono[where K=A and g = "%x. K"] by simp + then show ?thesis + using le setsum_mono[where K=A and g = "\x. K"] by simp next - case False thus ?thesis by simp + case False + then show ?thesis by simp qed lemma setsum_bounded_above_strict: - assumes "\i. i\A \ f i < (K::'a::{ordered_cancel_comm_monoid_add,semiring_1})" - "card A > 0" + fixes K :: "'a::{ordered_cancel_comm_monoid_add,semiring_1}" + assumes "\i. i\A \ f i < K" "card A > 0" shows "setsum f A < of_nat (card A) * K" -using assms setsum_strict_mono[where A=A and g = "%x. K"] -by (simp add: card_gt_0_iff) + using assms setsum_strict_mono[where A=A and g = "\x. K"] + by (simp add: card_gt_0_iff) lemma setsum_bounded_below: - assumes le: "\i. i\A \ (K::'a::{semiring_1, ordered_comm_monoid_add}) \ f i" + fixes K :: "'a::{semiring_1,ordered_comm_monoid_add}" + assumes le: "\i. i\A \ K \ f i" shows "of_nat (card A) * K \ setsum f A" proof (cases "finite A") case True - thus ?thesis using le setsum_mono[where K=A and f = "%x. K"] by simp + then show ?thesis + using le setsum_mono[where K=A and f = "%x. K"] by simp next - case False thus ?thesis by simp + case False + then show ?thesis by simp qed lemma card_UN_disjoint: @@ -972,24 +1044,26 @@ and "\i\I. \j\I. i \ j \ A i \ A j = {}" shows "card (UNION I A) = (\i\I. card(A i))" proof - - have "(\i\I. card (A i)) = (\i\I. \x\A i. 1)" by simp - with assms show ?thesis by (simp add: card_eq_setsum setsum.UNION_disjoint del: setsum_constant) + have "(\i\I. card (A i)) = (\i\I. \x\A i. 1)" + by simp + with assms show ?thesis + by (simp add: card_eq_setsum setsum.UNION_disjoint del: setsum_constant) qed lemma card_Union_disjoint: - "finite C ==> (ALL A:C. finite A) ==> - (ALL A:C. ALL B:C. A \ B --> A Int B = {}) - ==> card (\C) = setsum card C" -apply (frule card_UN_disjoint [of C id]) -apply simp_all -done + "finite C \ \A\C. finite A \ \A\C. \B\C. A \ B \ A \ B = {} \ + card (\C) = setsum card C" + by (frule card_UN_disjoint [of C id]) simp_all lemma setsum_multicount_gen: assumes "finite s" "finite t" "\j\t. (card {i\s. R i j} = k j)" - shows "setsum (\i. (card {j\t. R i j})) s = setsum k t" (is "?l = ?r") + shows "setsum (\i. (card {j\t. R i j})) s = setsum k t" + (is "?l = ?r") proof- - have "?l = setsum (\i. setsum (\x.1) {j\t. R i j}) s" by auto - also have "\ = ?r" unfolding setsum.commute_restrict [OF assms(1-2)] + have "?l = setsum (\i. setsum (\x.1) {j\t. R i j}) s" + by auto + also have "\ = ?r" + unfolding setsum.commute_restrict [OF assms(1-2)] using assms(3) by auto finally show ?thesis . qed @@ -998,17 +1072,18 @@ assumes "finite S" "finite T" "\j\T. (card {i\S. R i j} = k)" shows "setsum (\i. card {j\T. R i j}) S = k * card T" (is "?l = ?r") proof- - have "?l = setsum (\i. k) T" by (rule setsum_multicount_gen) (auto simp: assms) + have "?l = setsum (\i. k) T" + by (rule setsum_multicount_gen) (auto simp: assms) also have "\ = ?r" by (simp add: mult.commute) finally show ?thesis by auto qed + subsubsection \Cardinality of products\ lemma card_SigmaI [simp]: - "\ finite A; ALL a:A. finite (B a) \ - \ card (SIGMA x: A. B x) = (\a\A. card (B a))" -by(simp add: card_eq_setsum setsum.Sigma del:setsum_constant) + "finite A \ \a\A. finite (B a) \ card (SIGMA x: A. B x) = (\a\A. card (B a))" + by (simp add: card_eq_setsum setsum.Sigma del: setsum_constant) (* lemma SigmaI_insert: "y \ A ==> @@ -1016,12 +1091,12 @@ by auto *) -lemma card_cartesian_product: "card (A \ B) = card(A) * card(B)" +lemma card_cartesian_product: "card (A \ B) = card A * card B" by (cases "finite A \ finite B") (auto simp add: card_eq_0_iff dest: finite_cartesian_productD1 finite_cartesian_productD2) -lemma card_cartesian_product_singleton: "card({x} \ A) = card(A)" -by (simp add: card_cartesian_product) +lemma card_cartesian_product_singleton: "card ({x} \ A) = card A" + by (simp add: card_cartesian_product) subsection \Generalized product over a set\ @@ -1030,12 +1105,10 @@ begin sublocale setprod: comm_monoid_set times 1 -defines - setprod = setprod.F .. + defines setprod = setprod.F .. -abbreviation - Setprod ("\_" [1000] 999) where - "\A \ setprod (\x. x) A" +abbreviation Setprod ("\_" [1000] 999) + where "\A \ setprod (\x. x) A" end @@ -1058,22 +1131,26 @@ context comm_monoid_mult begin -lemma setprod_dvd_setprod: - "(\a. a \ A \ f a dvd g a) \ setprod f A dvd setprod g A" +lemma setprod_dvd_setprod: "(\a. a \ A \ f a dvd g a) \ setprod f A dvd setprod g A" proof (induct A rule: infinite_finite_induct) - case infinite then show ?case by (auto intro: dvdI) + case infinite + then show ?case by (auto intro: dvdI) +next + case empty + then show ?case by (auto intro: dvdI) next - case empty then show ?case by (auto intro: dvdI) -next - case (insert a A) then - have "f a dvd g a" and "setprod f A dvd setprod g A" by simp_all - then obtain r s where "g a = f a * r" and "setprod g A = setprod f A * s" by (auto elim!: dvdE) - then have "g a * setprod g A = f a * setprod f A * (r * s)" by (simp add: ac_simps) - with insert.hyps show ?case by (auto intro: dvdI) + case (insert a A) + then have "f a dvd g a" and "setprod f A dvd setprod g A" + by simp_all + then obtain r s where "g a = f a * r" and "setprod g A = setprod f A * s" + by (auto elim!: dvdE) + then have "g a * setprod g A = f a * setprod f A * (r * s)" + by (simp add: ac_simps) + with insert.hyps show ?case + by (auto intro: dvdI) qed -lemma setprod_dvd_setprod_subset: - "finite B \ A \ B \ setprod f A dvd setprod f B" +lemma setprod_dvd_setprod_subset: "finite B \ A \ B \ setprod f A dvd setprod f B" by (auto simp add: setprod.subset_diff ac_simps intro: dvdI) end @@ -1090,21 +1167,23 @@ proof - from \finite A\ have "setprod f (insert a (A - {a})) = f a * setprod f (A - {a})" by (intro setprod.insert) auto - also from \a \ A\ have "insert a (A - {a}) = A" by blast + also from \a \ A\ have "insert a (A - {a}) = A" + by blast finally have "setprod f A = f a * setprod f (A - {a})" . - with \b = f a\ show ?thesis by simp + with \b = f a\ show ?thesis + by simp qed -lemma dvd_setprodI [intro]: - assumes "finite A" and "a \ A" - shows "f a dvd setprod f A" - using assms by auto +lemma dvd_setprodI [intro]: "finite A \ a \ A \ f a dvd setprod f A" + by auto lemma setprod_zero: assumes "finite A" and "\a\A. f a = 0" shows "setprod f A = 0" -using assms proof (induct A) - case empty then show ?case by simp + using assms +proof (induct A) + case empty + then show ?case by simp next case (insert a A) then have "f a = 0 \ (\a\A. f a = 0)" by simp @@ -1126,71 +1205,73 @@ end lemma setprod_zero_iff [simp]: + fixes f :: "'b \ 'a::semidom" assumes "finite A" - shows "setprod f A = (0::'a::semidom) \ (\a\A. f a = 0)" + shows "setprod f A = 0 \ (\a\A. f a = 0)" using assms by (induct A) (auto simp: no_zero_divisors) lemma (in semidom_divide) setprod_diff1: assumes "finite A" and "f a \ 0" shows "setprod f (A - {a}) = (if a \ A then setprod f A div f a else setprod f A)" proof (cases "a \ A") - case True then show ?thesis by simp + case True + then show ?thesis by simp next - case False with assms show ?thesis - proof (induct A rule: finite_induct) - case empty then show ?case by simp + case False + with assms show ?thesis + proof induct + case empty + then show ?case by simp next case (insert b B) then show ?case proof (cases "a = b") - case True with insert show ?thesis by simp + case True + with insert show ?thesis by simp next - case False with insert have "a \ B" by simp + case False + with insert have "a \ B" by simp define C where "C = B - {a}" - with \finite B\ \a \ B\ - have *: "B = insert a C" "finite C" "a \ C" by auto - with insert show ?thesis by (auto simp add: insert_commute ac_simps) + with \finite B\ \a \ B\ have "B = insert a C" "finite C" "a \ C" + by auto + with insert show ?thesis + by (auto simp add: insert_commute ac_simps) qed qed qed -lemma setsum_zero_power [simp]: - fixes c :: "nat \ 'a::division_ring" - shows "(\i\A. c i * 0^i) = (if finite A \ 0 \ A then c 0 else 0)" -apply (cases "finite A") - by (induction A rule: finite_induct) auto +lemma setsum_zero_power [simp]: "(\i\A. c i * 0^i) = (if finite A \ 0 \ A then c 0 else 0)" + for c :: "nat \ 'a::division_ring" + by (induct A rule: infinite_finite_induct) auto lemma setsum_zero_power' [simp]: - fixes c :: "nat \ 'a::field" - shows "(\i\A. c i * 0^i / d i) = (if finite A \ 0 \ A then c 0 / d 0 else 0)" - using setsum_zero_power [of "\i. c i / d i" A] - by auto + "(\i\A. c i * 0^i / d i) = (if finite A \ 0 \ A then c 0 / d 0 else 0)" + for c :: "nat \ 'a::field" + using setsum_zero_power [of "\i. c i / d i" A] by auto lemma (in field) setprod_inversef: "finite A \ setprod (inverse \ f) A = inverse (setprod f A)" by (induct A rule: finite_induct) simp_all -lemma (in field) setprod_dividef: - "finite A \ (\x\A. f x / g x) = setprod f A / setprod g A" +lemma (in field) setprod_dividef: "finite A \ (\x\A. f x / g x) = setprod f A / setprod g A" using setprod_inversef [of A g] by (simp add: divide_inverse setprod.distrib) lemma setprod_Un: fixes f :: "'b \ 'a :: field" assumes "finite A" and "finite B" - and "\x\A \ B. f x \ 0" + and "\x\A \ B. f x \ 0" shows "setprod f (A \ B) = setprod f A * setprod f B / setprod f (A \ B)" proof - from assms have "setprod f A * setprod f B = setprod f (A \ B) * setprod f (A \ B)" by (simp add: setprod.union_inter [symmetric, of A B]) - with assms show ?thesis by simp + with assms show ?thesis + by simp qed -lemma (in linordered_semidom) setprod_nonneg: - "(\a\A. 0 \ f a) \ 0 \ setprod f A" +lemma (in linordered_semidom) setprod_nonneg: "(\a\A. 0 \ f a) \ 0 \ setprod f A" by (induct A rule: infinite_finite_induct) simp_all -lemma (in linordered_semidom) setprod_pos: - "(\a\A. 0 < f a) \ 0 < setprod f A" +lemma (in linordered_semidom) setprod_pos: "(\a\A. 0 < f a) \ 0 < setprod f A" by (induct A rule: infinite_finite_induct) simp_all lemma (in linordered_semidom) setprod_mono: @@ -1198,71 +1279,69 @@ by (induct A rule: infinite_finite_induct) (auto intro!: setprod_nonneg mult_mono) lemma (in linordered_semidom) setprod_mono_strict: - assumes"finite A" "\i\A. 0 \ f i \ f i < g i" "A \ {}" - shows "setprod f A < setprod g A" -using assms -apply (induct A rule: finite_induct) -apply (simp add: ) -apply (force intro: mult_strict_mono' setprod_nonneg) -done + assumes "finite A" "\i\A. 0 \ f i \ f i < g i" "A \ {}" + shows "setprod f A < setprod g A" + using assms +proof (induct A rule: finite_induct) + case empty + then show ?case by simp +next + case insert + then show ?case by (force intro: mult_strict_mono' setprod_nonneg) +qed -lemma (in linordered_field) abs_setprod: - "\setprod f A\ = (\x\A. \f x\)" +lemma (in linordered_field) abs_setprod: "\setprod f A\ = (\x\A. \f x\)" by (induct A rule: infinite_finite_induct) (simp_all add: abs_mult) -lemma setprod_eq_1_iff [simp]: - "finite A \ setprod f A = 1 \ (\a\A. f a = (1::nat))" +lemma setprod_eq_1_iff [simp]: "finite A \ setprod f A = 1 \ (\a\A. f a = 1)" + for f :: "'a \ nat" by (induct A rule: finite_induct) simp_all -lemma setprod_pos_nat_iff [simp]: - "finite A \ setprod f A > 0 \ (\a\A. f a > (0::nat))" +lemma setprod_pos_nat_iff [simp]: "finite A \ setprod f A > 0 \ (\a\A. f a > 0)" + for f :: "'a \ nat" using setprod_zero_iff by (simp del: neq0_conv add: zero_less_iff_neq_zero) -lemma setprod_constant: - "(\x\ A. (y::'a::comm_monoid_mult)) = y ^ card A" +lemma setprod_constant: "(\x\ A. y) = y ^ card A" + for y :: "'a::comm_monoid_mult" by (induct A rule: infinite_finite_induct) simp_all -lemma setprod_power_distrib: - fixes f :: "'a \ 'b::comm_semiring_1" - shows "setprod f A ^ n = setprod (\x. (f x) ^ n) A" -proof (cases "finite A") - case True then show ?thesis - by (induct A rule: finite_induct) (auto simp add: power_mult_distrib) -next - case False then show ?thesis - by simp -qed +lemma setprod_power_distrib: "setprod f A ^ n = setprod (\x. (f x) ^ n) A" + for f :: "'a \ 'b::comm_semiring_1" + by (induct A rule: infinite_finite_induct) (auto simp add: power_mult_distrib) -lemma power_setsum: - "c ^ (\a\A. f a) = (\a\A. c ^ f a)" +lemma power_setsum: "c ^ (\a\A. f a) = (\a\A. c ^ f a)" by (induct A rule: infinite_finite_induct) (simp_all add: power_add) lemma setprod_gen_delta: - assumes fS: "finite S" - shows "setprod (\k. if k=a then b k else c) S = (if a \ S then (b a ::'a::comm_monoid_mult) * c^ (card S - 1) else c^ card S)" -proof- + fixes b :: "'b \ 'a::comm_monoid_mult" + assumes fin: "finite S" + shows "setprod (\k. if k = a then b k else c) S = + (if a \ S then b a * c ^ (card S - 1) else c ^ card S)" +proof - let ?f = "(\k. if k=a then b k else c)" - {assume a: "a \ S" - hence "\ k\ S. ?f k = c" by simp - hence ?thesis using a setprod_constant by simp } - moreover - {assume a: "a \ S" + show ?thesis + proof (cases "a \ S") + case False + then have "\ k\ S. ?f k = c" by simp + with False show ?thesis by (simp add: setprod_constant) + next + case True let ?A = "S - {a}" let ?B = "{a}" - have eq: "S = ?A \ ?B" using a by blast - have dj: "?A \ ?B = {}" by simp - from fS have fAB: "finite ?A" "finite ?B" by auto - have fA0:"setprod ?f ?A = setprod (\i. c) ?A" + from True have eq: "S = ?A \ ?B" by blast + have disjoint: "?A \ ?B = {}" by simp + from fin have fin': "finite ?A" "finite ?B" by auto + have f_A0: "setprod ?f ?A = setprod (\i. c) ?A" by (rule setprod.cong) auto - have cA: "card ?A = card S - 1" using fS a by auto - have fA1: "setprod ?f ?A = c ^ card ?A" - unfolding fA0 by (rule setprod_constant) + from fin True have card_A: "card ?A = card S - 1" by auto + have f_A1: "setprod ?f ?A = c ^ card ?A" + unfolding f_A0 by (rule setprod_constant) have "setprod ?f ?A * setprod ?f ?B = setprod ?f S" - using setprod.union_disjoint[OF fAB dj, of ?f, unfolded eq[symmetric]] + using setprod.union_disjoint[OF fin' disjoint, of ?f, unfolded eq[symmetric]] by simp - then have ?thesis using a cA - by (simp add: fA1 field_simps cong add: setprod.cong cong del: if_weak_cong)} - ultimately show ?thesis by blast + with True card_A show ?thesis + by (simp add: f_A1 field_simps cong add: setprod.cong cong del: if_weak_cong) + qed qed end