# HG changeset patch # User hoelzl # Date 1412605651 -7200 # Node ID 93d87fd1583db58e0ecc73654a3d6367499fb51e # Parent 5484f6079bcd52185ca0e67468894aceacb03af7 add measure space for (coinductive) streams diff -r 5484f6079bcd -r 93d87fd1583d src/HOL/Probability/Probability.thy --- a/src/HOL/Probability/Probability.thy Mon Oct 06 16:27:07 2014 +0200 +++ b/src/HOL/Probability/Probability.thy Mon Oct 06 16:27:31 2014 +0200 @@ -2,12 +2,11 @@ imports Discrete_Topology Complete_Measure - Probability_Measure - Infinite_Product_Measure Projective_Limit Independent_Family Distributions Probability_Mass_Function + Stream_Space begin end diff -r 5484f6079bcd -r 93d87fd1583d src/HOL/Probability/Sigma_Algebra.thy --- a/src/HOL/Probability/Sigma_Algebra.thy Mon Oct 06 16:27:07 2014 +0200 +++ b/src/HOL/Probability/Sigma_Algebra.thy Mon Oct 06 16:27:31 2014 +0200 @@ -2214,122 +2214,101 @@ using emeasure_extend_measure[OF M _ _ ms(2,3), of "(i,j)"] eq ms(1) `I i j` by (auto simp: subset_eq) -subsubsection {* Sigma algebra generated by function preimages *} +subsubsection {* Supremum of a set of \sigma-algebras *} + +definition "Sup_sigma M = sigma (\x\M. space x) (\x\M. sets x)" + +syntax + "_SUP_sigma" :: "pttrn \ 'a set \ 'b \ 'b" ("(3\\<^sub>\ _\_./ _)" [0, 0, 10] 10) -definition - "vimage_algebra M S X = sigma S ((\A. X -` A \ S) ` sets M)" +translations + "\\<^sub>\ x\A. B" == "CONST Sup_sigma ((\x. B) ` A)" + +lemma space_Sup_sigma: "space (Sup_sigma M) = (\x\M. space x)" + unfolding Sup_sigma_def by (rule space_measure_of) (auto dest: sets.sets_into_space) + +lemma sets_Sup_sigma: "sets (Sup_sigma M) = sigma_sets (\x\M. space x) (\x\M. sets x)" + unfolding Sup_sigma_def by (rule sets_measure_of) (auto dest: sets.sets_into_space) + +lemma in_Sup_sigma: "m \ M \ A \ sets m \ A \ sets (Sup_sigma M)" + unfolding sets_Sup_sigma by auto -lemma sigma_algebra_preimages: - fixes f :: "'x \ 'a" - assumes "f \ S \ space M" - shows "sigma_algebra S ((\A. f -` A \ S) ` sets M)" - (is "sigma_algebra _ (?F ` sets M)") -proof (simp add: sigma_algebra_iff2, safe) - show "{} \ ?F ` sets M" by blast -next - fix A assume "A \ sets M" - moreover have "S - ?F A = ?F (space M - A)" +lemma sets_Sup_in_sets: + assumes "M \ {}" + assumes "\m. m \ M \ space m = space N" + assumes "\m. m \ M \ sets m \ sets N" + shows "sets (Sup_sigma M) \ sets N" +proof - + have *: "UNION M space = space N" using assms by auto - ultimately show "S - ?F A \ ?F ` sets M" - by blast -next - fix A :: "nat \ 'x set" assume *: "range A \ ?F ` M" - have "\i. \b. b \ M \ A i = ?F b" - proof safe - fix i - have "A i \ ?F ` M" using * by auto - then show "\b. b \ M \ A i = ?F b" by auto - qed - from choice[OF this] obtain b where b: "range b \ M" "\i. A i = ?F (b i)" - by auto - then have "(\i. A i) = ?F (\i. b i)" by auto - then show "(\i. A i) \ ?F ` M" using b(1) by blast + show ?thesis + unfolding sets_Sup_sigma * using assms by (auto intro!: sets.sigma_sets_subset) +qed + +lemma measurable_Sup_sigma1: + assumes m: "m \ M" and f: "f \ measurable m N" + and const_space: "\m n. m \ M \ n \ M \ space m = space n" + shows "f \ measurable (Sup_sigma M) N" +proof - + have "space (Sup_sigma M) = space m" + using m by (auto simp add: space_Sup_sigma dest: const_space) + then show ?thesis + using m f unfolding measurable_def by (auto intro: in_Sup_sigma) qed -lemma sets_vimage_algebra[simp]: - "f \ S \ space M \ sets (vimage_algebra M S f) = (\A. f -` A \ S) ` sets M" - using sigma_algebra.sets_measure_of_eq[OF sigma_algebra_preimages, of f S M] - by (simp add: vimage_algebra_def) +lemma measurable_Sup_sigma2: + assumes M: "M \ {}" + assumes f: "\m. m \ M \ f \ measurable N m" + shows "f \ measurable N (Sup_sigma M)" + unfolding Sup_sigma_def +proof (rule measurable_measure_of) + show "f \ space N \ UNION M space" + using measurable_space[OF f] M by auto +qed (auto intro: measurable_sets f dest: sets.sets_into_space) -lemma space_vimage_algebra[simp]: - "f \ S \ space M \ space (vimage_algebra M S f) = S" - using sigma_algebra.space_measure_of_eq[OF sigma_algebra_preimages, of f S M] - by (simp add: vimage_algebra_def) - -lemma in_vimage_algebra[simp]: - "f \ S \ space M \ A \ sets (vimage_algebra M S f) \ (\B\sets M. A = f -` B \ S)" - by (simp add: image_iff) +subsection {* The smallest \sigma-algebra regarding a function *} -lemma measurable_vimage_algebra: - fixes S :: "'c set" assumes "f \ S \ space M" - shows "f \ measurable (vimage_algebra M S f) M" - unfolding measurable_def using assms by force +definition + "vimage_algebra X f M = sigma X {f -` A \ X | A. A \ sets M}" + +lemma space_vimage_algebra[simp]: "space (vimage_algebra X f M) = X" + unfolding vimage_algebra_def by (rule space_measure_of) auto -lemma measurable_vimage: - fixes g :: "'a \ 'c" and f :: "'d \ 'a" - assumes "g \ measurable M M2" "f \ S \ space M" - shows "(\x. g (f x)) \ measurable (vimage_algebra M S f) M2" -proof - - note measurable_vimage_algebra[OF assms(2)] - from measurable_comp[OF this assms(1)] - show ?thesis by (simp add: comp_def) -qed +lemma sets_vimage_algebra: "sets (vimage_algebra X f M) = sigma_sets X {f -` A \ X | A. A \ sets M}" + unfolding vimage_algebra_def by (rule sets_measure_of) auto + +lemma sets_vimage_algebra2: + "f \ X \ space M \ sets (vimage_algebra X f M) = {f -` A \ X | A. A \ sets M}" + using sigma_sets_vimage_commute[of f X "space M" "sets M"] + unfolding sets_vimage_algebra sets.sigma_sets_eq by simp -lemma sigma_sets_vimage: - assumes "f \ S' \ S" and "A \ Pow S" - shows "sigma_sets S' ((\X. f -` X \ S') ` A) = (\X. f -` X \ S') ` sigma_sets S A" -proof (intro set_eqI iffI) - let ?F = "\X. f -` X \ S'" - fix X assume "X \ sigma_sets S' (?F ` A)" - then show "X \ ?F ` sigma_sets S A" - proof induct - case (Basic X) then obtain X' where "X = ?F X'" "X' \ A" - by auto - then show ?case by auto - next - case Empty then show ?case - by (auto intro!: image_eqI[of _ _ "{}"] sigma_sets.Empty) - next - case (Compl X) then obtain X' where X: "X = ?F X'" and "X' \ sigma_sets S A" - by auto - then have "S - X' \ sigma_sets S A" - by (auto intro!: sigma_sets.Compl) - then show ?case - using X assms by (auto intro!: image_eqI[where x="S - X'"]) - next - case (Union F) - then have "\i. \F'. F' \ sigma_sets S A \ F i = f -` F' \ S'" - by (auto simp: image_iff Bex_def) - from choice[OF this] obtain F' where - "\i. F' i \ sigma_sets S A" and "\i. F i = f -` F' i \ S'" - by auto - then show ?case - by (auto intro!: sigma_sets.Union image_eqI[where x="\i. F' i"]) - qed -next - let ?F = "\X. f -` X \ S'" - fix X assume "X \ ?F ` sigma_sets S A" - then obtain X' where "X' \ sigma_sets S A" "X = ?F X'" by auto - then show "X \ sigma_sets S' (?F ` A)" - proof (induct arbitrary: X) - case Empty then show ?case by (auto intro: sigma_sets.Empty) - next - case (Compl X') - have "S' - (S' - X) \ sigma_sets S' (?F ` A)" - apply (rule sigma_sets.Compl) - using assms by (auto intro!: Compl.hyps simp: Compl.prems) - also have "S' - (S' - X) = X" - using assms Compl by auto - finally show ?case . - next - case (Union F) - have "(\i. f -` F i \ S') \ sigma_sets S' (?F ` A)" - by (intro sigma_sets.Union Union.hyps) simp - also have "(\i. f -` F i \ S') = X" - using assms Union by auto - finally show ?case . - qed auto -qed +lemma in_vimage_algebra: "A \ sets M \ f -` A \ X \ sets (vimage_algebra X f M)" + by (auto simp: vimage_algebra_def) + +lemma sets_image_in_sets: + assumes N: "space N = X" + assumes f: "f \ measurable N M" + shows "sets (vimage_algebra X f M) \ sets N" + unfolding sets_vimage_algebra N[symmetric] + by (rule sets.sigma_sets_subset) (auto intro!: measurable_sets f) + +lemma measurable_vimage_algebra1: "f \ X \ space M \ f \ measurable (vimage_algebra X f M) M" + unfolding measurable_def by (auto intro: in_vimage_algebra) + +lemma measurable_vimage_algebra2: + assumes g: "g \ space N \ X" and f: "(\x. f (g x)) \ measurable N M" + shows "g \ measurable N (vimage_algebra X f M)" + unfolding vimage_algebra_def +proof (rule measurable_measure_of) + fix A assume "A \ {f -` A \ X | A. A \ sets M}" + then obtain Y where Y: "Y \ sets M" and A: "A = f -` Y \ X" + by auto + then have "g -` A \ space N = (\x. f (g x)) -` Y \ space N" + using g by auto + also have "\ \ sets N" + using f Y by (rule measurable_sets) + finally show "g -` A \ space N \ sets N" . +qed (insert g, auto) subsubsection {* Restricted Space Sigma Algebra *} @@ -2343,16 +2322,20 @@ by (simp add: space_restrict_space sets.sets_into_space) lemma sets_restrict_space: "sets (restrict_space M \) = (op \ \) ` sets M" -proof - - have "sigma_sets (\ \ space M) ((\X. X \ (\ \ space M)) ` sets M) = + unfolding restrict_space_def +proof (subst sets_measure_of) + show "op \ \ ` sets M \ Pow (\ \ space M)" + by (auto dest: sets.sets_into_space) + have "sigma_sets (\ \ space M) {((\x. x) -` X) \ (\ \ space M) | X. X \ sets M} = (\X. X \ (\ \ space M)) ` sets M" - using sigma_sets_vimage[of "\x. x" "\ \ space M" "space M" "sets M"] sets.space_closed[of M] - by (simp add: sets.sigma_sets_eq) - moreover have "(\X. X \ (\ \ space M)) ` sets M = (op \ \) ` sets M" - using sets.sets_into_space by (intro image_cong) auto - ultimately show ?thesis - using sets.sets_into_space[of _ M] unfolding restrict_space_def - by (subst sets_measure_of) fastforce+ + by (subst sigma_sets_vimage_commute[symmetric, where \' = "space M"]) + (auto simp add: sets.sigma_sets_eq) + moreover have "{((\x. x) -` X) \ (\ \ space M) | X. X \ sets M} = (\X. X \ (\ \ space M)) ` sets M" + by auto + moreover have "(\X. X \ (\ \ space M)) ` sets M = (op \ \) ` sets M" + by (intro image_cong) (auto dest: sets.sets_into_space) + ultimately show "sigma_sets (\ \ space M) (op \ \ ` sets M) = op \ \ ` sets M" + by simp qed lemma sets_restrict_space_iff: diff -r 5484f6079bcd -r 93d87fd1583d src/HOL/Probability/Stream_Space.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Probability/Stream_Space.thy Mon Oct 06 16:27:31 2014 +0200 @@ -0,0 +1,198 @@ +theory Stream_Space +imports + Infinite_Product_Measure + "~~/src/HOL/Datatype_Examples/Stream" +begin + +lemma stream_eq_Stream_iff: "s = x ## t \ (shd s = x \ stl s = t)" + by (cases s) simp + +lemma Stream_snth: "(x ## s) !! n = (case n of 0 \ x | Suc n \ s !! n)" + by (cases n) simp_all + +lemma sets_PiM_cong: assumes "I = J" "\i. i \ J \ sets (M i) = sets (N i)" shows "sets (PiM I M) = sets (PiM J N)" + using assms sets_eq_imp_space_eq[OF assms(2)] by (simp add: sets_PiM_single cong: PiE_cong conj_cong) + +lemma nn_integral_le_0[simp]: "integral\<^sup>N M f \ 0 \ integral\<^sup>N M f = 0" + using nn_integral_nonneg[of M f] by auto + +lemma restrict_UNIV: "restrict f UNIV = f" + by (simp add: restrict_def) + +definition to_stream :: "(nat \ 'a) \ 'a stream" where + "to_stream X = smap X nats" + +lemma to_stream_nat_case: "to_stream (case_nat x X) = x ## to_stream X" + unfolding to_stream_def + by (subst siterate.ctr) (simp add: smap_siterate[symmetric] stream.map_comp comp_def) + +definition stream_space :: "'a measure \ 'a stream measure" where + "stream_space M = + distr (\\<^sub>M i\UNIV. M) (vimage_algebra (streams (space M)) snth (\\<^sub>M i\UNIV. M)) to_stream" + +lemma space_stream_space: "space (stream_space M) = streams (space M)" + by (simp add: stream_space_def) + +lemma streams_stream_space[intro]: "streams (space M) \ sets (stream_space M)" + using sets.top[of "stream_space M"] by (simp add: space_stream_space) + +lemma stream_space_Stream: + "x ## \ \ space (stream_space M) \ x \ space M \ \ \ space (stream_space M)" + by (simp add: space_stream_space streams_Stream) + +lemma stream_space_eq_distr: "stream_space M = distr (\\<^sub>M i\UNIV. M) (stream_space M) to_stream" + unfolding stream_space_def by (rule distr_cong) auto + +lemma sets_stream_space_cong: "sets M = sets N \ sets (stream_space M) = sets (stream_space N)" + using sets_eq_imp_space_eq[of M N] by (simp add: stream_space_def vimage_algebra_def cong: sets_PiM_cong) + +lemma measurable_snth_PiM: "(\\ n. \ !! n) \ measurable (stream_space M) (\\<^sub>M i\UNIV. M)" + by (auto intro!: measurable_vimage_algebra1 + simp: space_PiM streams_iff_sset sset_range image_subset_iff stream_space_def) + +lemma measurable_snth[measurable]: "(\\. \ !! n) \ measurable (stream_space M) M" + using measurable_snth_PiM measurable_component_singleton by (rule measurable_compose) simp + +lemma measurable_shd[measurable]: "shd \ measurable (stream_space M) M" + using measurable_snth[of 0] by simp + +lemma measurable_stream_space2: + assumes f_snth: "\n. (\x. f x !! n) \ measurable N M" + shows "f \ measurable N (stream_space M)" + unfolding stream_space_def measurable_distr_eq2 +proof (rule measurable_vimage_algebra2) + show "f \ space N \ streams (space M)" + using f_snth[THEN measurable_space] by (auto simp add: streams_iff_sset sset_range) + show "(\x. op !! (f x)) \ measurable N (Pi\<^sub>M UNIV (\i. M))" + proof (rule measurable_PiM_single') + show "(\x. op !! (f x)) \ space N \ UNIV \\<^sub>E space M" + using f_snth[THEN measurable_space] by auto + qed (rule f_snth) +qed + +lemma measurable_stream_coinduct[consumes 1, case_names shd stl, coinduct set: measurable]: + assumes "F f" + assumes h: "\f. F f \ (\x. shd (f x)) \ measurable N M" + assumes t: "\f. F f \ F (\x. stl (f x))" + shows "f \ measurable N (stream_space M)" +proof (rule measurable_stream_space2) + fix n show "(\x. f x !! n) \ measurable N M" + using `F f` by (induction n arbitrary: f) (auto intro: h t) +qed + +lemma measurable_sdrop[measurable]: "sdrop n \ measurable (stream_space M) (stream_space M)" + by (rule measurable_stream_space2) (simp add: sdrop_snth) + +lemma measurable_stl[measurable]: "(\\. stl \) \ measurable (stream_space M) (stream_space M)" + by (rule measurable_stream_space2) (simp del: snth.simps add: snth.simps[symmetric]) + +lemma measurable_to_stream[measurable]: "to_stream \ measurable (\\<^sub>M i\UNIV. M) (stream_space M)" + by (rule measurable_stream_space2) (simp add: to_stream_def) + +lemma measurable_Stream[measurable (raw)]: + assumes f[measurable]: "f \ measurable N M" + assumes g[measurable]: "g \ measurable N (stream_space M)" + shows "(\x. f x ## g x) \ measurable N (stream_space M)" + by (rule measurable_stream_space2) (simp add: Stream_snth) + +lemma measurable_smap[measurable]: + assumes X[measurable]: "X \ measurable N M" + shows "smap X \ measurable (stream_space N) (stream_space M)" + by (rule measurable_stream_space2) simp + +lemma measurable_stake[measurable]: + "stake i \ measurable (stream_space (count_space UNIV)) (count_space (UNIV :: 'a::countable list set))" + by (induct i) auto + +lemma (in prob_space) prob_space_stream_space: "prob_space (stream_space M)" +proof - + interpret product_prob_space "\_. M" UNIV by default + show ?thesis + by (subst stream_space_eq_distr) (auto intro!: P.prob_space_distr) +qed + +lemma (in prob_space) nn_integral_stream_space: + assumes [measurable]: "f \ borel_measurable (stream_space M)" + shows "(\\<^sup>+X. f X \stream_space M) = (\\<^sup>+x. (\\<^sup>+X. f (x ## X) \stream_space M) \M)" +proof - + interpret S: sequence_space M + by default + interpret P: pair_sigma_finite M "\\<^sub>M i::nat\UNIV. M" + by default + + have "(\\<^sup>+X. f X \stream_space M) = (\\<^sup>+X. f (to_stream X) \S.S)" + by (subst stream_space_eq_distr) (simp add: nn_integral_distr) + also have "\ = (\\<^sup>+X. f (to_stream ((\(s, \). case_nat s \) X)) \(M \\<^sub>M S.S))" + by (subst S.PiM_iter[symmetric]) (simp add: nn_integral_distr) + also have "\ = (\\<^sup>+x. \\<^sup>+X. f (to_stream ((\(s, \). case_nat s \) (x, X))) \S.S \M)" + by (subst S.nn_integral_fst) simp_all + also have "\ = (\\<^sup>+x. \\<^sup>+X. f (x ## to_stream X) \S.S \M)" + by (auto intro!: nn_integral_cong simp: to_stream_nat_case) + also have "\ = (\\<^sup>+x. \\<^sup>+X. f (x ## X) \stream_space M \M)" + by (subst stream_space_eq_distr) + (simp add: nn_integral_distr cong: nn_integral_cong) + finally show ?thesis . +qed + +lemma (in prob_space) emeasure_stream_space: + assumes X[measurable]: "X \ sets (stream_space M)" + shows "emeasure (stream_space M) X = (\\<^sup>+t. emeasure (stream_space M) {x\space (stream_space M). t ## x \ X } \M)" +proof - + have eq: "\x xs. xs \ space (stream_space M) \ x \ space M \ + indicator X (x ## xs) = indicator {xs\space (stream_space M). x ## xs \ X } xs" + by (auto split: split_indicator) + show ?thesis + using nn_integral_stream_space[of "indicator X"] + apply (auto intro!: nn_integral_cong) + apply (subst nn_integral_cong) + apply (rule eq) + apply simp_all + done +qed + +lemma (in prob_space) prob_stream_space: + assumes P[measurable]: "{x\space (stream_space M). P x} \ sets (stream_space M)" + shows "\

