# HG changeset patch # User hoelzl # Date 1421934668 -3600 # Node ID c5e79df8cc21363647eb020efad99aa34bbe7874 # Parent ca2336984f6a6b40280b974713265d9c53bc6b44 import general thms from Density_Compiler diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Library/Extended_Real.thy --- a/src/HOL/Library/Extended_Real.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Library/Extended_Real.thy Thu Jan 22 14:51:08 2015 +0100 @@ -1606,6 +1606,42 @@ using zero_neq_one by blast qed +lemma ereal_Sup: + assumes *: "\SUP a:A. ereal a\ \ \" + shows "ereal (Sup A) = (SUP a:A. ereal a)" +proof (rule antisym) + obtain r where r: "ereal r = (SUP a:A. ereal a)" "A \ {}" + using * by (force simp: bot_ereal_def) + then have upper: "\a. a \ A \ a \ r" + by (auto intro!: SUP_upper simp add: ereal_less_eq(3)[symmetric] simp del: ereal_less_eq) + + show "ereal (Sup A) \ (SUP a:A. ereal a)" + using upper by (simp add: r[symmetric] cSup_least[OF `A \ {}`]) + show "(SUP a:A. ereal a) \ ereal (Sup A)" + using upper `A \ {}` by (intro SUP_least) (auto intro!: cSup_upper bdd_aboveI) +qed + +lemma ereal_SUP: "\SUP a:A. ereal (f a)\ \ \ \ ereal (SUP a:A. f a) = (SUP a:A. ereal (f a))" + using ereal_Sup[of "f`A"] by auto + +lemma ereal_Inf: + assumes *: "\INF a:A. ereal a\ \ \" + shows "ereal (Inf A) = (INF a:A. ereal a)" +proof (rule antisym) + obtain r where r: "ereal r = (INF a:A. ereal a)" "A \ {}" + using * by (force simp: top_ereal_def) + then have lower: "\a. a \ A \ r \ a" + by (auto intro!: INF_lower simp add: ereal_less_eq(3)[symmetric] simp del: ereal_less_eq) + + show "(INF a:A. ereal a) \ ereal (Inf A)" + using lower by (simp add: r[symmetric] cInf_greatest[OF `A \ {}`]) + show "ereal (Inf A) \ (INF a:A. ereal a)" + using lower `A \ {}` by (intro INF_greatest) (auto intro!: cInf_lower bdd_belowI) +qed + +lemma ereal_INF: "\INF a:A. ereal (f a)\ \ \ \ ereal (INF a:A. f a) = (INF a:A. ereal (f a))" + using ereal_Inf[of "f`A"] by auto + lemma ereal_Sup_uminus_image_eq: "Sup (uminus ` S::ereal set) = - Inf S" by (auto intro!: SUP_eqI simp: Ball_def[symmetric] ereal_uminus_le_reorder le_Inf_iff @@ -1705,28 +1741,37 @@ using assms by (cases e) auto qed +lemma SUP_PInfty: + fixes f :: "'a \ ereal" + assumes "\n::nat. \i\A. ereal (real n) \ f i" + shows "(SUP i:A. f i) = \" + unfolding SUP_def Sup_eq_top_iff[where 'a=ereal, unfolded top_ereal_def] + apply simp +proof safe + fix x :: ereal + assume "x \ \" + show "\i\A. x < f i" + proof (cases x) + case PInf + with `x \ \` show ?thesis + by simp + next + case MInf + with assms[of "0"] show ?thesis + by force + next + case (real r) + with less_PInf_Ex_of_nat[of x] obtain n :: nat where "x < ereal (real n)" + by auto + moreover obtain i where "i \ A" "ereal (real n) \ f i" + using assms .. + ultimately show ?thesis + by (auto intro!: bexI[of _ i]) + qed +qed + lemma SUP_nat_Infty: "(SUP i::nat. ereal (real i)) = \" -proof - - { - fix x :: ereal - assume "x \ \" - then have "\k::nat. x < ereal (real k)" - proof (cases x) - case MInf - then show ?thesis - by (intro exI[of _ 0]) auto - next - case (real r) - moreover obtain k :: nat where "r < real k" - using ex_less_of_nat by (auto simp: real_eq_of_nat) - ultimately show ?thesis - by auto - qed simp - } - then show ?thesis - using SUP_eq_top_iff[of UNIV "\n::nat. ereal (real n)"] - by (auto simp: top_ereal_def) -qed + by (rule SUP_PInfty) auto lemma Inf_less: fixes x :: ereal @@ -1930,35 +1975,6 @@ shows "I \ {} \ (\i. i \ I \ 0 \ f i) \ 0 \ c \ (SUP i:I. c + f i) = c + SUPREMUM I f" using SUP_ereal_add_left[of I f c] by (simp add: add_ac) -lemma SUP_PInfty: - fixes f :: "'a \ ereal" - assumes "\n::nat. \i\A. ereal (real n) \ f i" - shows "(SUP i:A. f i) = \" - unfolding SUP_def Sup_eq_top_iff[where 'a=ereal, unfolded top_ereal_def] - apply simp -proof safe - fix x :: ereal - assume "x \ \" - show "\i\A. x < f i" - proof (cases x) - case PInf - with `x \ \` show ?thesis - by simp - next - case MInf - with assms[of "0"] show ?thesis - by force - next - case (real r) - with less_PInf_Ex_of_nat[of x] obtain n :: nat where "x < ereal (real n)" - by auto - moreover obtain i where "i \ A" "ereal (real n) \ f i" - using assms .. - ultimately show ?thesis - by (auto intro!: bexI[of _ i]) - qed -qed - lemma Sup_countable_SUP: assumes "A \ {}" shows "\f::nat \ ereal. range f \ A \ Sup A = SUPREMUM UNIV f" @@ -2664,13 +2680,6 @@ by (cases rule: ereal3_cases[of a b c]) (auto simp add: field_simps not_le mult_le_0_iff mult_less_0_iff) -lemma ereal_pos_le_distrib: - fixes a b c :: ereal - assumes "c \ 0" - shows "c * (a + b) \ c * a + c * b" - using assms - by (cases rule: ereal3_cases[of a b c]) (auto simp add: field_simps) - lemma ereal_max_mono: "(a::ereal) \ b \ c \ d \ max a c \ max b d" by (metis sup_ereal_def sup_mono) diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Library/FuncSet.thy --- a/src/HOL/Library/FuncSet.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Library/FuncSet.thy Thu Jan 22 14:51:08 2015 +0100 @@ -405,16 +405,20 @@ lemma fun_upd_in_PiE: "x \ S \ f \ PiE (insert x S) T \ f(x := undefined) \ PiE S T" unfolding PiE_def extensional_def by auto -lemma PiE_insert_eq: - assumes "x \ S" - shows "PiE (insert x S) T = (\(y, g). g(x := y)) ` (T x \ PiE S T)" +lemma PiE_insert_eq: "PiE (insert x S) T = (\(y, g). g(x := y)) ` (T x \ PiE S T)" proof - { - fix f assume "f \ PiE (insert x S) T" + fix f assume "f \ PiE (insert x S) T" "x \ S" with assms have "f \ (\(y, g). g(x := y)) ` (T x \ PiE S T)" by (auto intro!: image_eqI[where x="(f x, f(x := undefined))"] intro: fun_upd_in_PiE PiE_mem) } - then show ?thesis + moreover + { + fix f assume "f \ PiE (insert x S) T" "x \ S" + with assms have "f \ (\(y, g). g(x := y)) ` (T x \ PiE S T)" + by (auto intro!: image_eqI[where x="(f x, f)"] intro: fun_upd_in_PiE PiE_mem simp: insert_absorb) + } + ultimately show ?thesis using assms by (auto intro: PiE_fun_upd) qed diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Library/Product_Vector.thy --- a/src/HOL/Library/Product_Vector.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Library/Product_Vector.thy Thu Jan 22 14:51:08 2015 +0100 @@ -538,4 +538,8 @@ end +lemma inner_Pair_0: "inner x (0, b) = inner (snd x) b" "inner x (a, 0) = inner (fst x) a" + by (cases x, simp)+ + + end diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy --- a/src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Multivariate_Analysis/Extended_Real_Limits.thy Thu Jan 22 14:51:08 2015 +0100 @@ -1175,6 +1175,16 @@ lemma suminf_ereal_finite: "summable f \ (\i. ereal (f i)) \ \" by (auto simp: sums_ereal[symmetric] summable_def sums_unique[symmetric]) +lemma suminf_ereal_finite_neg: + assumes "summable f" + shows "(\x. ereal (f x)) \ -\" +proof- + from assms obtain x where "f sums x" by blast + hence "(\x. ereal (f x)) sums ereal x" by (simp add: sums_ereal) + from sums_unique[OF this] have "(\x. ereal (f x)) = ereal x" .. + thus "(\x. ereal (f x)) \ -\" by simp_all +qed + subsection {* monoset *} definition (in order) mono_set: @@ -1364,4 +1374,8 @@ lemma ereal_indicator_nonneg[simp, intro]: "0 \ (indicator A x ::ereal)" unfolding indicator_def by auto +lemma indicator_inter_arith_ereal: "indicator A x * indicator B x = (indicator (A \ B) x :: ereal)" + by (simp split: split_indicator) + + end diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Multivariate_Analysis/Integration.thy --- a/src/HOL/Multivariate_Analysis/Integration.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Multivariate_Analysis/Integration.thy Thu Jan 22 14:51:08 2015 +0100 @@ -481,6 +481,35 @@ and "interval_lowerbound (cbox a b) = a" using assms unfolding box_ne_empty by auto + +lemma interval_upperbound_Times: + assumes "A \ {}" and "B \ {}" + shows "interval_upperbound (A \ B) = (interval_upperbound A, interval_upperbound B)" +proof- + from assms have fst_image_times': "A = fst ` (A \ B)" by simp + have "(\i\Basis. (SUP x:A \ B. x \ (i, 0)) *\<^sub>R i) = (\i\Basis. (SUP x:A. x \ i) *\<^sub>R i)" + by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0) + moreover from assms have snd_image_times': "B = snd ` (A \ B)" by simp + have "(\i\Basis. (SUP x:A \ B. x \ (0, i)) *\<^sub>R i) = (\i\Basis. (SUP x:B. x \ i) *\<^sub>R i)" + by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0) + ultimately show ?thesis unfolding interval_upperbound_def + by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod) +qed + +lemma interval_lowerbound_Times: + assumes "A \ {}" and "B \ {}" + shows "interval_lowerbound (A \ B) = (interval_lowerbound A, interval_lowerbound B)" +proof- + from assms have fst_image_times': "A = fst ` (A \ B)" by simp + have "(\i\Basis. (INF x:A \ B. x \ (i, 0)) *\<^sub>R i) = (\i\Basis. (INF x:A. x \ i) *\<^sub>R i)" + by (subst (2) fst_image_times') (simp del: fst_image_times add: o_def inner_Pair_0) + moreover from assms have snd_image_times': "B = snd ` (A \ B)" by simp + have "(\i\Basis. (INF x:A \ B. x \ (0, i)) *\<^sub>R i) = (\i\Basis. (INF x:B. x \ i) *\<^sub>R i)" + by (subst (2) snd_image_times') (simp del: snd_image_times add: o_def inner_Pair_0) + ultimately show ?thesis unfolding interval_lowerbound_def + by (subst setsum_Basis_prod_eq) (auto simp add: setsum_prod) +qed + subsection {* Content (length, area, volume...) of an interval. *} definition "content (s::('a::euclidean_space) set) = @@ -619,6 +648,20 @@ lemma content_lt_nz: "0 < content (cbox a b) \ content (cbox a b) \ 0" unfolding content_pos_lt_eq content_eq_0 unfolding not_ex not_le by fastforce +lemma content_times[simp]: "content (A \ B) = content A * content B" +proof (cases "A \ B = {}") + let ?ub1 = "interval_upperbound" and ?lb1 = "interval_lowerbound" + let ?ub2 = "interval_upperbound" and ?lb2 = "interval_lowerbound" + assume nonempty: "A \ B \ {}" + hence "content (A \ B) = (\i\Basis. (?ub1 A, ?ub2 B) \ i - (?lb1 A, ?lb2 B) \ i)" + unfolding content_def by (simp add: interval_upperbound_Times interval_lowerbound_Times) + also have "... = content A * content B" unfolding content_def using nonempty + apply (subst Basis_prod_def, subst setprod.union_disjoint, force, force, force, simp) + apply (subst (1 2) setprod.reindex, auto intro: inj_onI) + done + finally show ?thesis . +qed (auto simp: content_def) + subsection {* The notion of a gauge --- simply an open set containing the point. *} diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Bochner_Integration.thy --- a/src/HOL/Probability/Bochner_Integration.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Bochner_Integration.thy Thu Jan 22 14:51:08 2015 +0100 @@ -2059,6 +2059,41 @@ by (subst lebesgue_integral_count_space_finite_support) (auto intro!: setsum.mono_neutral_cong_left) +lemma integrable_count_space_nat_iff: + fixes f :: "nat \ _::{banach,second_countable_topology}" + shows "integrable (count_space UNIV) f \ summable (\x. norm (f x))" + by (auto simp add: integrable_iff_bounded nn_integral_count_space_nat summable_ereal suminf_ereal_finite) + +lemma sums_integral_count_space_nat: + fixes f :: "nat \ _::{banach,second_countable_topology}" + assumes *: "integrable (count_space UNIV) f" + shows "f sums (integral\<^sup>L (count_space UNIV) f)" +proof - + let ?f = "\n i. indicator {n} i *\<^sub>R f i" + have f': "\n i. ?f n i = indicator {n} i *\<^sub>R f n" + by (auto simp: fun_eq_iff split: split_indicator) + + have "(\i. \n. ?f i n \count_space UNIV) sums \ n. (\i. ?f i n) \count_space UNIV" + proof (rule sums_integral) + show "\i. integrable (count_space UNIV) (?f i)" + using * by (intro integrable_mult_indicator) auto + show "AE n in count_space UNIV. summable (\i. norm (?f i n))" + using summable_finite[of "{n}" "\i. norm (?f i n)" for n] by simp + show "summable (\i. \ n. norm (?f i n) \count_space UNIV)" + using * by (subst f') (simp add: integrable_count_space_nat_iff) + qed + also have "(\ n. (\i. ?f i n) \count_space UNIV) = (\n. f n \count_space UNIV)" + using suminf_finite[of "{n}" "\i. ?f i n" for n] by (auto intro!: integral_cong) + also have "(\i. \n. ?f i n \count_space UNIV) = f" + by (subst f') simp + finally show ?thesis . +qed + +lemma integral_count_space_nat: + fixes f :: "nat \ _::{banach,second_countable_topology}" + shows "integrable (count_space UNIV) f \ integral\<^sup>L (count_space UNIV) f = (\x. f x)" + using sums_integral_count_space_nat by (rule sums_unique) + subsection {* Point measure *} lemma lebesgue_integral_point_measure_finite: @@ -2076,6 +2111,20 @@ apply (auto simp: AE_count_space integrable_count_space) done +subsection {* Lebesgue integration on @{const null_measure} *} + +lemma has_bochner_integral_null_measure_iff[iff]: + "has_bochner_integral (null_measure M) f 0 \ f \ borel_measurable M" + by (auto simp add: has_bochner_integral.simps simple_bochner_integral_def[abs_def] + intro!: exI[of _ "\n x. 0"] simple_bochner_integrable.intros) + +lemma integrable_null_measure_iff[iff]: "integrable (null_measure M) f \ f \ borel_measurable M" + by (auto simp add: integrable.simps) + +lemma integral_null_measure[simp]: "integral\<^sup>L (null_measure M) f = 0" + by (cases "integrable (null_measure M) f") + (auto simp add: not_integrable_integral_eq has_bochner_integral_integral_eq) + subsection {* Legacy lemmas for the real-valued Lebesgue integral *} lemma real_lebesgue_integral_def: diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Finite_Product_Measure.thy --- a/src/HOL/Probability/Finite_Product_Measure.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Finite_Product_Measure.thy Thu Jan 22 14:51:08 2015 +0100 @@ -180,6 +180,37 @@ translations "PIM x:I. M" == "CONST PiM I (%x. M)" +lemma extend_measure_cong: + assumes "\ = \'" "I = I'" "G = G'" "\i. i \ I' \ \ i = \' i" + shows "extend_measure \ I G \ = extend_measure \' I' G' \'" + unfolding extend_measure_def by (auto simp add: assms) + +lemma Pi_cong_sets: + "\I = J; \x. x \ I \ M x = N x\ \ Pi I M = Pi J N" + unfolding Pi_def by auto + +lemma PiM_cong: + assumes "I = J" "\x. x \ I \ M x = N x" + shows "PiM I M = PiM J N" +unfolding PiM_def +proof (rule extend_measure_cong) + case goal1 show ?case using assms + by (subst assms(1), intro PiE_cong[of J "\i. space (M i)" "\i. space (N i)"]) simp_all +next + case goal2 + have "\K. K \ J \ (\ j\K. sets (M j)) = (\ j\K. sets (N j))" + using assms by (intro Pi_cong_sets) auto + thus ?case by (auto simp: assms) +next + case goal3 show ?case using assms + by (intro ext) (auto simp: prod_emb_def dest: PiE_mem) +next + case (goal4 x) + thus ?case using assms + by (auto intro!: setprod.cong split: split_if_asm) +qed + + lemma prod_algebra_sets_into_space: "prod_algebra I M \ Pow (\\<^sub>E i\I. space (M i))" by (auto simp: prod_emb_def prod_algebra_def) @@ -624,6 +655,17 @@ lemma measurable_restrict_subset: "J \ L \ (\f. restrict f J) \ measurable (Pi\<^sub>M L M) (Pi\<^sub>M J M)" by (intro measurable_restrict measurable_component_singleton) auto +lemma measurable_restrict_subset': + assumes "J \ L" "\x. x \ J \ sets (M x) = sets (N x)" + shows "(\f. restrict f J) \ measurable (Pi\<^sub>M L M) (Pi\<^sub>M J N)" +proof- + from assms(1) have "(\f. restrict f J) \ measurable (Pi\<^sub>M L M) (Pi\<^sub>M J M)" + by (rule measurable_restrict_subset) + also from assms(2) have "measurable (Pi\<^sub>M L M) (Pi\<^sub>M J M) = measurable (Pi\<^sub>M L M) (Pi\<^sub>M J N)" + by (intro sets_PiM_cong measurable_cong_sets) simp_all + finally show ?thesis . +qed + lemma measurable_prod_emb[intro, simp]: "J \ L \ X \ sets (Pi\<^sub>M J M) \ prod_emb L M J X \ sets (Pi\<^sub>M L M)" unfolding prod_emb_def space_PiM[symmetric] @@ -945,6 +987,17 @@ qed qed +lemma (in product_sigma_finite) product_nn_integral_insert_rev: + assumes I[simp]: "finite I" "i \ I" + and [measurable]: "f \ borel_measurable (Pi\<^sub>M (insert i I) M)" + shows "integral\<^sup>N (Pi\<^sub>M (insert i I) M) f = (\\<^sup>+ y. (\\<^sup>+ x. f (x(i := y)) \(Pi\<^sub>M I M)) \(M i))" + apply (subst product_nn_integral_insert[OF assms]) + apply (rule pair_sigma_finite.Fubini') + apply intro_locales [] + apply (rule sigma_finite[OF I(1)]) + apply measurable + done + lemma (in product_sigma_finite) product_nn_integral_setprod: fixes f :: "'i \ 'a \ ereal" assumes "finite I" and borel: "\i. i \ I \ f i \ borel_measurable (M i)" @@ -969,6 +1022,23 @@ done qed (simp add: space_PiM) +lemma (in product_sigma_finite) product_nn_integral_pair: + assumes [measurable]: "split f \ borel_measurable (M x \\<^sub>M M y)" + assumes xy: "x \ y" + shows "(\\<^sup>+\. f (\ x) (\ y) \PiM {x, y} M) = (\\<^sup>+z. f (fst z) (snd z) \(M x \\<^sub>M M y))" +proof- + interpret psm: pair_sigma_finite "M x" "M y" + unfolding pair_sigma_finite_def using sigma_finite_measures by simp_all + have "{x, y} = {y, x}" by auto + also have "(\\<^sup>+\. f (\ x) (\ y) \PiM {y, x} M) = (\\<^sup>+y. \\<^sup>+\. f (\ x) y \PiM {x} M \M y)" + using xy by (subst product_nn_integral_insert_rev) simp_all + also have "... = (\\<^sup>+y. \\<^sup>+x. f x y \M x \M y)" + by (intro nn_integral_cong, subst product_nn_integral_singleton) simp_all + also have "... = (\\<^sup>+z. f (fst z) (snd z) \(M x \\<^sub>M M y))" + by (subst psm.nn_integral_snd[symmetric]) simp_all + finally show ?thesis . +qed + lemma (in product_sigma_finite) distr_component: "distr (M i) (Pi\<^sub>M {i} M) (\x. \i\{i}. x) = Pi\<^sub>M {i} M" (is "?D = ?P") proof (intro measure_eqI[symmetric]) diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Giry_Monad.thy --- a/src/HOL/Probability/Giry_Monad.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Giry_Monad.thy Thu Jan 22 14:51:08 2015 +0100 @@ -32,6 +32,9 @@ "prob_space M \ subprob_space M" by (rule subprob_spaceI) (simp_all add: prob_space.emeasure_space_1 prob_space.not_empty) +lemma subprob_space_imp_sigma_finite: "subprob_space M \ sigma_finite_measure M" + unfolding subprob_space_def finite_measure_def by simp + sublocale prob_space \ subprob_space by (rule subprob_spaceI) (simp_all add: emeasure_space_1 not_empty) @@ -123,6 +126,10 @@ by (simp add: space_pair_measure) qed +lemma subprob_space_null_measure_iff: + "subprob_space (null_measure M) \ space M \ {}" + by (auto intro!: subprob_spaceI dest: subprob_space.subprob_not_empty) + definition subprob_algebra :: "'a measure \ 'a measure measure" where "subprob_algebra K = (\\<^sub>\ A\sets K. vimage_algebra {M. subprob_space M \ sets M = sets K} (\M. emeasure M A) borel)" @@ -1250,4 +1257,18 @@ by (simp add: emeasure_notin_sets) qed +lemma bind_return'': "sets M = sets N \ M \= return N = M" + by (cases "space M = {}") + (simp_all add: bind_empty space_empty[symmetric] bind_nonempty join_return' + cong: subprob_algebra_cong) + +lemma (in prob_space) distr_const[simp]: + "c \ space N \ distr M N (\x. c) = return N c" + by (rule measure_eqI) (auto simp: emeasure_distr emeasure_space_1) + +lemma return_count_space_eq_density: + "return (count_space M) x = density (count_space M) (indicator {x})" + by (rule measure_eqI) + (auto simp: indicator_inter_arith_ereal emeasure_density split: split_indicator) + end diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Lebesgue_Measure.thy --- a/src/HOL/Probability/Lebesgue_Measure.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Lebesgue_Measure.thy Thu Jan 22 14:51:08 2015 +0100 @@ -529,6 +529,23 @@ thus ?thesis by (auto simp add: emeasure_le_0_iff) qed +lemma countable_imp_null_set_lborel: "countable A \ A \ null_sets lborel" + by (simp add: null_sets_def emeasure_lborel_countable sets.countable) + +lemma finite_imp_null_set_lborel: "finite A \ A \ null_sets lborel" + by (intro countable_imp_null_set_lborel countable_finite) + +lemma lborel_neq_count_space[simp]: "lborel \ count_space (A::('a::ordered_euclidean_space) set)" +proof + assume asm: "lborel = count_space A" + have "space lborel = UNIV" by simp + hence [simp]: "A = UNIV" by (subst (asm) asm) (simp only: space_count_space) + have "emeasure lborel {undefined::'a} = 1" + by (subst asm, subst emeasure_count_space_finite) auto + moreover have "emeasure lborel {undefined} \ 1" by simp + ultimately show False by contradiction +qed + subsection {* Affine transformation on the Lebesgue-Borel *} lemma lborel_eqI: @@ -651,11 +668,59 @@ unfolding has_bochner_integral_iff lborel_integrable_real_affine_iff by (simp_all add: lborel_integral_real_affine[symmetric] divideR_right cong: conj_cong) +lemma lborel_distr_uminus: "distr lborel borel uminus = (lborel :: real measure)" + by (subst lborel_real_affine[of "-1" 0]) + (auto simp: density_1 one_ereal_def[symmetric]) + +lemma lborel_distr_mult: + assumes "(c::real) \ 0" + shows "distr lborel borel (op * c) = density lborel (\_. inverse \c\)" +proof- + have "distr lborel borel (op * c) = distr lborel lborel (op * c)" by (simp cong: distr_cong) + also from assms have "... = density lborel (\_. inverse \c\)" + by (subst lborel_real_affine[of "inverse c" 0]) (auto simp: o_def distr_density_distr) + finally show ?thesis . +qed + +lemma lborel_distr_mult': + assumes "(c::real) \ 0" + shows "lborel = density (distr lborel borel (op * c)) (\_. abs c)" +proof- + have "lborel = density lborel (\_. 1)" by (rule density_1[symmetric]) + also from assms have "(\_. 1 :: ereal) = (\_. inverse (abs c) * abs c)" by (intro ext) simp + also have "density lborel ... = density (density lborel (\_. inverse (abs c))) (\_. abs c)" + by (subst density_density_eq) auto + also from assms have "density lborel (\_. inverse (abs c)) = distr lborel borel (op * c)" + by (rule lborel_distr_mult[symmetric]) + finally show ?thesis . +qed + +lemma lborel_distr_plus: "distr lborel borel (op + c) = (lborel :: real measure)" + by (subst lborel_real_affine[of 1 c]) (auto simp: density_1 one_ereal_def[symmetric]) + interpretation lborel!: sigma_finite_measure lborel by (rule sigma_finite_lborel) interpretation lborel_pair: pair_sigma_finite lborel lborel .. +lemma lborel_prod: + "lborel \\<^sub>M lborel = (lborel :: ('a::euclidean_space \ 'b::euclidean_space) measure)" +proof (rule lborel_eqI[symmetric], clarify) + fix la ua :: 'a and lb ub :: 'b + assume lu: "\a b. (a, b) \ Basis \ (la, lb) \ (a, b) \ (ua, ub) \ (a, b)" + have [simp]: + "\b. b \ Basis \ la \ b \ ua \ b" + "\b. b \ Basis \ lb \ b \ ub \ b" + "inj_on (\u. (u, 0)) Basis" "inj_on (\u. (0, u)) Basis" + "(\u. (u, 0)) ` Basis \ (\u. (0, u)) ` Basis = {}" + "box (la, lb) (ua, ub) = box la ua \ box lb ub" + using lu[of _ 0] lu[of 0] by (auto intro!: inj_onI simp add: Basis_prod_def ball_Un box_def) + show "emeasure (lborel \\<^sub>M lborel) (box (la, lb) (ua, ub)) = + ereal (setprod (op \ ((ua, ub) - (la, lb))) Basis)" + by (simp add: lborel.emeasure_pair_measure_Times Basis_prod_def setprod.union_disjoint + setprod.reindex) +qed (simp add: borel_prod[symmetric]) + (* FIXME: conversion in measurable prover *) lemma lborelD_Collect[measurable (raw)]: "{x\space borel. P x} \ sets borel \ {x\space lborel. P x} \ sets lborel" by simp lemma lborelD[measurable (raw)]: "A \ sets borel \ A \ sets lborel" by simp diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Measure_Space.thy --- a/src/HOL/Probability/Measure_Space.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Measure_Space.thy Thu Jan 22 14:51:08 2015 +0100 @@ -1928,5 +1928,23 @@ finally show "emeasure M X = emeasure N X" . qed fact +subsection {* Null measure *} + +definition "null_measure M = sigma (space M) (sets M)" + +lemma space_null_measure[simp]: "space (null_measure M) = space M" + by (simp add: null_measure_def) + +lemma sets_null_measure[simp, measurable_cong]: "sets (null_measure M) = sets M" + by (simp add: null_measure_def) + +lemma emeasure_null_measure[simp]: "emeasure (null_measure M) X = 0" + by (cases "X \ sets M", rule emeasure_measure_of) + (auto simp: positive_def countably_additive_def emeasure_notin_sets null_measure_def + dest: sets.sets_into_space) + +lemma measure_null_measure[simp]: "measure (null_measure M) X = 0" + by (simp add: measure_def) + end diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Nonnegative_Lebesgue_Integration.thy --- a/src/HOL/Probability/Nonnegative_Lebesgue_Integration.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Nonnegative_Lebesgue_Integration.thy Thu Jan 22 14:51:08 2015 +0100 @@ -1951,6 +1951,11 @@ shows "(\\<^sup>+x. f x \count_space X) = (\\<^sup>+x. f x * indicator X x \count_space UNIV)" by (simp add: nn_integral_restrict_space[symmetric] restrict_count_space) +lemma nn_integral_count_space_eq: + "(\x. x \ A - B \ f x = 0) \ (\x. x \ B - A \ f x = 0) \ + (\\<^sup>+x. f x \count_space A) = (\\<^sup>+x. f x \count_space B)" + by (auto simp: nn_integral_count_space_indicator intro!: nn_integral_cong split: split_indicator) + lemma nn_integral_ge_point: assumes "x \ A" shows "p x \ \\<^sup>+ x. p x \count_space A" @@ -2194,6 +2199,23 @@ using f g by (subst density_density_eq) auto qed +lemma density_1: "density M (\_. 1) = M" + by (intro measure_eqI) (auto simp: emeasure_density) + +lemma emeasure_density_add: + assumes X: "X \ sets M" + assumes Mf[measurable]: "f \ borel_measurable M" + assumes Mg[measurable]: "g \ borel_measurable M" + assumes nonnegf: "\x. x \ space M \ f x \ 0" + assumes nonnegg: "\x. x \ space M \ g x \ 0" + shows "emeasure (density M f) X + emeasure (density M g) X = + emeasure (density M (\x. f x + g x)) X" + using assms + apply (subst (1 2 3) emeasure_density, simp_all) [] + apply (subst nn_integral_add[symmetric], simp_all) [] + apply (intro nn_integral_cong, simp split: split_indicator) + done + subsubsection {* Point measure *} definition point_measure :: "'a set \ ('a \ ereal) \ 'a measure" where @@ -2351,6 +2373,21 @@ unfolding uniform_measure_def by (simp add: AE_density) qed +subsubsection {* Null measure *} + +lemma null_measure_eq_density: "null_measure M = density M (\_. 0)" + by (intro measure_eqI) (simp_all add: emeasure_density) + +lemma nn_integral_null_measure[simp]: "(\\<^sup>+x. f x \null_measure M) = 0" + by (auto simp add: nn_integral_def simple_integral_def SUP_constant bot_ereal_def le_fun_def + intro!: exI[of _ "\x. 0"]) + +lemma density_null_measure[simp]: "density (null_measure M) f = null_measure M" +proof (intro measure_eqI) + fix A show "emeasure (density (null_measure M) f) A = emeasure (null_measure M) A" + by (simp add: density_def) (simp only: null_measure_def[symmetric] emeasure_null_measure) +qed simp + subsubsection {* Uniform count measure *} definition "uniform_count_measure A = point_measure A (\x. 1 / card A)" diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Probability_Mass_Function.thy --- a/src/HOL/Probability/Probability_Mass_Function.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Probability_Mass_Function.thy Thu Jan 22 14:51:08 2015 +0100 @@ -12,16 +12,6 @@ "~~/src/HOL/Library/Multiset" begin -lemma bind_return'': "sets M = sets N \ M \= return N = M" - by (cases "space M = {}") - (simp_all add: bind_empty space_empty[symmetric] bind_nonempty join_return' - cong: subprob_algebra_cong) - - -lemma (in prob_space) distr_const[simp]: - "c \ space N \ distr M N (\x. c) = return N c" - by (rule measure_eqI) (auto simp: emeasure_distr emeasure_space_1) - lemma (in finite_measure) countable_support: "countable {x. measure M {x} \ 0}" proof cases @@ -214,8 +204,7 @@ by (subst emeasure_eq_setsum_singleton) (auto simp: emeasure_pmf_single) lemma measure_measure_pmf_finite: "finite S \ measure (measure_pmf M) S = setsum (pmf M) S" -using emeasure_measure_pmf_finite[of S M] -by(simp add: measure_pmf.emeasure_eq_measure) + using emeasure_measure_pmf_finite[of S M] by(simp add: measure_pmf.emeasure_eq_measure) lemma nn_integral_measure_pmf_support: fixes f :: "'a \ ereal" @@ -759,33 +748,34 @@ intro!: measure_pmf.integrable_const_bound[where B=1]) done + lemma measurable_pair_restrict_pmf2: assumes "countable A" - assumes "\y. y \ A \ (\x. f (x, y)) \ measurable M L" - shows "f \ measurable (M \\<^sub>M restrict_space (measure_pmf N) A) L" - apply (subst measurable_cong_sets) - apply (rule sets_pair_measure_cong sets_restrict_space_cong sets_measure_pmf_count_space refl)+ - apply (simp_all add: restrict_count_space) - apply (subst split_eta[symmetric]) - unfolding measurable_split_conv - apply (rule measurable_compose_countable'[OF _ measurable_snd `countable A`]) - apply (rule measurable_compose[OF measurable_fst]) - apply fact - done + assumes [measurable]: "\y. y \ A \ (\x. f (x, y)) \ measurable M L" + shows "f \ measurable (M \\<^sub>M restrict_space (measure_pmf N) A) L" (is "f \ measurable ?M _") +proof - + have [measurable_cong]: "sets (restrict_space (count_space UNIV) A) = sets (count_space A)" + by (simp add: restrict_count_space) + + show ?thesis + by (intro measurable_compose_countable'[where f="\a b. f (fst b, a)" and g=snd and I=A, + unfolded pair_collapse] assms) + measurable +qed lemma measurable_pair_restrict_pmf1: assumes "countable A" - assumes "\x. x \ A \ (\y. f (x, y)) \ measurable N L" + assumes [measurable]: "\x. x \ A \ (\y. f (x, y)) \ measurable N L" shows "f \ measurable (restrict_space (measure_pmf M) A \\<^sub>M N) L" - apply (subst measurable_cong_sets) - apply (rule sets_pair_measure_cong sets_restrict_space_cong sets_measure_pmf_count_space refl)+ - apply (simp_all add: restrict_count_space) - apply (subst split_eta[symmetric]) - unfolding measurable_split_conv - apply (rule measurable_compose_countable'[OF _ measurable_fst `countable A`]) - apply (rule measurable_compose[OF measurable_snd]) - apply fact - done +proof - + have [measurable_cong]: "sets (restrict_space (count_space UNIV) A) = sets (count_space A)" + by (simp add: restrict_count_space) + + show ?thesis + by (intro measurable_compose_countable'[where f="\a b. f (a, snd b)" and g=fst and I=A, + unfolded pair_collapse] assms) + measurable +qed lemma bind_commute_pmf: "bind_pmf A (\x. bind_pmf B (C x)) = bind_pmf B (\y. bind_pmf A (\x. C x y))" unfolding pmf_eq_iff pmf_bind @@ -993,11 +983,6 @@ map_pmf fst pq = p; map_pmf snd pq = q \ \ rel_pmf R p q" -lemma nn_integral_count_space_eq: - "(\x. x \ A - B \ f x = 0) \ (\x. x \ B - A \ f x = 0) \ - (\\<^sup>+x. f x \count_space A) = (\\<^sup>+x. f x \count_space B)" - by (auto simp: nn_integral_count_space_indicator intro!: nn_integral_cong split: split_indicator) - bnf pmf: "'a pmf" map: map_pmf sets: set_pmf bd : "natLeq" rel: rel_pmf proof - show "map_pmf id = id" by (rule map_pmf_id) diff -r ca2336984f6a -r c5e79df8cc21 src/HOL/Probability/Probability_Measure.thy --- a/src/HOL/Probability/Probability_Measure.thy Thu Jan 22 13:21:45 2015 +0100 +++ b/src/HOL/Probability/Probability_Measure.thy Thu Jan 22 14:51:08 2015 +0100 @@ -23,6 +23,9 @@ show "prob_space M" by default fact qed +lemma prob_space_imp_sigma_finite: "prob_space M \ sigma_finite_measure M" + unfolding prob_space_def finite_measure_def by simp + abbreviation (in prob_space) "events \ sets M" abbreviation (in prob_space) "prob \ measure M" abbreviation (in prob_space) "random_variable M' X \ X \ measurable M M'"