diff -r dfe747e72fa8 -r d31085f07f60 src/HOL/Probability/Sigma_Algebra.thy --- a/src/HOL/Probability/Sigma_Algebra.thy Wed Apr 25 19:26:00 2012 +0200 +++ b/src/HOL/Probability/Sigma_Algebra.thy Wed Apr 25 19:26:27 2012 +0200 @@ -24,7 +24,7 @@ subsets of the universe. A sigma algebra is such a set that has three very natural and desirable properties. *} -subsection {* Algebras *} +subsection {* Families of sets *} locale subset_class = fixes \ :: "'a set" and M :: "'a set set" @@ -33,20 +33,85 @@ lemma (in subset_class) sets_into_space: "x \ M \ x \ \" by (metis PowD contra_subsetD space_closed) -locale ring_of_sets = subset_class + - assumes empty_sets [iff]: "{} \ M" - and Diff [intro]: "\a b. a \ M \ b \ M \ a - b \ M" - and Un [intro]: "\a b. a \ M \ b \ M \ a \ b \ M" +subsection {* Semiring of sets *} + +subsubsection {* Disjoint sets *} + +definition "disjoint A \ (\a\A. \b\A. a \ b \ a \ b = {})" + +lemma disjointI: + "(\a b. a \ A \ b \ A \ a \ b \ a \ b = {}) \ disjoint A" + unfolding disjoint_def by auto + +lemma disjointD: + "disjoint A \ a \ A \ b \ A \ a \ b \ a \ b = {}" + unfolding disjoint_def by auto + +lemma disjoint_empty[iff]: "disjoint {}" + by (auto simp: disjoint_def) -lemma (in ring_of_sets) Int [intro]: - assumes a: "a \ M" and b: "b \ M" shows "a \ b \ M" +lemma disjoint_union: + assumes C: "disjoint C" and B: "disjoint B" and disj: "\C \ \B = {}" + shows "disjoint (C \ B)" +proof (rule disjointI) + fix c d assume sets: "c \ C \ B" "d \ C \ B" and "c \ d" + show "c \ d = {}" + proof cases + assume "(c \ C \ d \ C) \ (c \ B \ d \ B)" + then show ?thesis + proof + assume "c \ C \ d \ C" with `c \ d` C show "c \ d = {}" + by (auto simp: disjoint_def) + next + assume "c \ B \ d \ B" with `c \ d` B show "c \ d = {}" + by (auto simp: disjoint_def) + qed + next + assume "\ ((c \ C \ d \ C) \ (c \ B \ d \ B))" + with sets have "(c \ \C \ d \ \B) \ (c \ \B \ d \ \C)" + by auto + with disj show "c \ d = {}" by auto + qed +qed + +locale semiring_of_sets = subset_class + + assumes empty_sets[iff]: "{} \ M" + assumes Int[intro]: "\a b. a \ M \ b \ M \ a \ b \ M" + assumes Diff_cover: + "\a b. a \ M \ b \ M \ \C\M. finite C \ disjoint C \ a - b = \C" + +lemma (in semiring_of_sets) finite_INT[intro]: + assumes "finite I" "I \ {}" "\i. i \ I \ A i \ M" + shows "(\i\I. A i) \ M" + using assms by (induct rule: finite_ne_induct) auto + +lemma (in semiring_of_sets) Int_space_eq1 [simp]: "x \ M \ \ \ x = x" + by (metis Int_absorb1 sets_into_space) + +lemma (in semiring_of_sets) Int_space_eq2 [simp]: "x \ M \ x \ \ = x" + by (metis Int_absorb2 sets_into_space) + +lemma (in semiring_of_sets) sets_Collect_conj: + assumes "{x\\. P x} \ M" "{x\\. Q x} \ M" + shows "{x\\. Q x \ P x} \ M" proof - - have "a \ b = a - (a - b)" + have "{x\\. Q x \ P x} = {x\\. Q x} \ {x\\. P x}" by auto - then show "a \ b \ M" - using a b by auto + with assms show ?thesis by auto qed +lemma (in semiring_of_sets) sets_Collect_finite_All: + assumes "\i. i \ S \ {x\\. P i x} \ M" "finite S" "S \ {}" + shows "{x\\. \i\S. P i x} \ M" +proof - + have "{x\\. \i\S. P i x} = (\i\S. {x\\. P i x})" + using `S \ {}` by auto + with assms show ?thesis by auto +qed + +locale ring_of_sets = semiring_of_sets + + assumes Un [intro]: "\a b. a \ M \ b \ M \ a \ b \ M" + lemma (in ring_of_sets) finite_Union [intro]: "finite X \ X \ M \ Union X \ M" by (induct set: finite) (auto simp add: Un) @@ -56,10 +121,32 @@ shows "(\i\I. A i) \ M" using assms by induct auto -lemma (in ring_of_sets) finite_INT[intro]: - assumes "finite I" "I \ {}" "\i. i \ I \ A i \ M" - shows "(\i\I. A i) \ M" - using assms by (induct rule: finite_ne_induct) auto +lemma (in ring_of_sets) Diff [intro]: + assumes "a \ M" "b \ M" shows "a - b \ M" + using Diff_cover[OF assms] by auto + +lemma ring_of_setsI: + assumes space_closed: "M \ Pow \" + assumes empty_sets[iff]: "{} \ M" + assumes Un[intro]: "\a b. a \ M \ b \ M \ a \ b \ M" + assumes Diff[intro]: "\a b. a \ M \ b \ M \ a - b \ M" + shows "ring_of_sets \ M" +proof + fix a b assume ab: "a \ M" "b \ M" + from ab show "\C\M. finite C \ disjoint C \ a - b = \C" + by (intro exI[of _ "{a - b}"]) (auto simp: disjoint_def) + have "a \ b = a - (a - b)" by auto + also have "\ \ M" using ab by auto + finally show "a \ b \ M" . +qed fact+ + +lemma ring_of_sets_iff: "ring_of_sets \ M \ M \ Pow \ \ {} \ M \ (\a\M. \b\M. a \ b \ M) \ (\a\M. \b\M. a - b \ M)" +proof + assume "ring_of_sets \ M" + then interpret ring_of_sets \ M . + show "M \ Pow \ \ {} \ M \ (\a\M. \b\M. a \ b \ M) \ (\a\M. \b\M. a - b \ M)" + using space_closed by auto +qed (auto intro!: ring_of_setsI) lemma (in ring_of_sets) insert_in_sets: assumes "{x} \ M" "A \ M" shows "insert x A \ M" @@ -68,21 +155,6 @@ thus ?thesis by auto qed -lemma (in ring_of_sets) Int_space_eq1 [simp]: "x \ M \ \ \ x = x" - by (metis Int_absorb1 sets_into_space) - -lemma (in ring_of_sets) Int_space_eq2 [simp]: "x \ M \ x \ \ = x" - by (metis Int_absorb2 sets_into_space) - -lemma (in ring_of_sets) sets_Collect_conj: - assumes "{x\\. P x} \ M" "{x\\. Q x} \ M" - shows "{x\\. Q x \ P x} \ M" -proof - - have "{x\\. Q x \ P x} = {x\\. Q x} \ {x\\. P x}" - by auto - with assms show ?thesis by auto -qed - lemma (in ring_of_sets) sets_Collect_disj: assumes "{x\\. P x} \ M" "{x\\. Q x} \ M" shows "{x\\. Q x \ P x} \ M" @@ -92,15 +164,6 @@ with assms show ?thesis by auto qed -lemma (in ring_of_sets) sets_Collect_finite_All: - assumes "\i. i \ S \ {x\\. P i x} \ M" "finite S" "S \ {}" - shows "{x\\. \i\S. P i x} \ M" -proof - - have "{x\\. \i\S. P i x} = (\i\S. {x\\. P i x})" - using `S \ {}` by auto - with assms show ?thesis by auto -qed - lemma (in ring_of_sets) sets_Collect_finite_Ex: assumes "\i. i \ S \ {x\\. P i x} \ M" "finite S" shows "{x\\. \i\S. P i x} \ M" @@ -129,9 +192,10 @@ show ?Un using sets_into_space by auto next assume ?Un - show "algebra \ M" - proof - show \: "M \ Pow \" "{} \ M" "\ \ M" + then have "\ \ M" by auto + interpret ring_of_sets \ M + proof (rule ring_of_setsI) + show \: "M \ Pow \" "{} \ M" using `?Un` by auto fix a b assume a: "a \ M" and b: "b \ M" then show "a \ b \ M" using `?Un` by auto @@ -140,6 +204,7 @@ then show "a - b \ M" using a b `?Un` by auto qed + show "algebra \ M" proof qed fact qed lemma algebra_iff_Int: @@ -184,9 +249,8 @@ by (cases P) auto lemma algebra_single_set: - assumes "X \ S" - shows "algebra S { {}, X, S - X, S }" - by default (insert `X \ S`, auto) + "X \ S \ algebra S { {}, X, S - X, S }" + by (auto simp: algebra_iff_Int) section {* Restricted algebras *} @@ -195,7 +259,7 @@ lemma (in algebra) restricted_algebra: assumes "A \ M" shows "algebra A (restricted_space A)" - using assms by unfold_locales auto + using assms by (auto simp: algebra_iff_Int) subsection {* Sigma Algebras *} @@ -261,19 +325,19 @@ qed lemma ring_of_sets_Pow: "ring_of_sets sp (Pow sp)" - by default auto + by (auto simp: ring_of_sets_iff) lemma algebra_Pow: "algebra sp (Pow sp)" - by default auto - -lemma sigma_algebra_Pow: "sigma_algebra sp (Pow sp)" - by default auto + by (auto simp: algebra_iff_Un) lemma sigma_algebra_iff: "sigma_algebra \ M \ algebra \ M \ (\A. range A \ M \ (\i::nat. A i) \ M)" by (simp add: sigma_algebra_def sigma_algebra_axioms_def) +lemma sigma_algebra_Pow: "sigma_algebra sp (Pow sp)" + by (auto simp: sigma_algebra_iff algebra_iff_Int) + lemma (in sigma_algebra) sets_Collect_countable_All: assumes "\i. {x\\. P i x} \ M" shows "{x\\. \i::'i::countable. P i x} \ M" @@ -452,6 +516,21 @@ by induct (insert `A \ B`, auto intro: sigma_sets.intros(2-)) qed +lemma sigma_sets_mono: assumes "A \ sigma_sets X B" shows "sigma_sets X A \ sigma_sets X B" +proof + fix x assume "x \ sigma_sets X A" then show "x \ sigma_sets X B" + by induct (insert `A \ sigma_sets X B`, auto intro: sigma_sets.intros(2-)) +qed + +lemma sigma_sets_mono': assumes "A \ B" shows "sigma_sets X A \ sigma_sets X B" +proof + fix x assume "x \ sigma_sets X A" then show "x \ sigma_sets X B" + by induct (insert `A \ B`, auto intro: sigma_sets.intros(2-)) +qed + +lemma sigma_sets_superset_generator: "A \ sigma_sets X A" + by (auto intro: sigma_sets.Basic) + lemma (in sigma_algebra) restriction_in_sets: fixes A :: "nat \ 'a set" assumes "S \ M" @@ -762,6 +841,150 @@ thus "(\i::nat. A i) \ M" by (simp add: UN_disjointed_eq) qed +lemma disjoint_family_on_disjoint_image: + "disjoint_family_on A I \ disjoint (A ` I)" + unfolding disjoint_family_on_def disjoint_def by force + +lemma disjoint_image_disjoint_family_on: + assumes d: "disjoint (A ` I)" and i: "inj_on A I" + shows "disjoint_family_on A I" + unfolding disjoint_family_on_def +proof (intro ballI impI) + fix n m assume nm: "m \ I" "n \ I" and "n \ m" + with i[THEN inj_onD, of n m] show "A n \ A m = {}" + by (intro disjointD[OF d]) auto +qed + +section {* Ring generated by a semiring *} + +definition (in semiring_of_sets) + "generated_ring = { \C | C. C \ M \ finite C \ disjoint C }" + +lemma (in semiring_of_sets) generated_ringE[elim?]: + assumes "a \ generated_ring" + obtains C where "finite C" "disjoint C" "C \ M" "a = \C" + using assms unfolding generated_ring_def by auto + +lemma (in semiring_of_sets) generated_ringI[intro?]: + assumes "finite C" "disjoint C" "C \ M" "a = \C" + shows "a \ generated_ring" + using assms unfolding generated_ring_def by auto + +lemma (in semiring_of_sets) generated_ringI_Basic: + "A \ M \ A \ generated_ring" + by (rule generated_ringI[of "{A}"]) (auto simp: disjoint_def) + +lemma (in semiring_of_sets) generated_ring_disjoint_Un[intro]: + assumes a: "a \ generated_ring" and b: "b \ generated_ring" + and "a \ b = {}" + shows "a \ b \ generated_ring" +proof - + from a guess Ca .. note Ca = this + from b guess Cb .. note Cb = this + show ?thesis + proof + show "disjoint (Ca \ Cb)" + using `a \ b = {}` Ca Cb by (auto intro!: disjoint_union) + qed (insert Ca Cb, auto) +qed + +lemma (in semiring_of_sets) generated_ring_empty: "{} \ generated_ring" + by (auto simp: generated_ring_def disjoint_def) + +lemma (in semiring_of_sets) generated_ring_disjoint_Union: + assumes "finite A" shows "A \ generated_ring \ disjoint A \ \A \ generated_ring" + using assms by (induct A) (auto simp: disjoint_def intro!: generated_ring_disjoint_Un generated_ring_empty) + +lemma (in semiring_of_sets) generated_ring_disjoint_UNION: + "finite I \ disjoint (A ` I) \ (\i. i \ I \ A i \ generated_ring) \ UNION I A \ generated_ring" + unfolding SUP_def by (intro generated_ring_disjoint_Union) auto + +lemma (in semiring_of_sets) generated_ring_Int: + assumes a: "a \ generated_ring" and b: "b \ generated_ring" + shows "a \ b \ generated_ring" +proof - + from a guess Ca .. note Ca = this + from b guess Cb .. note Cb = this + def C \ "(\(a,b). a \ b)` (Ca\Cb)" + show ?thesis + proof + show "disjoint C" + proof (simp add: disjoint_def C_def, intro ballI impI) + fix a1 b1 a2 b2 assume sets: "a1 \ Ca" "b1 \ Cb" "a2 \ Ca" "b2 \ Cb" + assume "a1 \ b1 \ a2 \ b2" + then have "a1 \ a2 \ b1 \ b2" by auto + then show "(a1 \ b1) \ (a2 \ b2) = {}" + proof + assume "a1 \ a2" + with sets Ca have "a1 \ a2 = {}" + by (auto simp: disjoint_def) + then show ?thesis by auto + next + assume "b1 \ b2" + with sets Cb have "b1 \ b2 = {}" + by (auto simp: disjoint_def) + then show ?thesis by auto + qed + qed + qed (insert Ca Cb, auto simp: C_def) +qed + +lemma (in semiring_of_sets) generated_ring_Inter: + assumes "finite A" "A \ {}" shows "A \ generated_ring \ \A \ generated_ring" + using assms by (induct A rule: finite_ne_induct) (auto intro: generated_ring_Int) + +lemma (in semiring_of_sets) generated_ring_INTER: + "finite I \ I \ {} \ (\i. i \ I \ A i \ generated_ring) \ INTER I A \ generated_ring" + unfolding INF_def by (intro generated_ring_Inter) auto + +lemma (in semiring_of_sets) generating_ring: + "ring_of_sets \ generated_ring" +proof (rule ring_of_setsI) + let ?R = generated_ring + show "?R \ Pow \" + using sets_into_space by (auto simp: generated_ring_def generated_ring_empty) + show "{} \ ?R" by (rule generated_ring_empty) + + { fix a assume a: "a \ ?R" then guess Ca .. note Ca = this + fix b assume b: "b \ ?R" then guess Cb .. note Cb = this + + show "a - b \ ?R" + proof cases + assume "Cb = {}" with Cb `a \ ?R` show ?thesis + by simp + next + assume "Cb \ {}" + with Ca Cb have "a - b = (\a'\Ca. \b'\Cb. a' - b')" by auto + also have "\ \ ?R" + proof (intro generated_ring_INTER generated_ring_disjoint_UNION) + fix a b assume "a \ Ca" "b \ Cb" + with Ca Cb Diff_cover[of a b] show "a - b \ ?R" + by (auto simp add: generated_ring_def) + next + show "disjoint ((\a'. \b'\Cb. a' - b')`Ca)" + using Ca by (auto simp add: disjoint_def `Cb \ {}`) + next + show "finite Ca" "finite Cb" "Cb \ {}" by fact+ + qed + finally show "a - b \ ?R" . + qed } + note Diff = this + + fix a b assume sets: "a \ ?R" "b \ ?R" + have "a \ b = (a - b) \ (a \ b) \ (b - a)" by auto + also have "\ \ ?R" + by (intro sets generated_ring_disjoint_Un generated_ring_Int Diff) auto + finally show "a \ b \ ?R" . +qed + +lemma (in semiring_of_sets) sigma_sets_generated_ring_eq: "sigma_sets \ generated_ring = sigma_sets \ M" +proof + interpret M: sigma_algebra \ "sigma_sets \ M" + using space_closed by (rule sigma_algebra_sigma_sets) + show "sigma_sets \ generated_ring \ sigma_sets \ M" + by (blast intro!: sigma_sets_mono elim: generated_ringE) +qed (auto intro!: generated_ringI_Basic sigma_sets_mono) + section {* Measure type *} definition positive :: "'a set set \ ('a set \ ereal) \ bool" where @@ -777,7 +1000,7 @@ typedef (open) 'a measure = "{(\::'a set, A, \). (\a\-A. \ a = 0) \ measure_space \ A \ }" proof have "sigma_algebra UNIV {{}, UNIV}" - proof qed auto + by (auto simp: sigma_algebra_iff2) then show "(UNIV, {{}, UNIV}, \A. 0) \ {(\, A, \). (\a\-A. \ a = 0) \ measure_space \ A \} " by (auto simp: measure_space_def positive_def countably_additive_def) qed