# HG changeset patch # User paulson # Date 1633360278 -3600 # Node ID aca96bd12b12bcb658a8027c780de2b8198fab75 # Parent e1b5bf983de36a6d300df3cc385f8646bd05d450# Parent c278b186459227c79596a4be8028e283cd90badd merged diff -r e1b5bf983de3 -r aca96bd12b12 src/HOL/Analysis/Ball_Volume.thy --- a/src/HOL/Analysis/Ball_Volume.thy Mon Oct 04 15:01:50 2021 +0200 +++ b/src/HOL/Analysis/Ball_Volume.thy Mon Oct 04 16:11:18 2021 +0100 @@ -1,4 +1,4 @@ -(* +(* File: HOL/Analysis/Ball_Volume.thy Author: Manuel Eberl, TU München *) @@ -25,11 +25,11 @@ text \ We first need the value of the following integral, which is at the core of - computing the measure of an \n + 1\-dimensional ball in terms of the measure of an + computing the measure of an \n + 1\-dimensional ball in terms of the measure of an \n\-dimensional one. \ lemma emeasure_cball_aux_integral: - "(\\<^sup>+x. indicator {-1..1} x * sqrt (1 - x\<^sup>2) ^ n \lborel) = + "(\\<^sup>+x. indicator {-1..1} x * sqrt (1 - x\<^sup>2) ^ n \lborel) = ennreal (Beta (1 / 2) (real n / 2 + 1))" proof - have "((\t. t powr (-1 / 2) * (1 - t) powr (real n / 2)) has_integral @@ -37,7 +37,7 @@ using has_integral_Beta_real[of "1/2" "n / 2 + 1"] by simp from nn_integral_has_integral_lebesgue[OF _ this] have "ennreal (Beta (1 / 2) (real n / 2 + 1)) = - nn_integral lborel (\t. ennreal (t powr (-1 / 2) * (1 - t) powr (real n / 2) * + nn_integral lborel (\t. ennreal (t powr (-1 / 2) * (1 - t) powr (real n / 2) * indicator {0^2..1^2} t))" by (simp add: mult_ac ennreal_mult' ennreal_indicator) also have "\ = (\\<^sup>+ x. ennreal (x\<^sup>2 powr - (1 / 2) * (1 - x\<^sup>2) powr (real n / 2) * (2 * x) * @@ -45,7 +45,7 @@ by (subst nn_integral_substitution[where g = "\x. x ^ 2" and g' = "\x. 2 * x"]) (auto intro!: derivative_eq_intros continuous_intros simp: set_borel_measurable_def) also have "\ = (\\<^sup>+ x. 2 * ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {0..1} x) \lborel)" - by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"]) + by (intro nn_integral_cong_AE AE_I[of _ _ "{0}"]) (auto simp: indicator_def powr_minus powr_half_sqrt field_split_simps ennreal_mult') also have "\ = (\\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {0..1} x) \lborel) + (\\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {0..1} x) \lborel)" @@ -54,7 +54,7 @@ by (subst nn_integral_real_affine[of _ "-1" 0]) (auto simp: indicator_def intro!: nn_integral_cong) hence "?I + ?I = \ + ?I" by simp - also have "\ = (\\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * + also have "\ = (\\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * (indicator {-1..0} x + indicator{0..1} x)) \lborel)" by (subst nn_integral_add [symmetric]) (auto simp: algebra_simps) also have "\ = (\\<^sup>+ x. ennreal ((1 - x\<^sup>2) powr (real n / 2) * indicator {-1..1} x) \lborel)" @@ -69,13 +69,10 @@ lemma real_sqrt_le_iff': "x \ 0 \ y \ 0 \ sqrt x \ y \ x \ y ^ 2" using real_le_lsqrt sqrt_le_D by blast -lemma power2_le_iff_abs_le: "y \ 0 \ (x::real) ^ 2 \ y ^ 2 \ abs x \ y" - by (subst real_sqrt_le_iff' [symmetric]) auto - text \ - Isabelle's type system makes it very difficult to do an induction over the dimension - of a Euclidean space type, because the type would change in the inductive step. To avoid - this problem, we instead formulate the problem in a more concrete way by unfolding the + Isabelle's type system makes it very difficult to do an induction over the dimension + of a Euclidean space type, because the type would change in the inductive step. To avoid + this problem, we instead formulate the problem in a more concrete way by unfolding the definition of the Euclidean norm. \ lemma emeasure_cball_aux: @@ -92,17 +89,17 @@ case (insert i A r) interpret product_sigma_finite "\_. lborel" by standard - have "emeasure (Pi\<^sub>M (insert i A) (\_. lborel)) + have "emeasure (Pi\<^sub>M (insert i A) (\_. lborel)) ({f. sqrt (\i\insert i A. (f i)\<^sup>2) \ r} \ space (Pi\<^sub>M (insert i A) (\_. lborel))) = nn_integral (Pi\<^sub>M (insert i A) (\_. lborel)) (indicator ({f. sqrt (\i\insert i A. (f i)\<^sup>2) \ r} \ space (Pi\<^sub>M (insert i A) (\_. lborel))))" by (subst nn_integral_indicator) auto - also have "\ = (\\<^sup>+ y. \\<^sup>+ x. indicator ({f. sqrt ((f i)\<^sup>2 + (\i\A. (f i)\<^sup>2)) \ r} \ - space (Pi\<^sub>M (insert i A) (\_. lborel))) (x(i := y)) + also have "\ = (\\<^sup>+ y. \\<^sup>+ x. indicator ({f. sqrt ((f i)\<^sup>2 + (\i\A. (f i)\<^sup>2)) \ r} \ + space (Pi\<^sub>M (insert i A) (\_. lborel))) (x(i := y)) \Pi\<^sub>M A (\_. lborel) \lborel)" using insert.prems insert.hyps by (subst product_nn_integral_insert_rev) auto - also have "\ = (\\<^sup>+ (y::real). \\<^sup>+ x. indicator {-r..r} y * indicator ({f. sqrt ((\i\A. (f i)\<^sup>2)) \ + also have "\ = (\\<^sup>+ (y::real). \\<^sup>+ x. indicator {-r..r} y * indicator ({f. sqrt ((\i\A. (f i)\<^sup>2)) \ sqrt (r ^ 2 - y ^ 2)} \ space (Pi\<^sub>M A (\_. lborel))) x \Pi\<^sub>M A (\_. lborel) \lborel)" proof (intro nn_integral_cong, goal_cases) case (1 y f) @@ -118,13 +115,13 @@ thus ?case using 1 \r > 0\ by (auto simp: sum_nonneg real_sqrt_le_iff' indicator_def PiE_def space_PiM dest!: *) qed - also have "\ = (\\<^sup>+ (y::real). indicator {-r..r} y * (\\<^sup>+ x. indicator ({f. sqrt ((\i\A. (f i)\<^sup>2)) + also have "\ = (\\<^sup>+ (y::real). indicator {-r..r} y * (\\<^sup>+ x. indicator ({f. sqrt ((\i\A. (f i)\<^sup>2)) \ sqrt (r ^ 2 - y ^ 2)} \ space (Pi\<^sub>M A (\_. lborel))) x \Pi\<^sub>M A (\_. lborel)) \lborel)" by (subst nn_integral_cmult) auto - also have "\ = (\\<^sup>+ (y::real). indicator {-r..r} y * emeasure (PiM A (\_. lborel)) + also have "\ = (\\<^sup>+ (y::real). indicator {-r..r} y * emeasure (PiM A (\_. lborel)) ({f. sqrt ((\i\A. (f i)\<^sup>2)) \ sqrt (r ^ 2 - y ^ 2)} \ space (Pi\<^sub>M A (\_. lborel))) \lborel)" using \finite A\ by (intro nn_integral_cong, subst nn_integral_indicator) auto - also have "\ = (\\<^sup>+ (y::real). indicator {-r..r} y * ennreal (unit_ball_vol (real (card A)) * + also have "\ = (\\<^sup>+ (y::real). indicator {-r..r} y * ennreal (unit_ball_vol (real (card A)) * (sqrt (r ^ 2 - y ^ 2)) ^ card A) \lborel)" proof (intro nn_integral_cong_AE, goal_cases) case 1 @@ -141,28 +138,28 @@ qed (insert elim, auto) qed qed - also have "\ = ennreal (unit_ball_vol (real (card A))) * + also have "\ = ennreal (unit_ball_vol (real (card A))) * (\\<^sup>+ (y::real). indicator {-r..r} y * (sqrt (r ^ 2 - y ^ 2)) ^ card A \lborel)" by (subst nn_integral_cmult [symmetric]) (auto simp: mult_ac ennreal_mult' [symmetric] indicator_def intro!: nn_integral_cong) also have "(\\<^sup>+ (y::real). indicator {-r..r} y * (sqrt (r ^ 2 - y ^ 2)) ^ card A \lborel) = - (\\<^sup>+ (y::real). r ^ card A * indicator {-1..1} y * (sqrt (1 - y ^ 2)) ^ card A + (\\<^sup>+ (y::real). r ^ card A * indicator {-1..1} y * (sqrt (1 - y ^ 2)) ^ card A \(distr lborel borel ((*) (1/r))))" using \r > 0\ by (subst nn_integral_distr) (auto simp: indicator_def field_simps real_sqrt_divide intro!: nn_integral_cong) - also have "\ = (\\<^sup>+ x. ennreal (r ^ Suc (card A)) * + also have "\ = (\\<^sup>+ x. ennreal (r ^ Suc (card A)) * (indicator {- 1..1} x * sqrt (1 - x\<^sup>2) ^ card A) \lborel)" using \r > 0\ by (subst lborel_distr_mult) (auto simp: nn_integral_density ennreal_mult' [symmetric] mult_ac) - also have "\ = ennreal (r ^ Suc (card A)) * (\\<^sup>+ x. indicator {- 1..1} x * + also have "\ = ennreal (r ^ Suc (card A)) * (\\<^sup>+ x. indicator {- 1..1} x * sqrt (1 - x\<^sup>2) ^ card A \lborel)" by (subst nn_integral_cmult) auto also note emeasure_cball_aux_integral also have "ennreal (unit_ball_vol (real (card A))) * (ennreal (r ^ Suc (card A)) * - ennreal (Beta (1/2) (card A / 2 + 1))) = + ennreal (Beta (1/2) (card A / 2 + 1))) = ennreal (unit_ball_vol (card A) * Beta (1/2) (card A / 2 + 1) * r ^ Suc (card A))" using \r > 0\ by (simp add: ennreal_mult' [symmetric] mult_ac) also have "unit_ball_vol (card A) * Beta (1/2) (card A / 2 + 1) = unit_ball_vol (Suc (card A))" - by (auto simp: unit_ball_vol_def Beta_def Gamma_eq_zero_iff field_simps + by (auto simp: unit_ball_vol_def Beta_def Gamma_eq_zero_iff field_simps Gamma_one_half_real powr_half_sqrt [symmetric] powr_add [symmetric]) also have "Suc (card A) = card (insert i A)" using insert.hyps by simp finally show ?case . @@ -182,11 +179,11 @@ proof (cases "r = 0") case False with r have r: "r > 0" by simp - have "(lborel :: 'a measure) = + have "(lborel :: 'a measure) = distr (Pi\<^sub>M Basis (\_. lborel)) borel (\f. \b\Basis. f b *\<^sub>R b)" by (rule lborel_eq) - also have "emeasure \ (cball 0 r) = - emeasure (Pi\<^sub>M Basis (\_. lborel)) + also have "emeasure \ (cball 0 r) = + emeasure (Pi\<^sub>M Basis (\_. lborel)) ({y. dist 0 (\b\Basis. y b *\<^sub>R b :: 'a) \ r} \ space (Pi\<^sub>M Basis (\_. lborel)))" by (subst emeasure_distr) (auto simp: cball_def) also have "{f. dist 0 (\b\Basis. f b *\<^sub>R b :: 'a) \ r} = {f. sqrt (\i\Basis. (f i)\<^sup>2) \ r}" @@ -227,7 +224,7 @@ text \ - Lastly, we now prove some nicer explicit formulas for the volume of the unit balls in + Lastly, we now prove some nicer explicit formulas for the volume of the unit balls in the cases of even and odd integer dimensions. \ lemma unit_ball_vol_even: @@ -240,7 +237,7 @@ "unit_ball_vol (real (2 * n + 1)) = (2 ^ (2 * Suc n) * fact (Suc n)) / fact (2 * Suc n) * pi ^ n" proof - - have "unit_ball_vol (real (2 * n + 1)) = + have "unit_ball_vol (real (2 * n + 1)) = pi powr (real n + 1 / 2) / Gamma (1 / 2 + real (Suc n))" by (simp add: unit_ball_vol_def field_simps) also have "pochhammer (1 / 2) (Suc n) = Gamma (1 / 2 + real (Suc n)) / Gamma (1 / 2)" @@ -250,7 +247,7 @@ also have "pi powr (real n + 1 / 2) / \ = pi ^ n / pochhammer (1 / 2) (Suc n)" by (simp add: powr_add powr_half_sqrt powr_realpow) finally show "unit_ball_vol (real (2 * n + 1)) = \" . - also have "pochhammer (1 / 2 :: real) (Suc n) = + also have "pochhammer (1 / 2 :: real) (Suc n) = fact (2 * Suc n) / (2 ^ (2 * Suc n) * fact (Suc n))" using fact_double[of "Suc n", where ?'a = real] by (simp add: divide_simps mult_ac) also have "pi ^n / \ = (2 ^ (2 * Suc n) * fact (Suc n)) / fact (2 * Suc n) * pi ^ n" @@ -263,7 +260,7 @@ "unit_ball_vol (numeral (Num.Bit1 n)) = 2 ^ (2 * Suc (numeral n)) * fact (Suc (numeral n)) / fact (2 * Suc (numeral n)) * pi ^ numeral n" (is ?th2) proof - - have "numeral (Num.Bit0 n) = (2 * numeral n :: nat)" + have "numeral (Num.Bit0 n) = (2 * numeral n :: nat)" by (simp only: numeral_Bit0 mult_2 ring_distribs) also have "unit_ball_vol \ = pi ^ numeral n / fact (numeral n)" by (rule unit_ball_vol_even) diff -r e1b5bf983de3 -r aca96bd12b12 src/HOL/Finite_Set.thy --- a/src/HOL/Finite_Set.thy Mon Oct 04 15:01:50 2021 +0200 +++ b/src/HOL/Finite_Set.thy Mon Oct 04 16:11:18 2021 +0100 @@ -373,6 +373,17 @@ lemma finite_vimage_iff: "bij h \ finite (h -` F) \ finite F" unfolding bij_def by (auto elim: finite_vimageD finite_vimageI) +lemma finite_inverse_image_gen: + assumes "finite A" "inj_on f D" + shows "finite {j\D. f j \ A}" + using finite_vimage_IntI [OF assms] + by (simp add: Collect_conj_eq inf_commute vimage_def) + +lemma finite_inverse_image: + assumes "finite A" "inj f" + shows "finite {j. f j \ A}" + using finite_inverse_image_gen [OF assms] by simp + lemma finite_Collect_bex [simp]: assumes "finite A" shows "finite {x. \y\A. Q x y} \ (\y\A. finite {x. Q x y})" diff -r e1b5bf983de3 -r aca96bd12b12 src/HOL/Groups_Big.thy --- a/src/HOL/Groups_Big.thy Mon Oct 04 15:01:50 2021 +0200 +++ b/src/HOL/Groups_Big.thy Mon Oct 04 16:11:18 2021 +0100 @@ -1560,6 +1560,20 @@ then show ?case by (force intro: mult_strict_mono' prod_nonneg) qed +lemma prod_le_power: + assumes A: "\i. i \ A \ 0 \ f i \ f i \ n" "card A \ k" and "n \ 1" + shows "prod f A \ n ^ k" + using A +proof (induction A arbitrary: k rule: infinite_finite_induct) + case (insert i A) + then obtain k' where k': "card A \ k'" "k = Suc k'" + using Suc_le_D by force + have "f i * prod f A \ n * n ^ k'" + using insert \n \ 1\ k' by (intro prod_nonneg mult_mono; force) + then show ?case + by (auto simp: \k = Suc k'\ insert.hyps) +qed (use \n \ 1\ in auto) + end lemma prod_mono2: diff -r e1b5bf983de3 -r aca96bd12b12 src/HOL/Library/Countable_Set.thy --- a/src/HOL/Library/Countable_Set.thy Mon Oct 04 15:01:50 2021 +0200 +++ b/src/HOL/Library/Countable_Set.thy Mon Oct 04 16:11:18 2021 +0100 @@ -110,6 +110,25 @@ using to_nat_on_infinite[of S, unfolded bij_betw_def] by (auto cong: bij_betw_cong intro: bij_betw_inv_into to_nat_on_infinite) +text \ + The sum/product over the enumeration of a finite set equals simply the sum/product over the set +\ +context comm_monoid_set +begin + +lemma card_from_nat_into: + "F (\i. h (from_nat_into A i)) {..i. h (from_nat_into A i)) {.. 'a" where "A = range f" "inj f" diff -r e1b5bf983de3 -r aca96bd12b12 src/HOL/Library/Disjoint_Sets.thy --- a/src/HOL/Library/Disjoint_Sets.thy Mon Oct 04 15:01:50 2021 +0200 +++ b/src/HOL/Library/Disjoint_Sets.thy Mon Oct 04 16:11:18 2021 +0100 @@ -167,6 +167,20 @@ by (intro disjointD[OF d]) auto qed +lemma disjoint_family_on_iff_disjoint_image: + assumes "\i. i \ I \ A i \ {}" + shows "disjoint_family_on A I \ disjoint (A ` I) \ inj_on A I" +proof + assume "disjoint_family_on A I" + then show "disjoint (A ` I) \ inj_on A I" + by (metis (mono_tags, lifting) assms disjoint_family_onD disjoint_family_on_disjoint_image inf.idem inj_onI) +qed (use disjoint_image_disjoint_family_on in metis) + +lemma card_UN_disjoint': + assumes "disjoint_family_on A I" "\i. i \ I \ finite (A i)" "finite I" + shows "card (\i\I. A i) = (\i\I. card (A i))" + using assms by (simp add: card_UN_disjoint disjoint_family_on_def) + lemma disjoint_UN: assumes F: "\i. i \ I \ disjoint (F i)" and *: "disjoint_family_on (\i. \(F i)) I" shows "disjoint (\i\I. F i)" @@ -217,6 +231,25 @@ using disjoint_UN[of "{C, B}" "\x. x"] by (auto simp add: disjoint_family_on_def) text \ + Sum/product of the union of a finite disjoint family +\ +context comm_monoid_set +begin + +lemma UNION_disjoint_family: + assumes "finite I" and "\i\I. finite (A i)" + and "disjoint_family_on A I" + shows "F g (\(A ` I)) = F (\x. F g (A x)) I" + using assms unfolding disjoint_family_on_def by (rule UNION_disjoint) + +lemma Union_disjoint_sets: + assumes "\A\C. finite A" and "disjoint C" + shows "F g (\C) = (F \ F) g C" + using assms unfolding disjoint_def by (rule Union_disjoint) + +end + +text \ The union of an infinite disjoint family of non-empty sets is infinite. \ lemma infinite_disjoint_family_imp_infinite_UNION: @@ -353,6 +386,11 @@ lemma finite_elements: "finite A \ partition_on A P \ finite P" using partition_onD1[of A P] by (simp add: finite_UnionD) +lemma product_partition: + assumes "partition_on A P" and "\p. p \ P \ finite p" + shows "card A = (\p\P. card p)" + using assms unfolding partition_on_def by (meson card_Union_disjoint) + subsection \Equivalence of partitions and equivalence classes\ lemma partition_on_quotient: diff -r e1b5bf983de3 -r aca96bd12b12 src/HOL/Power.thy --- a/src/HOL/Power.thy Mon Oct 04 15:01:50 2021 +0200 +++ b/src/HOL/Power.thy Mon Oct 04 16:11:18 2021 +0100 @@ -810,6 +810,10 @@ by (auto intro!: power2_le_imp_le [OF _ abs_ge_zero]) qed +lemma power2_le_iff_abs_le: + "y \ 0 \ x\<^sup>2 \ y\<^sup>2 \ \x\ \ y" + by (metis abs_le_square_iff abs_of_nonneg) + lemma abs_square_le_1:"x\<^sup>2 \ 1 \ \x\ \ 1" using abs_le_square_iff [of x 1] by simp