(x in stream_space M. P x) = (\\<^sup>+t. \

(x in stream_space M. P (t ## x)) \M)" +proof - + interpret S: prob_space "stream_space M" + by (rule prob_space_stream_space) + show ?thesis + unfolding S.emeasure_eq_measure[symmetric] + by (subst emeasure_stream_space) (auto simp: stream_space_Stream intro!: nn_integral_cong) +qed + +lemma (in prob_space) AE_stream_space: + assumes [measurable]: "Measurable.pred (stream_space M) P" + shows "(AE X in stream_space M. P X) = (AE x in M. AE X in stream_space M. P (x ## X))" +proof - + interpret stream: prob_space "stream_space M" + by (rule prob_space_stream_space) + + have eq: "\x X. indicator {x. \ P x} (x ## X) = indicator {X. \ P (x ## X)} X" + by (auto split: split_indicator) + show ?thesis + apply (subst AE_iff_nn_integral, simp) + apply (subst nn_integral_stream_space, simp) + apply (subst eq) + apply (subst nn_integral_0_iff_AE, simp) + apply (simp add: AE_iff_nn_integral[symmetric]) + done +qed + +lemma (in prob_space) AE_stream_all: + assumes [measurable]: "Measurable.pred M P" and P: "AE x in M. P x" + shows "AE x in stream_space M. stream_all P x" +proof - + { fix n have "AE x in stream_space M. P (x !! n)" + proof (induct n) + case 0 with P show ?case + by (subst AE_stream_space) (auto elim!: eventually_elim1) + next + case (Suc n) then show ?case + by (subst AE_stream_space) auto + qed } + then show ?thesis + unfolding stream_all_def by (simp add: AE_all_countable) +qed + +end