--- a/NEWS Wed Dec 01 20:52:16 2010 -0800
+++ b/NEWS Thu Dec 02 11:18:44 2010 -0800
@@ -92,6 +92,22 @@
*** HOL ***
+* Functions can be declared as coercions and type inference will add them
+as necessary upon input of a term. In Complex_Main, real :: nat => real
+and real :: int => real are declared as coercions. A new coercion function
+f is declared like this:
+
+declare [[coercion f]]
+
+To lift coercions through type constructors (eg from nat => real to
+nat list => real list), map functions can be declared, e.g.
+
+declare [[coercion_map map]]
+
+Currently coercion inference is activated only in theories including real
+numbers, i.e. descendants of Complex_Main. In other theories it needs to be
+loaded explicitly: uses "~~/src/Tools/subtyping.ML"
+
* Abandoned locales equiv, congruent and congruent2 for equivalence relations.
INCOMPATIBILITY: use equivI rather than equiv_intro (same for congruent(2)).
@@ -138,7 +154,7 @@
techniques, in particular static evaluation conversions.
* String.literal is a type, but not a datatype. INCOMPATIBILITY.
-
+
* Renamed lemmas:
expand_fun_eq -> fun_eq_iff
expand_set_eq -> set_eq_iff
@@ -285,15 +301,13 @@
Also note that the indices are now natural numbers and not from some finite
type. Finite cartesian products of euclidean spaces, products of euclidean
spaces the real and complex numbers are instantiated to be euclidean_spaces.
-
INCOMPATIBILITY.
* Probability: Introduced pinfreal as real numbers with infinity. Use pinfreal
-as value for measures. Introduces Lebesgue Measure based on the integral in
-Multivariate Analysis. Proved Radon Nikodym for arbitrary sigma finite measure
-spaces.
-
- INCOMPATIBILITY.
+as value for measures. Introduce the Radon-Nikodym derivative, product spaces
+and Fubini's theorem for arbitrary sigma finite measures. Introduces Lebesgue
+measure based on the integral in Multivariate Analysis.
+INCOMPATIBILITY.
* Inductive package: offers new command "inductive_simps" to automatically
derive instantiated and simplified equations for inductive predicates,
--- a/src/HOL/Code_Evaluation.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Code_Evaluation.thy Thu Dec 02 11:18:44 2010 -0800
@@ -138,28 +138,37 @@
subsubsection {* Numeric types *}
-definition term_of_num :: "'a\<Colon>{semiring_div} \<Rightarrow> 'a\<Colon>{semiring_div} \<Rightarrow> term" where
- "term_of_num two = (\<lambda>_. dummy_term)"
+definition term_of_num_semiring :: "'a\<Colon>semiring_div \<Rightarrow> 'a \<Rightarrow> term" where
+ "term_of_num_semiring two = (\<lambda>_. dummy_term)"
-lemma (in term_syntax) term_of_num_code [code]:
- "term_of_num two k = (if k = 0 then termify Int.Pls
+lemma (in term_syntax) term_of_num_semiring_code [code]:
+ "term_of_num_semiring two k = (if k = 0 then termify Int.Pls
else (if k mod two = 0
- then termify Int.Bit0 <\<cdot>> term_of_num two (k div two)
- else termify Int.Bit1 <\<cdot>> term_of_num two (k div two)))"
- by (auto simp add: term_of_anything Const_def App_def term_of_num_def Let_def)
+ then termify Int.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
+ else termify Int.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
+ by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def Let_def)
lemma (in term_syntax) term_of_nat_code [code]:
- "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num (2::nat) n"
+ "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n"
+ by (simp only: term_of_anything)
+
+lemma (in term_syntax) term_of_code_numeral_code [code]:
+ "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k"
by (simp only: term_of_anything)
+definition term_of_num_ring :: "'a\<Colon>ring_div \<Rightarrow> 'a \<Rightarrow> term" where
+ "term_of_num_ring two = (\<lambda>_. dummy_term)"
+
+lemma (in term_syntax) term_of_num_ring_code [code]:
+ "term_of_num_ring two k = (if k = 0 then termify Int.Pls
+ else if k = -1 then termify Int.Min
+ else if k mod two = 0 then termify Int.Bit0 <\<cdot>> term_of_num_ring two (k div two)
+ else termify Int.Bit1 <\<cdot>> term_of_num_ring two (k div two))"
+ by (auto simp add: term_of_anything Const_def App_def term_of_num_ring_def Let_def)
+
lemma (in term_syntax) term_of_int_code [code]:
"term_of (k::int) = (if k = 0 then termify (0 :: int)
- else if k > 0 then termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) k
- else termify (uminus :: int \<Rightarrow> int) <\<cdot>> (termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num (2::int) (- k)))"
- by (simp only: term_of_anything)
-
-lemma (in term_syntax) term_of_code_numeral_code [code]:
- "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num (2::code_numeral) k"
+ else termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num_ring (2::int) k)"
by (simp only: term_of_anything)
@@ -188,6 +197,6 @@
hide_const dummy_term valapp
-hide_const (open) Const App Abs termify valtermify term_of term_of_num tracing
+hide_const (open) Const App Abs termify valtermify term_of term_of_num_semiring term_of_num_ring tracing
end
--- a/src/HOL/Complete_Lattice.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Complete_Lattice.thy Thu Dec 02 11:18:44 2010 -0800
@@ -172,6 +172,18 @@
"(\<And>m. m \<in> B \<Longrightarrow> \<exists>n\<in>A. f n \<le> g m) \<Longrightarrow> (INF n:A. f n) \<le> (INF n:B. g n)"
by (force intro!: Inf_mono simp: INFI_def)
+lemma SUP_subset: "A \<subseteq> B \<Longrightarrow> SUPR A f \<le> SUPR B f"
+ by (intro SUP_mono) auto
+
+lemma INF_subset: "A \<subseteq> B \<Longrightarrow> INFI B f \<le> INFI A f"
+ by (intro INF_mono) auto
+
+lemma SUP_commute: "(SUP i:A. SUP j:B. f i j) = (SUP j:B. SUP i:A. f i j)"
+ by (iprover intro: SUP_leI le_SUPI order_trans antisym)
+
+lemma INF_commute: "(INF i:A. INF j:B. f i j) = (INF j:B. INF i:A. f i j)"
+ by (iprover intro: INF_leI le_INFI order_trans antisym)
+
end
lemma less_Sup_iff:
@@ -184,6 +196,16 @@
shows "Inf S < a \<longleftrightarrow> (\<exists>x\<in>S. x < a)"
unfolding not_le[symmetric] le_Inf_iff by auto
+lemma less_SUP_iff:
+ fixes a :: "'a::{complete_lattice,linorder}"
+ shows "a < (SUP i:A. f i) \<longleftrightarrow> (\<exists>x\<in>A. a < f x)"
+ unfolding SUPR_def less_Sup_iff by auto
+
+lemma INF_less_iff:
+ fixes a :: "'a::{complete_lattice,linorder}"
+ shows "(INF i:A. f i) < a \<longleftrightarrow> (\<exists>x\<in>A. f x < a)"
+ unfolding INFI_def Inf_less_iff by auto
+
subsection {* @{typ bool} and @{typ "_ \<Rightarrow> _"} as complete lattice *}
instantiation bool :: complete_lattice
--- a/src/HOL/Complex_Main.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Complex_Main.thy Thu Dec 02 11:18:44 2010 -0800
@@ -10,9 +10,6 @@
Ln
Taylor
Deriv
-uses "~~/src/Tools/subtyping.ML"
begin
-setup Subtyping.setup
-
end
--- a/src/HOL/Decision_Procs/Approximation.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Decision_Procs/Approximation.thy Thu Dec 02 11:18:44 2010 -0800
@@ -1,18 +1,26 @@
-(* Author: Johannes Hoelzl <hoelzl@in.tum.de> 2008 / 2009 *)
+(* Author: Johannes Hoelzl, TU Muenchen
+ Coercions removed by Dmitriy Traytel *)
header {* Prove Real Valued Inequalities by Computation *}
-theory Approximation
-imports Complex_Main Float Reflection Dense_Linear_Order Efficient_Nat
+theory Approximation_coercion
+imports Complex_Main Float Reflection "~~/src/HOL/Decision_Procs/Dense_Linear_Order" Efficient_Nat
begin
+declare [[coercion_map map]]
+declare [[coercion_map "% f g h . g o h o f"]]
+declare [[coercion_map "% f g (x,y) . (f x, g y)"]]
+declare [[coercion int]]
+declare [[coercion "% x . Float x 0"]]
+declare [[coercion "real::float\<Rightarrow>real"]]
+
section "Horner Scheme"
subsection {* Define auxiliary helper @{text horner} function *}
primrec horner :: "(nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow> nat \<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> real \<Rightarrow> real" where
"horner F G 0 i k x = 0" |
-"horner F G (Suc n) i k x = 1 / real k - x * horner F G n (F i) (G i k) x"
+"horner F G (Suc n) i k x = 1 / k - x * horner F G n (F i) (G i k) x"
lemma horner_schema': fixes x :: real and a :: "nat \<Rightarrow> real"
shows "a 0 - x * (\<Sum> i=0..<n. (-1)^i * a (Suc i) * x^i) = (\<Sum> i=0..<Suc n. (-1)^i * a i * x^i)"
@@ -24,22 +32,23 @@
lemma horner_schema: fixes f :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat" and F :: "nat \<Rightarrow> nat"
assumes f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
- shows "horner F G n ((F ^^ j') s) (f j') x = (\<Sum> j = 0..< n. -1 ^ j * (1 / real (f (j' + j))) * x ^ j)"
+ shows "horner F G n ((F ^^ j') s) (f j') x = (\<Sum> j = 0..< n. -1 ^ j * (1 / (f (j' + j))) * x ^ j)"
proof (induct n arbitrary: i k j')
case (Suc n)
show ?case unfolding horner.simps Suc[where j'="Suc j'", unfolded funpow.simps comp_def f_Suc]
- using horner_schema'[of "\<lambda> j. 1 / real (f (j' + j))"] by auto
+ using horner_schema'[of "\<lambda> j. 1 / (f (j' + j))"] by auto
qed auto
lemma horner_bounds':
+ fixes lb :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> float \<Rightarrow> float" and ub :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> float \<Rightarrow> float"
assumes "0 \<le> real x" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
and lb_0: "\<And> i k x. lb 0 i k x = 0"
- and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 (int k) - x * (ub n (F i) (G i k) x)"
+ and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 k - x * (ub n (F i) (G i k) x)"
and ub_0: "\<And> i k x. ub 0 i k x = 0"
- and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 (int k) - x * (lb n (F i) (G i k) x)"
- shows "real (lb n ((F ^^ j') s) (f j') x) \<le> horner F G n ((F ^^ j') s) (f j') (real x) \<and>
- horner F G n ((F ^^ j') s) (f j') (real x) \<le> real (ub n ((F ^^ j') s) (f j') x)"
+ and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 k - x * (lb n (F i) (G i k) x)"
+ shows "(lb n ((F ^^ j') s) (f j') x) \<le> horner F G n ((F ^^ j') s) (f j') x \<and>
+ horner F G n ((F ^^ j') s) (f j') x \<le> (ub n ((F ^^ j') s) (f j') x)"
(is "?lb n j' \<le> ?horner n j' \<and> ?horner n j' \<le> ?ub n j'")
proof (induct n arbitrary: j')
case 0 thus ?case unfolding lb_0 ub_0 horner.simps by auto
@@ -47,16 +56,17 @@
case (Suc n)
have "?lb (Suc n) j' \<le> ?horner (Suc n) j'" unfolding lb_Suc ub_Suc horner.simps real_of_float_sub diff_minus
proof (rule add_mono)
- show "real (lapprox_rat prec 1 (int (f j'))) \<le> 1 / real (f j')" using lapprox_rat[of prec 1 "int (f j')"] by auto
+ show "(lapprox_rat prec 1 (f j')) \<le> 1 / (f j')" using lapprox_rat[of prec 1 "f j'"] by auto
from Suc[where j'="Suc j'", unfolded funpow.simps comp_def f_Suc, THEN conjunct2] `0 \<le> real x`
- show "- real (x * ub n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x) \<le> - (real x * horner F G n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) (real x))"
+ show "- real (x * ub n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x) \<le>
+ - (x * horner F G n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x)"
unfolding real_of_float_mult neg_le_iff_le by (rule mult_left_mono)
qed
moreover have "?horner (Suc n) j' \<le> ?ub (Suc n) j'" unfolding ub_Suc ub_Suc horner.simps real_of_float_sub diff_minus
proof (rule add_mono)
- show "1 / real (f j') \<le> real (rapprox_rat prec 1 (int (f j')))" using rapprox_rat[of 1 "int (f j')" prec] by auto
+ show "1 / (f j') \<le> (rapprox_rat prec 1 (f j'))" using rapprox_rat[of 1 "f j'" prec] by auto
from Suc[where j'="Suc j'", unfolded funpow.simps comp_def f_Suc, THEN conjunct1] `0 \<le> real x`
- show "- (real x * horner F G n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) (real x)) \<le>
+ show "- (x * horner F G n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x) \<le>
- real (x * lb n (F ((F ^^ j') s)) (G ((F ^^ j') s) (f j')) x)"
unfolding real_of_float_mult neg_le_iff_le by (rule mult_left_mono)
qed
@@ -75,11 +85,11 @@
lemma horner_bounds: fixes F :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat"
assumes "0 \<le> real x" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
and lb_0: "\<And> i k x. lb 0 i k x = 0"
- and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 (int k) - x * (ub n (F i) (G i k) x)"
+ and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 k - x * (ub n (F i) (G i k) x)"
and ub_0: "\<And> i k x. ub 0 i k x = 0"
- and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 (int k) - x * (lb n (F i) (G i k) x)"
- shows "real (lb n ((F ^^ j') s) (f j') x) \<le> (\<Sum>j=0..<n. -1 ^ j * (1 / real (f (j' + j))) * real x ^ j)" (is "?lb") and
- "(\<Sum>j=0..<n. -1 ^ j * (1 / real (f (j' + j))) * (real x ^ j)) \<le> real (ub n ((F ^^ j') s) (f j') x)" (is "?ub")
+ and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 k - x * (lb n (F i) (G i k) x)"
+ shows "(lb n ((F ^^ j') s) (f j') x) \<le> (\<Sum>j=0..<n. -1 ^ j * (1 / (f (j' + j))) * (x ^ j))" (is "?lb") and
+ "(\<Sum>j=0..<n. -1 ^ j * (1 / (f (j' + j))) * (x ^ j)) \<le> (ub n ((F ^^ j') s) (f j') x)" (is "?ub")
proof -
have "?lb \<and> ?ub"
using horner_bounds'[where lb=lb, OF `0 \<le> real x` f_Suc lb_0 lb_Suc ub_0 ub_Suc]
@@ -90,11 +100,11 @@
lemma horner_bounds_nonpos: fixes F :: "nat \<Rightarrow> nat" and G :: "nat \<Rightarrow> nat \<Rightarrow> nat"
assumes "real x \<le> 0" and f_Suc: "\<And>n. f (Suc n) = G ((F ^^ n) s) (f n)"
and lb_0: "\<And> i k x. lb 0 i k x = 0"
- and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 (int k) + x * (ub n (F i) (G i k) x)"
+ and lb_Suc: "\<And> n i k x. lb (Suc n) i k x = lapprox_rat prec 1 k + x * (ub n (F i) (G i k) x)"
and ub_0: "\<And> i k x. ub 0 i k x = 0"
- and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 (int k) + x * (lb n (F i) (G i k) x)"
- shows "real (lb n ((F ^^ j') s) (f j') x) \<le> (\<Sum>j=0..<n. (1 / real (f (j' + j))) * real x ^ j)" (is "?lb") and
- "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * (real x ^ j)) \<le> real (ub n ((F ^^ j') s) (f j') x)" (is "?ub")
+ and ub_Suc: "\<And> n i k x. ub (Suc n) i k x = rapprox_rat prec 1 k + x * (lb n (F i) (G i k) x)"
+ shows "(lb n ((F ^^ j') s) (f j') x) \<le> (\<Sum>j=0..<n. (1 / (f (j' + j))) * real x ^ j)" (is "?lb") and
+ "(\<Sum>j=0..<n. (1 / (f (j' + j))) * real x ^ j) \<le> (ub n ((F ^^ j') s) (f j') x)" (is "?ub")
proof -
{ fix x y z :: float have "x - y * z = x + - y * z"
by (cases x, cases y, cases z, simp add: plus_float.simps minus_float_def uminus_float.simps times_float.simps algebra_simps)
@@ -102,13 +112,13 @@
{ fix x :: float have "- (- x) = x" by (cases x, auto simp add: uminus_float.simps) } note minus_minus = this
- have move_minus: "real (-x) = -1 * real x" by auto
-
- have sum_eq: "(\<Sum>j=0..<n. (1 / real (f (j' + j))) * real x ^ j) =
- (\<Sum>j = 0..<n. -1 ^ j * (1 / real (f (j' + j))) * real (- x) ^ j)"
+ have move_minus: "(-x) = -1 * real x" by auto (* coercion "inside" is necessary *)
+
+ have sum_eq: "(\<Sum>j=0..<n. (1 / (f (j' + j))) * real x ^ j) =
+ (\<Sum>j = 0..<n. -1 ^ j * (1 / (f (j' + j))) * real (- x) ^ j)"
proof (rule setsum_cong, simp)
fix j assume "j \<in> {0 ..< n}"
- show "1 / real (f (j' + j)) * real x ^ j = -1 ^ j * (1 / real (f (j' + j))) * real (- x) ^ j"
+ show "1 / (f (j' + j)) * real x ^ j = -1 ^ j * (1 / (f (j' + j))) * real (- x) ^ j"
unfolding move_minus power_mult_distrib mult_assoc[symmetric]
unfolding mult_commute unfolding mult_assoc[of "-1 ^ j", symmetric] power_mult_distrib[symmetric]
by auto
@@ -159,15 +169,16 @@
else if u < 0 then (u ^ n, l ^ n)
else (0, (max (-l) u) ^ n))"
-lemma float_power_bnds: assumes "(l1, u1) = float_power_bnds n l u" and "x \<in> {real l .. real u}"
- shows "x ^ n \<in> {real l1..real u1}"
+lemma float_power_bnds: fixes x :: real
+ assumes "(l1, u1) = float_power_bnds n l u" and "x \<in> {l .. u}"
+ shows "x ^ n \<in> {l1..u1}"
proof (cases "even n")
case True
show ?thesis
proof (cases "0 < l")
case True hence "odd n \<or> 0 < l" and "0 \<le> real l" unfolding less_float_def by auto
have u1: "u1 = u ^ n" and l1: "l1 = l ^ n" using assms unfolding float_power_bnds_def if_P[OF `odd n \<or> 0 < l`] by auto
- have "real l ^ n \<le> x ^ n" and "x ^ n \<le> real u ^ n " using `0 \<le> real l` and assms unfolding atLeastAtMost_iff using power_mono[of "real l" x] power_mono[of x "real u"] by auto
+ have "real l ^ n \<le> x ^ n" and "x ^ n \<le> real u ^ n " using `0 \<le> real l` and assms unfolding atLeastAtMost_iff using power_mono[of l x] power_mono[of x u] by auto
thus ?thesis using assms `0 < l` unfolding atLeastAtMost_iff l1 u1 float_power less_float_def by auto
next
case False hence P: "\<not> (odd n \<or> 0 < l)" using `even n` by auto
@@ -198,7 +209,7 @@
thus ?thesis unfolding atLeastAtMost_iff l1 u1 float_power less_float_def by auto
qed
-lemma bnds_power: "\<forall> x l u. (l1, u1) = float_power_bnds n l u \<and> x \<in> {real l .. real u} \<longrightarrow> real l1 \<le> x ^ n \<and> x ^ n \<le> real u1"
+lemma bnds_power: "\<forall> (x::real) l u. (l1, u1) = float_power_bnds n l u \<and> x \<in> {l .. u} \<longrightarrow> l1 \<le> x ^ n \<and> x ^ n \<le> u1"
using float_power_bnds by auto
section "Square root"
@@ -242,25 +253,25 @@
qed
lemma sqrt_iteration_bound: assumes "0 < real x"
- shows "sqrt (real x) < real (sqrt_iteration prec n x)"
+ shows "sqrt x < (sqrt_iteration prec n x)"
proof (induct n)
case 0
show ?case
proof (cases x)
case (Float m e)
hence "0 < m" using float_pos_m_pos[unfolded less_float_def] assms by auto
- hence "0 < sqrt (real m)" by auto
-
- have int_nat_bl: "int (nat (bitlen m)) = bitlen m" using bitlen_ge0 by auto
-
- have "real x = (real m / 2^nat (bitlen m)) * pow2 (e + int (nat (bitlen m)))"
+ hence "0 < sqrt m" by auto
+
+ have int_nat_bl: "(nat (bitlen m)) = bitlen m" using bitlen_ge0 by auto
+
+ have "x = (m / 2^nat (bitlen m)) * pow2 (e + (nat (bitlen m)))"
unfolding pow2_add pow2_int Float real_of_float_simp by auto
- also have "\<dots> < 1 * pow2 (e + int (nat (bitlen m)))"
+ also have "\<dots> < 1 * pow2 (e + nat (bitlen m))"
proof (rule mult_strict_right_mono, auto)
show "real m < 2^nat (bitlen m)" using bitlen_bounds[OF `0 < m`, THEN conjunct2]
unfolding real_of_int_less_iff[of m, symmetric] by auto
qed
- finally have "sqrt (real x) < sqrt (pow2 (e + bitlen m))" unfolding int_nat_bl by auto
+ finally have "sqrt x < sqrt (pow2 (e + bitlen m))" unfolding int_nat_bl by auto
also have "\<dots> \<le> pow2 ((e + bitlen m) div 2 + 1)"
proof -
let ?E = "e + bitlen m"
@@ -295,18 +306,18 @@
next
case (Suc n)
let ?b = "sqrt_iteration prec n x"
- have "0 < sqrt (real x)" using `0 < real x` by auto
+ have "0 < sqrt x" using `0 < real x` by auto
also have "\<dots> < real ?b" using Suc .
- finally have "sqrt (real x) < (real ?b + real x / real ?b)/2" using sqrt_ub_pos_pos_1[OF Suc _ `0 < real x`] by auto
- also have "\<dots> \<le> (real ?b + real (float_divr prec x ?b))/2" by (rule divide_right_mono, auto simp add: float_divr)
- also have "\<dots> = real (Float 1 -1) * (real ?b + real (float_divr prec x ?b))" by auto
+ finally have "sqrt x < (?b + x / ?b)/2" using sqrt_ub_pos_pos_1[OF Suc _ `0 < real x`] by auto
+ also have "\<dots> \<le> (?b + (float_divr prec x ?b))/2" by (rule divide_right_mono, auto simp add: float_divr)
+ also have "\<dots> = (Float 1 -1) * (?b + (float_divr prec x ?b))" by auto
finally show ?case unfolding sqrt_iteration.simps Let_def real_of_float_mult real_of_float_add right_distrib .
qed
lemma sqrt_iteration_lower_bound: assumes "0 < real x"
shows "0 < real (sqrt_iteration prec n x)" (is "0 < ?sqrt")
proof -
- have "0 < sqrt (real x)" using assms by auto
+ have "0 < sqrt x" using assms by auto
also have "\<dots> < ?sqrt" using sqrt_iteration_bound[OF assms] .
finally show ?thesis .
qed
@@ -324,31 +335,31 @@
qed
lemma bnds_sqrt':
- shows "sqrt (real x) \<in> { real (lb_sqrt prec x) .. real (ub_sqrt prec x) }"
+ shows "sqrt x \<in> {(lb_sqrt prec x) .. (ub_sqrt prec x) }"
proof -
{ fix x :: float assume "0 < x"
hence "0 < real x" and "0 \<le> real x" unfolding less_float_def by auto
- hence sqrt_gt0: "0 < sqrt (real x)" by auto
- hence sqrt_ub: "sqrt (real x) < real (sqrt_iteration prec prec x)" using sqrt_iteration_bound by auto
-
- have "real (float_divl prec x (sqrt_iteration prec prec x)) \<le>
- real x / real (sqrt_iteration prec prec x)" by (rule float_divl)
- also have "\<dots> < real x / sqrt (real x)"
+ hence sqrt_gt0: "0 < sqrt x" by auto
+ hence sqrt_ub: "sqrt x < sqrt_iteration prec prec x" using sqrt_iteration_bound by auto
+
+ have "(float_divl prec x (sqrt_iteration prec prec x)) \<le>
+ x / (sqrt_iteration prec prec x)" by (rule float_divl)
+ also have "\<dots> < x / sqrt x"
by (rule divide_strict_left_mono[OF sqrt_ub `0 < real x`
mult_pos_pos[OF order_less_trans[OF sqrt_gt0 sqrt_ub] sqrt_gt0]])
- also have "\<dots> = sqrt (real x)"
- unfolding inverse_eq_iff_eq[of _ "sqrt (real x)", symmetric]
+ also have "\<dots> = sqrt x"
+ unfolding inverse_eq_iff_eq[of _ "sqrt x", symmetric]
sqrt_divide_self_eq[OF `0 \<le> real x`, symmetric] by auto
- finally have "real (lb_sqrt prec x) \<le> sqrt (real x)"
+ finally have "lb_sqrt prec x \<le> sqrt x"
unfolding lb_sqrt.simps if_P[OF `0 < x`] by auto }
note lb = this
{ fix x :: float assume "0 < x"
hence "0 < real x" unfolding less_float_def by auto
- hence "0 < sqrt (real x)" by auto
- hence "sqrt (real x) < real (sqrt_iteration prec prec x)"
+ hence "0 < sqrt x" by auto
+ hence "sqrt x < sqrt_iteration prec prec x"
using sqrt_iteration_bound by auto
- hence "sqrt (real x) \<le> real (ub_sqrt prec x)"
+ hence "sqrt x \<le> ub_sqrt prec x"
unfolding ub_sqrt.simps if_P[OF `0 < x`] by auto }
note ub = this
@@ -369,20 +380,20 @@
qed qed
qed
-lemma bnds_sqrt: "\<forall> x lx ux. (l, u) = (lb_sqrt prec lx, ub_sqrt prec ux) \<and> x \<in> {real lx .. real ux} \<longrightarrow> real l \<le> sqrt x \<and> sqrt x \<le> real u"
+lemma bnds_sqrt: "\<forall> (x::real) lx ux. (l, u) = (lb_sqrt prec lx, ub_sqrt prec ux) \<and> x \<in> {lx .. ux} \<longrightarrow> l \<le> sqrt x \<and> sqrt x \<le> u"
proof ((rule allI) +, rule impI, erule conjE, rule conjI)
- fix x lx ux
+ fix x :: real fix lx ux
assume "(l, u) = (lb_sqrt prec lx, ub_sqrt prec ux)"
- and x: "x \<in> {real lx .. real ux}"
+ and x: "x \<in> {lx .. ux}"
hence l: "l = lb_sqrt prec lx " and u: "u = ub_sqrt prec ux" by auto
- have "sqrt (real lx) \<le> sqrt x" using x by auto
+ have "sqrt lx \<le> sqrt x" using x by auto
from order_trans[OF _ this]
- show "real l \<le> sqrt x" unfolding l using bnds_sqrt'[of lx prec] by auto
-
- have "sqrt x \<le> sqrt (real ux)" using x by auto
+ show "l \<le> sqrt x" unfolding l using bnds_sqrt'[of lx prec] by auto
+
+ have "sqrt x \<le> sqrt ux" using x by auto
from order_trans[OF this]
- show "sqrt x \<le> real u" unfolding u using bnds_sqrt'[of ux prec] by auto
+ show "sqrt x \<le> u" unfolding u using bnds_sqrt'[of ux prec] by auto
qed
section "Arcus tangens and \<pi>"
@@ -400,25 +411,25 @@
and lb_arctan_horner :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> float \<Rightarrow> float" where
"ub_arctan_horner prec 0 k x = 0"
| "ub_arctan_horner prec (Suc n) k x =
- (rapprox_rat prec 1 (int k)) - x * (lb_arctan_horner prec n (k + 2) x)"
+ (rapprox_rat prec 1 k) - x * (lb_arctan_horner prec n (k + 2) x)"
| "lb_arctan_horner prec 0 k x = 0"
| "lb_arctan_horner prec (Suc n) k x =
- (lapprox_rat prec 1 (int k)) - x * (ub_arctan_horner prec n (k + 2) x)"
+ (lapprox_rat prec 1 k) - x * (ub_arctan_horner prec n (k + 2) x)"
lemma arctan_0_1_bounds': assumes "0 \<le> real x" "real x \<le> 1" and "even n"
- shows "arctan (real x) \<in> {real (x * lb_arctan_horner prec n 1 (x * x)) .. real (x * ub_arctan_horner prec (Suc n) 1 (x * x))}"
+ shows "arctan x \<in> {(x * lb_arctan_horner prec n 1 (x * x)) .. (x * ub_arctan_horner prec (Suc n) 1 (x * x))}"
proof -
- let "?c i" = "-1^i * (1 / real (i * 2 + 1) * real x ^ (i * 2 + 1))"
+ let "?c i" = "-1^i * (1 / (i * 2 + (1::nat)) * real x ^ (i * 2 + 1))"
let "?S n" = "\<Sum> i=0..<n. ?c i"
have "0 \<le> real (x * x)" by auto
from `even n` obtain m where "2 * m = n" unfolding even_mult_two_ex by auto
- have "arctan (real x) \<in> { ?S n .. ?S (Suc n) }"
+ have "arctan x \<in> { ?S n .. ?S (Suc n) }"
proof (cases "real x = 0")
case False
hence "0 < real x" using `0 \<le> real x` by auto
- hence prem: "0 < 1 / real (0 * 2 + (1::nat)) * real x ^ (0 * 2 + 1)" by auto
+ hence prem: "0 < 1 / (0 * 2 + (1::nat)) * real x ^ (0 * 2 + 1)" by auto
have "\<bar> real x \<bar> \<le> 1" using `0 \<le> real x` `real x \<le> 1` by auto
from mp[OF summable_Leibniz(2)[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]] prem, THEN spec, of m, unfolded `2 * m = n`]
@@ -433,34 +444,34 @@
and ub="\<lambda>n i k x. ub_arctan_horner prec n k x",
OF `0 \<le> real (x*x)` F lb_arctan_horner.simps ub_arctan_horner.simps]
- { have "real (x * lb_arctan_horner prec n 1 (x*x)) \<le> ?S n"
+ { have "(x * lb_arctan_horner prec n 1 (x*x)) \<le> ?S n"
using bounds(1) `0 \<le> real x`
unfolding real_of_float_mult power_add power_one_right mult_assoc[symmetric] setsum_left_distrib[symmetric]
unfolding mult_commute[where 'a=real] mult_commute[of _ "2::nat"] power_mult power2_eq_square[of "real x"]
by (auto intro!: mult_left_mono)
- also have "\<dots> \<le> arctan (real x)" using arctan_bounds ..
- finally have "real (x * lb_arctan_horner prec n 1 (x*x)) \<le> arctan (real x)" . }
+ also have "\<dots> \<le> arctan x" using arctan_bounds ..
+ finally have "(x * lb_arctan_horner prec n 1 (x*x)) \<le> arctan x" . }
moreover
- { have "arctan (real x) \<le> ?S (Suc n)" using arctan_bounds ..
- also have "\<dots> \<le> real (x * ub_arctan_horner prec (Suc n) 1 (x*x))"
+ { have "arctan x \<le> ?S (Suc n)" using arctan_bounds ..
+ also have "\<dots> \<le> (x * ub_arctan_horner prec (Suc n) 1 (x*x))"
using bounds(2)[of "Suc n"] `0 \<le> real x`
unfolding real_of_float_mult power_add power_one_right mult_assoc[symmetric] setsum_left_distrib[symmetric]
unfolding mult_commute[where 'a=real] mult_commute[of _ "2::nat"] power_mult power2_eq_square[of "real x"]
by (auto intro!: mult_left_mono)
- finally have "arctan (real x) \<le> real (x * ub_arctan_horner prec (Suc n) 1 (x*x))" . }
+ finally have "arctan x \<le> (x * ub_arctan_horner prec (Suc n) 1 (x*x))" . }
ultimately show ?thesis by auto
qed
lemma arctan_0_1_bounds: assumes "0 \<le> real x" "real x \<le> 1"
- shows "arctan (real x) \<in> {real (x * lb_arctan_horner prec (get_even n) 1 (x * x)) .. real (x * ub_arctan_horner prec (get_odd n) 1 (x * x))}"
+ shows "arctan x \<in> {(x * lb_arctan_horner prec (get_even n) 1 (x * x)) .. (x * ub_arctan_horner prec (get_odd n) 1 (x * x))}"
proof (cases "even n")
case True
obtain n' where "Suc n' = get_odd n" and "odd (Suc n')" using get_odd_ex by auto
hence "even n'" unfolding even_Suc by auto
- have "arctan (real x) \<le> real (x * ub_arctan_horner prec (get_odd n) 1 (x * x))"
+ have "arctan x \<le> x * ub_arctan_horner prec (get_odd n) 1 (x * x)"
unfolding `Suc n' = get_odd n`[symmetric] using arctan_0_1_bounds'[OF `0 \<le> real x` `real x \<le> 1` `even n'`] by auto
moreover
- have "real (x * lb_arctan_horner prec (get_even n) 1 (x * x)) \<le> arctan (real x)"
+ have "x * lb_arctan_horner prec (get_even n) 1 (x * x) \<le> arctan x"
unfolding get_even_def if_P[OF True] using arctan_0_1_bounds'[OF `0 \<le> real x` `real x \<le> 1` `even n`] by auto
ultimately show ?thesis by auto
next
@@ -470,10 +481,10 @@
have "even n'" and "even (Suc (Suc n'))" by auto
have "get_odd n = Suc n'" unfolding get_odd_def if_P[OF False] using `n = Suc n'` .
- have "arctan (real x) \<le> real (x * ub_arctan_horner prec (get_odd n) 1 (x * x))"
+ have "arctan x \<le> x * ub_arctan_horner prec (get_odd n) 1 (x * x)"
unfolding `get_odd n = Suc n'` using arctan_0_1_bounds'[OF `0 \<le> real x` `real x \<le> 1` `even n'`] by auto
moreover
- have "real (x * lb_arctan_horner prec (get_even n) 1 (x * x)) \<le> arctan (real x)"
+ have "(x * lb_arctan_horner prec (get_even n) 1 (x * x)) \<le> arctan x"
unfolding get_even_def if_not_P[OF False] unfolding `n = Suc n'` using arctan_0_1_bounds'[OF `0 \<le> real x` `real x \<le> 1` `even (Suc (Suc n'))`] by auto
ultimately show ?thesis by auto
qed
@@ -492,7 +503,7 @@
in ((Float 1 2) * ((Float 1 2) * A * (lb_arctan_horner prec (get_even (prec div 4 + 1)) 1 (A * A)) -
B * (ub_arctan_horner prec (get_odd (prec div 14 + 1)) 1 (B * B)))))"
-lemma pi_boundaries: "pi \<in> {real (lb_pi n) .. real (ub_pi n)}"
+lemma pi_boundaries: "pi \<in> {(lb_pi n) .. (ub_pi n)}"
proof -
have machin_pi: "pi = 4 * (4 * arctan (1 / 5) - arctan (1 / 239))" unfolding machin[symmetric] by auto
@@ -504,35 +515,35 @@
have "real ?k \<le> 1" unfolding rapprox_rat.simps(2)[OF zero_le_one `0 < k`]
by (rule rapprox_posrat_le1, auto simp add: `0 < k` `1 \<le> k`)
- have "1 / real k \<le> real ?k" using rapprox_rat[where x=1 and y=k] by auto
- hence "arctan (1 / real k) \<le> arctan (real ?k)" by (rule arctan_monotone')
- also have "\<dots> \<le> real (?k * ub_arctan_horner prec (get_odd n) 1 (?k * ?k))"
+ have "1 / k \<le> ?k" using rapprox_rat[where x=1 and y=k] by auto
+ hence "arctan (1 / k) \<le> arctan ?k" by (rule arctan_monotone')
+ also have "\<dots> \<le> (?k * ub_arctan_horner prec (get_odd n) 1 (?k * ?k))"
using arctan_0_1_bounds[OF `0 \<le> real ?k` `real ?k \<le> 1`] by auto
- finally have "arctan (1 / (real k)) \<le> real (?k * ub_arctan_horner prec (get_odd n) 1 (?k * ?k))" .
+ finally have "arctan (1 / k) \<le> ?k * ub_arctan_horner prec (get_odd n) 1 (?k * ?k)" .
} note ub_arctan = this
{ fix prec n :: nat fix k :: int assume "1 < k" hence "0 \<le> k" and "0 < k" by auto
let ?k = "lapprox_rat prec 1 k"
have "1 div k = 0" using div_pos_pos_trivial[OF _ `1 < k`] by auto
- have "1 / real k \<le> 1" using `1 < k` by auto
+ have "1 / k \<le> 1" using `1 < k` by auto
have "\<And>n. 0 \<le> real ?k" using lapprox_rat_bottom[where x=1 and y=k, OF zero_le_one `0 < k`] by (auto simp add: `1 div k = 0`)
- have "\<And>n. real ?k \<le> 1" using lapprox_rat by (rule order_trans, auto simp add: `1 / real k \<le> 1`)
-
- have "real ?k \<le> 1 / real k" using lapprox_rat[where x=1 and y=k] by auto
-
- have "real (?k * lb_arctan_horner prec (get_even n) 1 (?k * ?k)) \<le> arctan (real ?k)"
+ have "\<And>n. real ?k \<le> 1" using lapprox_rat by (rule order_trans, auto simp add: `1 / k \<le> 1`)
+
+ have "?k \<le> 1 / k" using lapprox_rat[where x=1 and y=k] by auto
+
+ have "?k * lb_arctan_horner prec (get_even n) 1 (?k * ?k) \<le> arctan ?k"
using arctan_0_1_bounds[OF `0 \<le> real ?k` `real ?k \<le> 1`] by auto
- also have "\<dots> \<le> arctan (1 / real k)" using `real ?k \<le> 1 / real k` by (rule arctan_monotone')
- finally have "real (?k * lb_arctan_horner prec (get_even n) 1 (?k * ?k)) \<le> arctan (1 / (real k))" .
+ also have "\<dots> \<le> arctan (1 / k)" using `?k \<le> 1 / k` by (rule arctan_monotone')
+ finally have "?k * lb_arctan_horner prec (get_even n) 1 (?k * ?k) \<le> arctan (1 / k)" .
} note lb_arctan = this
- have "pi \<le> real (ub_pi n)"
+ have "pi \<le> ub_pi n"
unfolding ub_pi_def machin_pi Let_def real_of_float_mult real_of_float_sub unfolding Float_num
using lb_arctan[of 239] ub_arctan[of 5]
by (auto intro!: mult_left_mono add_mono simp add: diff_minus simp del: lapprox_rat.simps rapprox_rat.simps)
moreover
- have "real (lb_pi n) \<le> pi"
+ have "lb_pi n \<le> pi"
unfolding lb_pi_def machin_pi Let_def real_of_float_mult real_of_float_sub Float_num
using lb_arctan[of 5] ub_arctan[of 239]
by (auto intro!: mult_left_mono add_mono simp add: diff_minus simp del: lapprox_rat.simps rapprox_rat.simps)
@@ -566,7 +577,7 @@
declare lb_arctan_horner.simps[simp del]
lemma lb_arctan_bound': assumes "0 \<le> real x"
- shows "real (lb_arctan prec x) \<le> arctan (real x)"
+ shows "lb_arctan prec x \<le> arctan x"
proof -
have "\<not> x < 0" and "0 \<le> x" unfolding less_float_def le_float_def using `0 \<le> real x` by auto
let "?ub_horner x" = "x * ub_arctan_horner prec (get_odd (prec div 4 + 1)) 1 (x * x)"
@@ -586,16 +597,16 @@
have sqr_ge0: "0 \<le> 1 + real x * real x" using sum_power2_ge_zero[of 1 "real x", unfolded numeral_2_eq_2] by auto
hence divisor_gt0: "0 < ?R" by (auto intro: add_pos_nonneg)
- have "sqrt (real (1 + x * x)) \<le> real (ub_sqrt prec (1 + x * x))"
+ have "sqrt (1 + x * x) \<le> ub_sqrt prec (1 + x * x)"
using bnds_sqrt'[of "1 + x * x"] by auto
- hence "?R \<le> real ?fR" by auto
+ hence "?R \<le> ?fR" by auto
hence "0 < ?fR" and "0 < real ?fR" unfolding less_float_def using `0 < ?R` by auto
- have monotone: "real (float_divl prec x ?fR) \<le> real x / ?R"
+ have monotone: "(float_divl prec x ?fR) \<le> x / ?R"
proof -
- have "real ?DIV \<le> real x / real ?fR" by (rule float_divl)
- also have "\<dots> \<le> real x / ?R" by (rule divide_left_mono[OF `?R \<le> real ?fR` `0 \<le> real x` mult_pos_pos[OF order_less_le_trans[OF divisor_gt0 `?R \<le> real ?fR`] divisor_gt0]])
+ have "?DIV \<le> real x / ?fR" by (rule float_divl)
+ also have "\<dots> \<le> x / ?R" by (rule divide_left_mono[OF `?R \<le> ?fR` `0 \<le> real x` mult_pos_pos[OF order_less_le_trans[OF divisor_gt0 `?R \<le> real ?fR`] divisor_gt0]])
finally show ?thesis .
qed
@@ -603,20 +614,20 @@
proof (cases "x \<le> Float 1 1")
case True
- have "real x \<le> sqrt (real (1 + x * x))" using real_sqrt_sum_squares_ge2[where x=1, unfolded numeral_2_eq_2] by auto
- also have "\<dots> \<le> real (ub_sqrt prec (1 + x * x))"
+ have "x \<le> sqrt (1 + x * x)" using real_sqrt_sum_squares_ge2[where x=1, unfolded numeral_2_eq_2] by auto
+ also have "\<dots> \<le> (ub_sqrt prec (1 + x * x))"
using bnds_sqrt'[of "1 + x * x"] by auto
- finally have "real x \<le> real ?fR" by auto
- moreover have "real ?DIV \<le> real x / real ?fR" by (rule float_divl)
+ finally have "real x \<le> ?fR" by auto
+ moreover have "?DIV \<le> real x / ?fR" by (rule float_divl)
ultimately have "real ?DIV \<le> 1" unfolding divide_le_eq_1_pos[OF `0 < real ?fR`, symmetric] by auto
have "0 \<le> real ?DIV" using float_divl_lower_bound[OF `0 \<le> x` `0 < ?fR`] unfolding le_float_def by auto
- have "real (Float 1 1 * ?lb_horner ?DIV) \<le> 2 * arctan (real (float_divl prec x ?fR))" unfolding real_of_float_mult[of "Float 1 1"] Float_num
+ have "(Float 1 1 * ?lb_horner ?DIV) \<le> 2 * arctan (float_divl prec x ?fR)" unfolding real_of_float_mult[of "Float 1 1"] Float_num
using arctan_0_1_bounds[OF `0 \<le> real ?DIV` `real ?DIV \<le> 1`] by auto
- also have "\<dots> \<le> 2 * arctan (real x / ?R)"
+ also have "\<dots> \<le> 2 * arctan (x / ?R)"
using arctan_monotone'[OF monotone] by (auto intro!: mult_left_mono)
- also have "2 * arctan (real x / ?R) = arctan (real x)" using arctan_half[symmetric] unfolding numeral_2_eq_2 power_Suc2 power_0 mult_1_left .
+ also have "2 * arctan (x / ?R) = arctan x" using arctan_half[symmetric] unfolding numeral_2_eq_2 power_Suc2 power_0 mult_1_left .
finally show ?thesis unfolding lb_arctan.simps Let_def if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x \<le> Float 1 -1`] if_P[OF True] .
next
case False
@@ -624,27 +635,27 @@
hence "1 \<le> real x" by auto
let "?invx" = "float_divr prec 1 x"
- have "0 \<le> arctan (real x)" using arctan_monotone'[OF `0 \<le> real x`] using arctan_tan[of 0, unfolded tan_zero] by auto
+ have "0 \<le> arctan x" using arctan_monotone'[OF `0 \<le> real x`] using arctan_tan[of 0, unfolded tan_zero] by auto
show ?thesis
proof (cases "1 < ?invx")
case True
show ?thesis unfolding lb_arctan.simps Let_def if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x \<le> Float 1 -1`] if_not_P[OF False] if_P[OF True]
- using `0 \<le> arctan (real x)` by auto
+ using `0 \<le> arctan x` by auto
next
case False
hence "real ?invx \<le> 1" unfolding less_float_def by auto
have "0 \<le> real ?invx" by (rule order_trans[OF _ float_divr], auto simp add: `0 \<le> real x`)
- have "1 / real x \<noteq> 0" and "0 < 1 / real x" using `0 < real x` by auto
-
- have "arctan (1 / real x) \<le> arctan (real ?invx)" unfolding real_of_float_1[symmetric] by (rule arctan_monotone', rule float_divr)
- also have "\<dots> \<le> real (?ub_horner ?invx)" using arctan_0_1_bounds[OF `0 \<le> real ?invx` `real ?invx \<le> 1`] by auto
- finally have "pi / 2 - real (?ub_horner ?invx) \<le> arctan (real x)"
- using `0 \<le> arctan (real x)` arctan_inverse[OF `1 / real x \<noteq> 0`]
+ have "1 / x \<noteq> 0" and "0 < 1 / x" using `0 < real x` by auto
+
+ have "arctan (1 / x) \<le> arctan ?invx" unfolding real_of_float_1[symmetric] by (rule arctan_monotone', rule float_divr)
+ also have "\<dots> \<le> (?ub_horner ?invx)" using arctan_0_1_bounds[OF `0 \<le> real ?invx` `real ?invx \<le> 1`] by auto
+ finally have "pi / 2 - (?ub_horner ?invx) \<le> arctan x"
+ using `0 \<le> arctan x` arctan_inverse[OF `1 / x \<noteq> 0`]
unfolding real_sgn_pos[OF `0 < 1 / real x`] le_diff_eq by auto
moreover
- have "real (lb_pi prec * Float 1 -1) \<le> pi / 2" unfolding real_of_float_mult Float_num times_divide_eq_right mult_1_left using pi_boundaries by auto
+ have "lb_pi prec * Float 1 -1 \<le> pi / 2" unfolding real_of_float_mult Float_num times_divide_eq_right mult_1_left using pi_boundaries by auto
ultimately
show ?thesis unfolding lb_arctan.simps Let_def if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x \<le> Float 1 -1`] if_not_P[OF `\<not> x \<le> Float 1 1`] if_not_P[OF False]
by auto
@@ -654,7 +665,7 @@
qed
lemma ub_arctan_bound': assumes "0 \<le> real x"
- shows "arctan (real x) \<le> real (ub_arctan prec x)"
+ shows "arctan x \<le> ub_arctan prec x"
proof -
have "\<not> x < 0" and "0 \<le> x" unfolding less_float_def le_float_def using `0 \<le> real x` by auto
@@ -677,16 +688,16 @@
hence divisor_gt0: "0 < ?R" by (auto intro: add_pos_nonneg)
- have "real (lb_sqrt prec (1 + x * x)) \<le> sqrt (real (1 + x * x))"
+ have "lb_sqrt prec (1 + x * x) \<le> sqrt (1 + x * x)"
using bnds_sqrt'[of "1 + x * x"] by auto
- hence "real ?fR \<le> ?R" by auto
+ hence "?fR \<le> ?R" by auto
have "0 < real ?fR" unfolding real_of_float_add real_of_float_1 by (rule order_less_le_trans[OF zero_less_one], auto simp add: lb_sqrt_lower_bound[OF `0 \<le> real (1 + x*x)`])
- have monotone: "real x / ?R \<le> real (float_divr prec x ?fR)"
+ have monotone: "x / ?R \<le> (float_divr prec x ?fR)"
proof -
- from divide_left_mono[OF `real ?fR \<le> ?R` `0 \<le> real x` mult_pos_pos[OF divisor_gt0 `0 < real ?fR`]]
- have "real x / ?R \<le> real x / real ?fR" .
- also have "\<dots> \<le> real ?DIV" by (rule float_divr)
+ from divide_left_mono[OF `?fR \<le> ?R` `0 \<le> real x` mult_pos_pos[OF divisor_gt0 `0 < real ?fR`]]
+ have "x / ?R \<le> x / ?fR" .
+ also have "\<dots> \<le> ?DIV" by (rule float_divr)
finally show ?thesis .
qed
@@ -696,20 +707,20 @@
show ?thesis
proof (cases "?DIV > 1")
case True
- have "pi / 2 \<le> real (ub_pi prec * Float 1 -1)" unfolding real_of_float_mult Float_num times_divide_eq_right mult_1_left using pi_boundaries by auto
+ have "pi / 2 \<le> ub_pi prec * Float 1 -1" unfolding real_of_float_mult Float_num times_divide_eq_right mult_1_left using pi_boundaries by auto
from order_less_le_trans[OF arctan_ubound this, THEN less_imp_le]
show ?thesis unfolding ub_arctan.simps Let_def if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x \<le> Float 1 -1`] if_P[OF `x \<le> Float 1 1`] if_P[OF True] .
next
case False
hence "real ?DIV \<le> 1" unfolding less_float_def by auto
- have "0 \<le> real x / ?R" using `0 \<le> real x` `0 < ?R` unfolding real_0_le_divide_iff by auto
+ have "0 \<le> x / ?R" using `0 \<le> real x` `0 < ?R` unfolding real_0_le_divide_iff by auto
hence "0 \<le> real ?DIV" using monotone by (rule order_trans)
- have "arctan (real x) = 2 * arctan (real x / ?R)" using arctan_half unfolding numeral_2_eq_2 power_Suc2 power_0 mult_1_left .
- also have "\<dots> \<le> 2 * arctan (real ?DIV)"
+ have "arctan x = 2 * arctan (x / ?R)" using arctan_half unfolding numeral_2_eq_2 power_Suc2 power_0 mult_1_left .
+ also have "\<dots> \<le> 2 * arctan (?DIV)"
using arctan_monotone'[OF monotone] by (auto intro!: mult_left_mono)
- also have "\<dots> \<le> real (Float 1 1 * ?ub_horner ?DIV)" unfolding real_of_float_mult[of "Float 1 1"] Float_num
+ also have "\<dots> \<le> (Float 1 1 * ?ub_horner ?DIV)" unfolding real_of_float_mult[of "Float 1 1"] Float_num
using arctan_0_1_bounds[OF `0 \<le> real ?DIV` `real ?DIV \<le> 1`] by auto
finally show ?thesis unfolding ub_arctan.simps Let_def if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x \<le> Float 1 -1`] if_P[OF `x \<le> Float 1 1`] if_not_P[OF False] .
qed
@@ -721,20 +732,20 @@
hence "0 < x" unfolding less_float_def by auto
let "?invx" = "float_divl prec 1 x"
- have "0 \<le> arctan (real x)" using arctan_monotone'[OF `0 \<le> real x`] using arctan_tan[of 0, unfolded tan_zero] by auto
+ have "0 \<le> arctan x" using arctan_monotone'[OF `0 \<le> real x`] using arctan_tan[of 0, unfolded tan_zero] by auto
have "real ?invx \<le> 1" unfolding less_float_def by (rule order_trans[OF float_divl], auto simp add: `1 \<le> real x` divide_le_eq_1_pos[OF `0 < real x`])
have "0 \<le> real ?invx" unfolding real_of_float_0[symmetric] by (rule float_divl_lower_bound[unfolded le_float_def], auto simp add: `0 < x`)
- have "1 / real x \<noteq> 0" and "0 < 1 / real x" using `0 < real x` by auto
-
- have "real (?lb_horner ?invx) \<le> arctan (real ?invx)" using arctan_0_1_bounds[OF `0 \<le> real ?invx` `real ?invx \<le> 1`] by auto
- also have "\<dots> \<le> arctan (1 / real x)" unfolding real_of_float_1[symmetric] by (rule arctan_monotone', rule float_divl)
- finally have "arctan (real x) \<le> pi / 2 - real (?lb_horner ?invx)"
- using `0 \<le> arctan (real x)` arctan_inverse[OF `1 / real x \<noteq> 0`]
- unfolding real_sgn_pos[OF `0 < 1 / real x`] le_diff_eq by auto
+ have "1 / x \<noteq> 0" and "0 < 1 / x" using `0 < real x` by auto
+
+ have "(?lb_horner ?invx) \<le> arctan (?invx)" using arctan_0_1_bounds[OF `0 \<le> real ?invx` `real ?invx \<le> 1`] by auto
+ also have "\<dots> \<le> arctan (1 / x)" unfolding real_of_float_1[symmetric] by (rule arctan_monotone', rule float_divl)
+ finally have "arctan x \<le> pi / 2 - (?lb_horner ?invx)"
+ using `0 \<le> arctan x` arctan_inverse[OF `1 / x \<noteq> 0`]
+ unfolding real_sgn_pos[OF `0 < 1 / x`] le_diff_eq by auto
moreover
- have "pi / 2 \<le> real (ub_pi prec * Float 1 -1)" unfolding real_of_float_mult Float_num times_divide_eq_right mult_1_right using pi_boundaries by auto
+ have "pi / 2 \<le> ub_pi prec * Float 1 -1" unfolding real_of_float_mult Float_num times_divide_eq_right mult_1_right using pi_boundaries by auto
ultimately
show ?thesis unfolding ub_arctan.simps Let_def if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x \<le> Float 1 -1`] if_not_P[OF `\<not> x \<le> Float 1 1`] if_not_P[OF False]
by auto
@@ -743,34 +754,34 @@
qed
lemma arctan_boundaries:
- "arctan (real x) \<in> {real (lb_arctan prec x) .. real (ub_arctan prec x)}"
+ "arctan x \<in> {(lb_arctan prec x) .. (ub_arctan prec x)}"
proof (cases "0 \<le> x")
case True hence "0 \<le> real x" unfolding le_float_def by auto
show ?thesis using ub_arctan_bound'[OF `0 \<le> real x`] lb_arctan_bound'[OF `0 \<le> real x`] unfolding atLeastAtMost_iff by auto
next
let ?mx = "-x"
case False hence "x < 0" and "0 \<le> real ?mx" unfolding le_float_def less_float_def by auto
- hence bounds: "real (lb_arctan prec ?mx) \<le> arctan (real ?mx) \<and> arctan (real ?mx) \<le> real (ub_arctan prec ?mx)"
+ hence bounds: "lb_arctan prec ?mx \<le> arctan ?mx \<and> arctan ?mx \<le> ub_arctan prec ?mx"
using ub_arctan_bound'[OF `0 \<le> real ?mx`] lb_arctan_bound'[OF `0 \<le> real ?mx`] by auto
show ?thesis unfolding real_of_float_minus arctan_minus lb_arctan.simps[where x=x] ub_arctan.simps[where x=x] Let_def if_P[OF `x < 0`]
unfolding atLeastAtMost_iff using bounds[unfolded real_of_float_minus arctan_minus] by auto
qed
-lemma bnds_arctan: "\<forall> x lx ux. (l, u) = (lb_arctan prec lx, ub_arctan prec ux) \<and> x \<in> {real lx .. real ux} \<longrightarrow> real l \<le> arctan x \<and> arctan x \<le> real u"
+lemma bnds_arctan: "\<forall> (x::real) lx ux. (l, u) = (lb_arctan prec lx, ub_arctan prec ux) \<and> x \<in> {lx .. ux} \<longrightarrow> l \<le> arctan x \<and> arctan x \<le> u"
proof (rule allI, rule allI, rule allI, rule impI)
- fix x lx ux
- assume "(l, u) = (lb_arctan prec lx, ub_arctan prec ux) \<and> x \<in> {real lx .. real ux}"
- hence l: "lb_arctan prec lx = l " and u: "ub_arctan prec ux = u" and x: "x \<in> {real lx .. real ux}" by auto
+ fix x :: real fix lx ux
+ assume "(l, u) = (lb_arctan prec lx, ub_arctan prec ux) \<and> x \<in> {lx .. ux}"
+ hence l: "lb_arctan prec lx = l " and u: "ub_arctan prec ux = u" and x: "x \<in> {lx .. ux}" by auto
{ from arctan_boundaries[of lx prec, unfolded l]
- have "real l \<le> arctan (real lx)" by (auto simp del: lb_arctan.simps)
+ have "l \<le> arctan lx" by (auto simp del: lb_arctan.simps)
also have "\<dots> \<le> arctan x" using x by (auto intro: arctan_monotone')
- finally have "real l \<le> arctan x" .
+ finally have "l \<le> arctan x" .
} moreover
- { have "arctan x \<le> arctan (real ux)" using x by (auto intro: arctan_monotone')
- also have "\<dots> \<le> real u" using arctan_boundaries[of ux prec, unfolded u] by (auto simp del: ub_arctan.simps)
- finally have "arctan x \<le> real u" .
- } ultimately show "real l \<le> arctan x \<and> arctan x \<le> real u" ..
+ { have "arctan x \<le> arctan ux" using x by (auto intro: arctan_monotone')
+ also have "\<dots> \<le> u" using arctan_boundaries[of ux prec, unfolded u] by (auto simp del: ub_arctan.simps)
+ finally have "arctan x \<le> u" .
+ } ultimately show "l \<le> arctan x \<and> arctan x \<le> u" ..
qed
section "Sinus and Cosinus"
@@ -781,14 +792,13 @@
and lb_sin_cos_aux :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> float \<Rightarrow> float" where
"ub_sin_cos_aux prec 0 i k x = 0"
| "ub_sin_cos_aux prec (Suc n) i k x =
- (rapprox_rat prec 1 (int k)) - x * (lb_sin_cos_aux prec n (i + 2) (k * i * (i + 1)) x)"
+ (rapprox_rat prec 1 k) - x * (lb_sin_cos_aux prec n (i + 2) (k * i * (i + 1)) x)"
| "lb_sin_cos_aux prec 0 i k x = 0"
| "lb_sin_cos_aux prec (Suc n) i k x =
- (lapprox_rat prec 1 (int k)) - x * (ub_sin_cos_aux prec n (i + 2) (k * i * (i + 1)) x)"
-
+ (lapprox_rat prec 1 k) - x * (ub_sin_cos_aux prec n (i + 2) (k * i * (i + 1)) x)"
lemma cos_aux:
- shows "real (lb_sin_cos_aux prec n 1 1 (x * x)) \<le> (\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * (real x)^(2 * i))" (is "?lb")
- and "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * (real x)^(2 * i)) \<le> real (ub_sin_cos_aux prec n 1 1 (x * x))" (is "?ub")
+ shows "(lb_sin_cos_aux prec n 1 1 (x * x)) \<le> (\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * x ^(2 * i))" (is "?lb")
+ and "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i))) * x^(2 * i)) \<le> (ub_sin_cos_aux prec n 1 1 (x * x))" (is "?ub")
proof -
have "0 \<le> real (x * x)" unfolding real_of_float_mult by auto
let "?f n" = "fact (2 * n)"
@@ -803,8 +813,8 @@
show "?lb" and "?ub" by (auto simp add: power_mult power2_eq_square[of "real x"])
qed
-lemma cos_boundaries: assumes "0 \<le> real x" and "real x \<le> pi / 2"
- shows "cos (real x) \<in> {real (lb_sin_cos_aux prec (get_even n) 1 1 (x * x)) .. real (ub_sin_cos_aux prec (get_odd n) 1 1 (x * x))}"
+lemma cos_boundaries: assumes "0 \<le> real x" and "x \<le> pi / 2"
+ shows "cos x \<in> {(lb_sin_cos_aux prec (get_even n) 1 1 (x * x)) .. (ub_sin_cos_aux prec (get_odd n) 1 1 (x * x))}"
proof (cases "real x = 0")
case False hence "real x \<noteq> 0" by auto
hence "0 < x" and "0 < real x" using `0 \<le> real x` unfolding less_float_def by auto
@@ -828,17 +838,17 @@
{ fix n :: nat assume "0 < n"
hence "0 < 2 * n" by auto
obtain t where "0 < t" and "t < real x" and
- cos_eq: "cos (real x) = (\<Sum> i = 0 ..< 2 * n. (if even(i) then (-1 ^ (i div 2))/(real (fact i)) else 0) * (real x) ^ i)
- + (cos (t + 1/2 * real (2 * n) * pi) / real (fact (2*n))) * (real x)^(2*n)"
+ cos_eq: "cos x = (\<Sum> i = 0 ..< 2 * n. (if even(i) then (-1 ^ (i div 2))/(real (fact i)) else 0) * (real x) ^ i)
+ + (cos (t + 1/2 * (2 * n) * pi) / real (fact (2*n))) * (real x)^(2*n)"
(is "_ = ?SUM + ?rest / ?fact * ?pow")
using Maclaurin_cos_expansion2[OF `0 < real x` `0 < 2 * n`] by auto
- have "cos t * -1^n = cos t * cos (real n * pi) + sin t * sin (real n * pi)" by auto
- also have "\<dots> = cos (t + real n * pi)" using cos_add by auto
+ have "cos t * -1^n = cos t * cos (n * pi) + sin t * sin (n * pi)" by auto
+ also have "\<dots> = cos (t + n * pi)" using cos_add by auto
also have "\<dots> = ?rest" by auto
finally have "cos t * -1^n = ?rest" .
moreover
- have "t \<le> pi / 2" using `t < real x` and `real x \<le> pi / 2` by auto
+ have "t \<le> pi / 2" using `t < real x` and `x \<le> pi / 2` by auto
hence "0 \<le> cos t" using `0 < t` and cos_ge_zero by auto
ultimately have even: "even n \<Longrightarrow> 0 \<le> ?rest" and odd: "odd n \<Longrightarrow> 0 \<le> - ?rest " by auto
@@ -847,41 +857,41 @@
{
assume "even n"
- have "real (lb_sin_cos_aux prec n 1 1 (x * x)) \<le> ?SUM"
+ have "(lb_sin_cos_aux prec n 1 1 (x * x)) \<le> ?SUM"
unfolding morph_to_if_power[symmetric] using cos_aux by auto
- also have "\<dots> \<le> cos (real x)"
+ also have "\<dots> \<le> cos x"
proof -
from even[OF `even n`] `0 < ?fact` `0 < ?pow`
have "0 \<le> (?rest / ?fact) * ?pow" by (metis mult_nonneg_nonneg divide_nonneg_pos less_imp_le)
thus ?thesis unfolding cos_eq by auto
qed
- finally have "real (lb_sin_cos_aux prec n 1 1 (x * x)) \<le> cos (real x)" .
+ finally have "(lb_sin_cos_aux prec n 1 1 (x * x)) \<le> cos x" .
} note lb = this
{
assume "odd n"
- have "cos (real x) \<le> ?SUM"
+ have "cos x \<le> ?SUM"
proof -
from `0 < ?fact` and `0 < ?pow` and odd[OF `odd n`]
have "0 \<le> (- ?rest) / ?fact * ?pow"
by (metis mult_nonneg_nonneg divide_nonneg_pos less_imp_le)
thus ?thesis unfolding cos_eq by auto
qed
- also have "\<dots> \<le> real (ub_sin_cos_aux prec n 1 1 (x * x))"
+ also have "\<dots> \<le> (ub_sin_cos_aux prec n 1 1 (x * x))"
unfolding morph_to_if_power[symmetric] using cos_aux by auto
- finally have "cos (real x) \<le> real (ub_sin_cos_aux prec n 1 1 (x * x))" .
+ finally have "cos x \<le> (ub_sin_cos_aux prec n 1 1 (x * x))" .
} note ub = this and lb
} note ub = this(1) and lb = this(2)
- have "cos (real x) \<le> real (ub_sin_cos_aux prec (get_odd n) 1 1 (x * x))" using ub[OF odd_pos[OF get_odd] get_odd] .
- moreover have "real (lb_sin_cos_aux prec (get_even n) 1 1 (x * x)) \<le> cos (real x)"
+ have "cos x \<le> (ub_sin_cos_aux prec (get_odd n) 1 1 (x * x))" using ub[OF odd_pos[OF get_odd] get_odd] .
+ moreover have "(lb_sin_cos_aux prec (get_even n) 1 1 (x * x)) \<le> cos x"
proof (cases "0 < get_even n")
case True show ?thesis using lb[OF True get_even] .
next
case False
hence "get_even n = 0" by auto
- have "- (pi / 2) \<le> real x" by (rule order_trans[OF _ `0 < real x`[THEN less_imp_le]], auto)
- with `real x \<le> pi / 2`
+ have "- (pi / 2) \<le> x" by (rule order_trans[OF _ `0 < real x`[THEN less_imp_le]], auto)
+ with `x \<le> pi / 2`
show ?thesis unfolding `get_even n = 0` lb_sin_cos_aux.simps real_of_float_minus real_of_float_0 using cos_ge_zero by auto
qed
ultimately show ?thesis by auto
@@ -898,8 +908,8 @@
qed
lemma sin_aux: assumes "0 \<le> real x"
- shows "real (x * lb_sin_cos_aux prec n 2 1 (x * x)) \<le> (\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i + 1))) * (real x)^(2 * i + 1))" (is "?lb")
- and "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i + 1))) * (real x)^(2 * i + 1)) \<le> real (x * ub_sin_cos_aux prec n 2 1 (x * x))" (is "?ub")
+ shows "(x * lb_sin_cos_aux prec n 2 1 (x * x)) \<le> (\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i + 1))) * x^(2 * i + 1))" (is "?lb")
+ and "(\<Sum> i=0..<n. -1^i * (1/real (fact (2 * i + 1))) * x^(2 * i + 1)) \<le> (x * ub_sin_cos_aux prec n 2 1 (x * x))" (is "?ub")
proof -
have "0 \<le> real (x * x)" unfolding real_of_float_mult by auto
let "?f n" = "fact (2 * n + 1)"
@@ -917,8 +927,8 @@
by (auto intro!: mult_left_mono simp add: power_mult power2_eq_square[of "real x"])
qed
-lemma sin_boundaries: assumes "0 \<le> real x" and "real x \<le> pi / 2"
- shows "sin (real x) \<in> {real (x * lb_sin_cos_aux prec (get_even n) 2 1 (x * x)) .. real (x * ub_sin_cos_aux prec (get_odd n) 2 1 (x * x))}"
+lemma sin_boundaries: assumes "0 \<le> real x" and "x \<le> pi / 2"
+ shows "sin x \<in> {(x * lb_sin_cos_aux prec (get_even n) 2 1 (x * x)) .. (x * ub_sin_cos_aux prec (get_odd n) 2 1 (x * x))}"
proof (cases "real x = 0")
case False hence "real x \<noteq> 0" by auto
hence "0 < x" and "0 < real x" using `0 \<le> real x` unfolding less_float_def by auto
@@ -940,14 +950,14 @@
{ fix n :: nat assume "0 < n"
hence "0 < 2 * n + 1" by auto
obtain t where "0 < t" and "t < real x" and
- sin_eq: "sin (real x) = (\<Sum> i = 0 ..< 2 * n + 1. (if even(i) then 0 else (-1 ^ ((i - Suc 0) div 2))/(real (fact i))) * (real x) ^ i)
- + (sin (t + 1/2 * real (2 * n + 1) * pi) / real (fact (2*n + 1))) * (real x)^(2*n + 1)"
+ sin_eq: "sin x = (\<Sum> i = 0 ..< 2 * n + 1. (if even(i) then 0 else (-1 ^ ((i - Suc 0) div 2))/(real (fact i))) * (real x) ^ i)
+ + (sin (t + 1/2 * (2 * n + 1) * pi) / real (fact (2*n + 1))) * (real x)^(2*n + 1)"
(is "_ = ?SUM + ?rest / ?fact * ?pow")
using Maclaurin_sin_expansion3[OF `0 < 2 * n + 1` `0 < real x`] by auto
have "?rest = cos t * -1^n" unfolding sin_add cos_add real_of_nat_add left_distrib right_distrib by auto
moreover
- have "t \<le> pi / 2" using `t < real x` and `real x \<le> pi / 2` by auto
+ have "t \<le> pi / 2" using `t < real x` and `x \<le> pi / 2` by auto
hence "0 \<le> cos t" using `0 < t` and cos_ge_zero by auto
ultimately have even: "even n \<Longrightarrow> 0 \<le> ?rest" and odd: "odd n \<Longrightarrow> 0 \<le> - ?rest " by auto
@@ -956,22 +966,22 @@
{
assume "even n"
- have "real (x * lb_sin_cos_aux prec n 2 1 (x * x)) \<le>
+ have "(x * lb_sin_cos_aux prec n 2 1 (x * x)) \<le>
(\<Sum> i = 0 ..< 2 * n. (if even(i) then 0 else (-1 ^ ((i - Suc 0) div 2))/(real (fact i))) * (real x) ^ i)"
using sin_aux[OF `0 \<le> real x`] unfolding setsum_morph[symmetric] by auto
also have "\<dots> \<le> ?SUM" by auto
- also have "\<dots> \<le> sin (real x)"
+ also have "\<dots> \<le> sin x"
proof -
from even[OF `even n`] `0 < ?fact` `0 < ?pow`
have "0 \<le> (?rest / ?fact) * ?pow" by (metis mult_nonneg_nonneg divide_nonneg_pos less_imp_le)
thus ?thesis unfolding sin_eq by auto
qed
- finally have "real (x * lb_sin_cos_aux prec n 2 1 (x * x)) \<le> sin (real x)" .
+ finally have "(x * lb_sin_cos_aux prec n 2 1 (x * x)) \<le> sin x" .
} note lb = this
{
assume "odd n"
- have "sin (real x) \<le> ?SUM"
+ have "sin x \<le> ?SUM"
proof -
from `0 < ?fact` and `0 < ?pow` and odd[OF `odd n`]
have "0 \<le> (- ?rest) / ?fact * ?pow"
@@ -980,20 +990,20 @@
qed
also have "\<dots> \<le> (\<Sum> i = 0 ..< 2 * n. (if even(i) then 0 else (-1 ^ ((i - Suc 0) div 2))/(real (fact i))) * (real x) ^ i)"
by auto
- also have "\<dots> \<le> real (x * ub_sin_cos_aux prec n 2 1 (x * x))"
+ also have "\<dots> \<le> (x * ub_sin_cos_aux prec n 2 1 (x * x))"
using sin_aux[OF `0 \<le> real x`] unfolding setsum_morph[symmetric] by auto
- finally have "sin (real x) \<le> real (x * ub_sin_cos_aux prec n 2 1 (x * x))" .
+ finally have "sin x \<le> (x * ub_sin_cos_aux prec n 2 1 (x * x))" .
} note ub = this and lb
} note ub = this(1) and lb = this(2)
- have "sin (real x) \<le> real (x * ub_sin_cos_aux prec (get_odd n) 2 1 (x * x))" using ub[OF odd_pos[OF get_odd] get_odd] .
- moreover have "real (x * lb_sin_cos_aux prec (get_even n) 2 1 (x * x)) \<le> sin (real x)"
+ have "sin x \<le> (x * ub_sin_cos_aux prec (get_odd n) 2 1 (x * x))" using ub[OF odd_pos[OF get_odd] get_odd] .
+ moreover have "(x * lb_sin_cos_aux prec (get_even n) 2 1 (x * x)) \<le> sin x"
proof (cases "0 < get_even n")
case True show ?thesis using lb[OF True get_even] .
next
case False
hence "get_even n = 0" by auto
- with `real x \<le> pi / 2` `0 \<le> real x`
+ with `x \<le> pi / 2` `0 \<le> real x`
show ?thesis unfolding `get_even n = 0` ub_sin_cos_aux.simps real_of_float_minus real_of_float_0 using sin_ge_zero by auto
qed
ultimately show ?thesis by auto
@@ -1027,8 +1037,8 @@
else if x < 1 then half (horner (x * Float 1 -1))
else half (half (horner (x * Float 1 -2))))"
-lemma lb_cos: assumes "0 \<le> real x" and "real x \<le> pi"
- shows "cos (real x) \<in> {real (lb_cos prec x) .. real (ub_cos prec x)}" (is "?cos x \<in> { real (?lb x) .. real (?ub x) }")
+lemma lb_cos: assumes "0 \<le> real x" and "x \<le> pi"
+ shows "cos x \<in> {(lb_cos prec x) .. (ub_cos prec x)}" (is "?cos x \<in> {(?lb x) .. (?ub x) }")
proof -
{ fix x :: real
have "cos x = cos (x / 2 + x / 2)" by auto
@@ -1046,42 +1056,42 @@
show ?thesis
proof (cases "x < Float 1 -1")
- case True hence "real x \<le> pi / 2" unfolding less_float_def using pi_ge_two by auto
+ case True hence "x \<le> pi / 2" unfolding less_float_def using pi_ge_two by auto
show ?thesis unfolding lb_cos_def[where x=x] ub_cos_def[where x=x] if_not_P[OF `\<not> x < 0`] if_P[OF `x < Float 1 -1`] Let_def
- using cos_boundaries[OF `0 \<le> real x` `real x \<le> pi / 2`] .
+ using cos_boundaries[OF `0 \<le> real x` `x \<le> pi / 2`] .
next
case False
- { fix y x :: float let ?x2 = "real (x * Float 1 -1)"
- assume "real y \<le> cos ?x2" and "-pi \<le> real x" and "real x \<le> pi"
+ { fix y x :: float let ?x2 = "(x * Float 1 -1)"
+ assume "y \<le> cos ?x2" and "-pi \<le> x" and "x \<le> pi"
hence "- (pi / 2) \<le> ?x2" and "?x2 \<le> pi / 2" using pi_ge_two unfolding real_of_float_mult Float_num by auto
hence "0 \<le> cos ?x2" by (rule cos_ge_zero)
- have "real (?lb_half y) \<le> cos (real x)"
+ have "(?lb_half y) \<le> cos x"
proof (cases "y < 0")
case True show ?thesis using cos_ge_minus_one unfolding if_P[OF True] by auto
next
case False
hence "0 \<le> real y" unfolding less_float_def by auto
- from mult_mono[OF `real y \<le> cos ?x2` `real y \<le> cos ?x2` `0 \<le> cos ?x2` this]
+ from mult_mono[OF `y \<le> cos ?x2` `y \<le> cos ?x2` `0 \<le> cos ?x2` this]
have "real y * real y \<le> cos ?x2 * cos ?x2" .
hence "2 * real y * real y \<le> 2 * cos ?x2 * cos ?x2" by auto
- hence "2 * real y * real y - 1 \<le> 2 * cos (real x / 2) * cos (real x / 2) - 1" unfolding Float_num real_of_float_mult by auto
+ hence "2 * real y * real y - 1 \<le> 2 * cos (x / 2) * cos (x / 2) - 1" unfolding Float_num real_of_float_mult by auto
thus ?thesis unfolding if_not_P[OF False] x_half Float_num real_of_float_mult real_of_float_sub by auto
qed
} note lb_half = this
- { fix y x :: float let ?x2 = "real (x * Float 1 -1)"
- assume ub: "cos ?x2 \<le> real y" and "- pi \<le> real x" and "real x \<le> pi"
+ { fix y x :: float let ?x2 = "(x * Float 1 -1)"
+ assume ub: "cos ?x2 \<le> y" and "- pi \<le> x" and "x \<le> pi"
hence "- (pi / 2) \<le> ?x2" and "?x2 \<le> pi / 2" using pi_ge_two unfolding real_of_float_mult Float_num by auto
hence "0 \<le> cos ?x2" by (rule cos_ge_zero)
- have "cos (real x) \<le> real (?ub_half y)"
+ have "cos x \<le> (?ub_half y)"
proof -
have "0 \<le> real y" using `0 \<le> cos ?x2` ub by (rule order_trans)
from mult_mono[OF ub ub this `0 \<le> cos ?x2`]
have "cos ?x2 * cos ?x2 \<le> real y * real y" .
hence "2 * cos ?x2 * cos ?x2 \<le> 2 * real y * real y" by auto
- hence "2 * cos (real x / 2) * cos (real x / 2) - 1 \<le> 2 * real y * real y - 1" unfolding Float_num real_of_float_mult by auto
+ hence "2 * cos (x / 2) * cos (x / 2) - 1 \<le> 2 * real y * real y - 1" unfolding Float_num real_of_float_mult by auto
thus ?thesis unfolding x_half real_of_float_mult Float_num real_of_float_sub by auto
qed
} note ub_half = this
@@ -1089,44 +1099,44 @@
let ?x2 = "x * Float 1 -1"
let ?x4 = "x * Float 1 -1 * Float 1 -1"
- have "-pi \<le> real x" using pi_ge_zero[THEN le_imp_neg_le, unfolded minus_zero] `0 \<le> real x` by (rule order_trans)
+ have "-pi \<le> x" using pi_ge_zero[THEN le_imp_neg_le, unfolded minus_zero] `0 \<le> real x` by (rule order_trans)
show ?thesis
proof (cases "x < 1")
case True hence "real x \<le> 1" unfolding less_float_def by auto
- have "0 \<le> real ?x2" and "real ?x2 \<le> pi / 2" using pi_ge_two `0 \<le> real x` unfolding real_of_float_mult Float_num using assms by auto
+ have "0 \<le> real ?x2" and "?x2 \<le> pi / 2" using pi_ge_two `0 \<le> real x` unfolding real_of_float_mult Float_num using assms by auto
from cos_boundaries[OF this]
- have lb: "real (?lb_horner ?x2) \<le> ?cos ?x2" and ub: "?cos ?x2 \<le> real (?ub_horner ?x2)" by auto
-
- have "real (?lb x) \<le> ?cos x"
+ have lb: "(?lb_horner ?x2) \<le> ?cos ?x2" and ub: "?cos ?x2 \<le> (?ub_horner ?x2)" by auto
+
+ have "(?lb x) \<le> ?cos x"
proof -
- from lb_half[OF lb `-pi \<le> real x` `real x \<le> pi`]
+ from lb_half[OF lb `-pi \<le> x` `x \<le> pi`]
show ?thesis unfolding lb_cos_def[where x=x] Let_def using `\<not> x < 0` `\<not> x < Float 1 -1` `x < 1` by auto
qed
- moreover have "?cos x \<le> real (?ub x)"
+ moreover have "?cos x \<le> (?ub x)"
proof -
- from ub_half[OF ub `-pi \<le> real x` `real x \<le> pi`]
+ from ub_half[OF ub `-pi \<le> x` `x \<le> pi`]
show ?thesis unfolding ub_cos_def[where x=x] Let_def using `\<not> x < 0` `\<not> x < Float 1 -1` `x < 1` by auto
qed
ultimately show ?thesis by auto
next
case False
- have "0 \<le> real ?x4" and "real ?x4 \<le> pi / 2" using pi_ge_two `0 \<le> real x` `real x \<le> pi` unfolding real_of_float_mult Float_num by auto
+ have "0 \<le> real ?x4" and "?x4 \<le> pi / 2" using pi_ge_two `0 \<le> real x` `x \<le> pi` unfolding real_of_float_mult Float_num by auto
from cos_boundaries[OF this]
- have lb: "real (?lb_horner ?x4) \<le> ?cos ?x4" and ub: "?cos ?x4 \<le> real (?ub_horner ?x4)" by auto
+ have lb: "(?lb_horner ?x4) \<le> ?cos ?x4" and ub: "?cos ?x4 \<le> (?ub_horner ?x4)" by auto
have eq_4: "?x2 * Float 1 -1 = x * Float 1 -2" by (cases x, auto simp add: times_float.simps)
- have "real (?lb x) \<le> ?cos x"
+ have "(?lb x) \<le> ?cos x"
proof -
- have "-pi \<le> real ?x2" and "real ?x2 \<le> pi" unfolding real_of_float_mult Float_num using pi_ge_two `0 \<le> real x` `real x \<le> pi` by auto
- from lb_half[OF lb_half[OF lb this] `-pi \<le> real x` `real x \<le> pi`, unfolded eq_4]
+ have "-pi \<le> ?x2" and "?x2 \<le> pi" unfolding real_of_float_mult Float_num using pi_ge_two `0 \<le> real x` `x \<le> pi` by auto
+ from lb_half[OF lb_half[OF lb this] `-pi \<le> x` `x \<le> pi`, unfolded eq_4]
show ?thesis unfolding lb_cos_def[where x=x] if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x < Float 1 -1`] if_not_P[OF `\<not> x < 1`] Let_def .
qed
- moreover have "?cos x \<le> real (?ub x)"
+ moreover have "?cos x \<le> (?ub x)"
proof -
- have "-pi \<le> real ?x2" and "real ?x2 \<le> pi" unfolding real_of_float_mult Float_num using pi_ge_two `0 \<le> real x` `real x \<le> pi` by auto
- from ub_half[OF ub_half[OF ub this] `-pi \<le> real x` `real x \<le> pi`, unfolded eq_4]
+ have "-pi \<le> ?x2" and "?x2 \<le> pi" unfolding real_of_float_mult Float_num using pi_ge_two `0 \<le> real x` ` x \<le> pi` by auto
+ from ub_half[OF ub_half[OF ub this] `-pi \<le> x` `x \<le> pi`, unfolded eq_4]
show ?thesis unfolding ub_cos_def[where x=x] if_not_P[OF `\<not> x < 0`] if_not_P[OF `\<not> x < Float 1 -1`] if_not_P[OF `\<not> x < 1`] Let_def .
qed
ultimately show ?thesis by auto
@@ -1134,10 +1144,10 @@
qed
qed
-lemma lb_cos_minus: assumes "-pi \<le> real x" and "real x \<le> 0"
- shows "cos (real (-x)) \<in> {real (lb_cos prec (-x)) .. real (ub_cos prec (-x))}"
+lemma lb_cos_minus: assumes "-pi \<le> x" and "real x \<le> 0"
+ shows "cos (real(-x)) \<in> {(lb_cos prec (-x)) .. (ub_cos prec (-x))}"
proof -
- have "0 \<le> real (-x)" and "real (-x) \<le> pi" using `-pi \<le> real x` `real x \<le> 0` by auto
+ have "0 \<le> real (-x)" and "(-x) \<le> pi" using `-pi \<le> x` `real x \<le> 0` by auto
from lb_cos[OF this] show ?thesis .
qed
@@ -1156,49 +1166,49 @@
else (Float -1 0, Float 1 0))"
lemma floor_int:
- obtains k :: int where "real k = real (floor_fl f)"
+ obtains k :: int where "real k = (floor_fl f)"
proof -
- assume *: "\<And> k :: int. real k = real (floor_fl f) \<Longrightarrow> thesis"
+ assume *: "\<And> k :: int. real k = (floor_fl f) \<Longrightarrow> thesis"
obtain m e where fl: "Float m e = floor_fl f" by (cases "floor_fl f", auto)
from floor_pos_exp[OF this]
- have "real (m* 2^(nat e)) = real (floor_fl f)"
+ have "real (m* 2^(nat e)) = (floor_fl f)"
by (auto simp add: fl[symmetric] real_of_float_def pow2_def)
from *[OF this] show thesis by blast
qed
-lemma float_remove_real_numeral[simp]: "real (number_of k :: float) = number_of k"
+lemma float_remove_real_numeral[simp]: "(number_of k :: float) = (number_of k :: real)"
proof -
- have "real (number_of k :: float) = real k"
+ have "(number_of k :: float) = real k"
unfolding number_of_float_def real_of_float_def pow2_def by auto
- also have "\<dots> = real (number_of k :: int)"
+ also have "\<dots> = (number_of k :: int)"
by (simp add: number_of_is_id)
finally show ?thesis by auto
qed
-lemma cos_periodic_nat[simp]: fixes n :: nat shows "cos (x + real n * 2 * pi) = cos x"
+lemma cos_periodic_nat[simp]: fixes n :: nat shows "cos (x + n * (2 * pi)) = cos x"
proof (induct n arbitrary: x)
case (Suc n)
- have split_pi_off: "x + real (Suc n) * 2 * pi = (x + real n * 2 * pi) + 2 * pi"
+ have split_pi_off: "x + (Suc n) * (2 * pi) = (x + n * (2 * pi)) + 2 * pi"
unfolding Suc_eq_plus1 real_of_nat_add real_of_one left_distrib by auto
show ?case unfolding split_pi_off using Suc by auto
qed auto
-lemma cos_periodic_int[simp]: fixes i :: int shows "cos (x + real i * 2 * pi) = cos x"
+lemma cos_periodic_int[simp]: fixes i :: int shows "cos (x + i * (2 * pi)) = cos x"
proof (cases "0 \<le> i")
- case True hence i_nat: "real i = real (nat i)" by auto
+ case True hence i_nat: "real i = nat i" by auto
show ?thesis unfolding i_nat by auto
next
- case False hence i_nat: "real i = - real (nat (-i))" by auto
- have "cos x = cos (x + real i * 2 * pi - real i * 2 * pi)" by auto
- also have "\<dots> = cos (x + real i * 2 * pi)"
+ case False hence i_nat: "i = - real (nat (-i))" by auto
+ have "cos x = cos (x + i * (2 * pi) - i * (2 * pi))" by auto
+ also have "\<dots> = cos (x + i * (2 * pi))"
unfolding i_nat mult_minus_left diff_minus_eq_add by (rule cos_periodic_nat)
finally show ?thesis by auto
qed
-lemma bnds_cos: "\<forall> x lx ux. (l, u) = bnds_cos prec lx ux \<and> x \<in> {real lx .. real ux} \<longrightarrow> real l \<le> cos x \<and> cos x \<le> real u"
+lemma bnds_cos: "\<forall> (x::real) lx ux. (l, u) = bnds_cos prec lx ux \<and> x \<in> {lx .. ux} \<longrightarrow> l \<le> cos x \<and> cos x \<le> u"
proof ((rule allI | rule impI | erule conjE) +)
- fix x lx ux
- assume bnds: "(l, u) = bnds_cos prec lx ux" and x: "x \<in> {real lx .. real ux}"
+ fix x :: real fix lx ux
+ assume bnds: "(l, u) = bnds_cos prec lx ux" and x: "x \<in> {lx .. ux}"
let ?lpi = "round_down prec (lb_pi prec)"
let ?upi = "round_up prec (ub_pi prec)"
@@ -1206,78 +1216,78 @@
let ?lx = "lx - ?k * 2 * (if ?k < 0 then ?lpi else ?upi)"
let ?ux = "ux - ?k * 2 * (if ?k < 0 then ?upi else ?lpi)"
- obtain k :: int where k: "real k = real ?k" using floor_int .
-
- have upi: "pi \<le> real ?upi" and lpi: "real ?lpi \<le> pi"
+ obtain k :: int where k: "k = real ?k" using floor_int .
+
+ have upi: "pi \<le> ?upi" and lpi: "?lpi \<le> pi"
using round_up[of "ub_pi prec" prec] pi_boundaries[of prec]
round_down[of prec "lb_pi prec"] by auto
- hence "real ?lx \<le> x - real k * 2 * pi \<and> x - real k * 2 * pi \<le> real ?ux"
+ hence "?lx \<le> x - k * (2 * pi) \<and> x - k * (2 * pi) \<le> ?ux"
using x by (cases "k = 0") (auto intro!: add_mono
simp add: diff_minus k[symmetric] less_float_def)
note lx = this[THEN conjunct1] and ux = this[THEN conjunct2]
- hence lx_less_ux: "real ?lx \<le> real ?ux" by (rule order_trans)
-
- { assume "- ?lpi \<le> ?lx" and x_le_0: "x - real k * 2 * pi \<le> 0"
+ hence lx_less_ux: "?lx \<le> real ?ux" by (rule order_trans)
+
+ { assume "- ?lpi \<le> ?lx" and x_le_0: "x - k * (2 * pi) \<le> 0"
with lpi[THEN le_imp_neg_le] lx
- have pi_lx: "- pi \<le> real ?lx" and lx_0: "real ?lx \<le> 0"
+ have pi_lx: "- pi \<le> ?lx" and lx_0: "real ?lx \<le> 0"
by (simp_all add: le_float_def)
- have "real (lb_cos prec (- ?lx)) \<le> cos (real (- ?lx))"
+ have "(lb_cos prec (- ?lx)) \<le> cos (real (- ?lx))"
using lb_cos_minus[OF pi_lx lx_0] by simp
- also have "\<dots> \<le> cos (x + real (-k) * 2 * pi)"
+ also have "\<dots> \<le> cos (x + (-k) * (2 * pi))"
using cos_monotone_minus_pi_0'[OF pi_lx lx x_le_0]
by (simp only: real_of_float_minus real_of_int_minus
cos_minus diff_minus mult_minus_left)
- finally have "real (lb_cos prec (- ?lx)) \<le> cos x"
+ finally have "(lb_cos prec (- ?lx)) \<le> cos x"
unfolding cos_periodic_int . }
note negative_lx = this
- { assume "0 \<le> ?lx" and pi_x: "x - real k * 2 * pi \<le> pi"
+ { assume "0 \<le> ?lx" and pi_x: "x - k * (2 * pi) \<le> pi"
with lx
- have pi_lx: "real ?lx \<le> pi" and lx_0: "0 \<le> real ?lx"
+ have pi_lx: "?lx \<le> pi" and lx_0: "0 \<le> real ?lx"
by (auto simp add: le_float_def)
- have "cos (x + real (-k) * 2 * pi) \<le> cos (real ?lx)"
+ have "cos (x + (-k) * (2 * pi)) \<le> cos ?lx"
using cos_monotone_0_pi'[OF lx_0 lx pi_x]
by (simp only: real_of_float_minus real_of_int_minus
cos_minus diff_minus mult_minus_left)
- also have "\<dots> \<le> real (ub_cos prec ?lx)"
+ also have "\<dots> \<le> (ub_cos prec ?lx)"
using lb_cos[OF lx_0 pi_lx] by simp
- finally have "cos x \<le> real (ub_cos prec ?lx)"
+ finally have "cos x \<le> (ub_cos prec ?lx)"
unfolding cos_periodic_int . }
note positive_lx = this
- { assume pi_x: "- pi \<le> x - real k * 2 * pi" and "?ux \<le> 0"
+ { assume pi_x: "- pi \<le> x - k * (2 * pi)" and "?ux \<le> 0"
with ux
- have pi_ux: "- pi \<le> real ?ux" and ux_0: "real ?ux \<le> 0"
+ have pi_ux: "- pi \<le> ?ux" and ux_0: "real ?ux \<le> 0"
by (simp_all add: le_float_def)
- have "cos (x + real (-k) * 2 * pi) \<le> cos (real (- ?ux))"
+ have "cos (x + (-k) * (2 * pi)) \<le> cos (real (- ?ux))"
using cos_monotone_minus_pi_0'[OF pi_x ux ux_0]
by (simp only: real_of_float_minus real_of_int_minus
cos_minus diff_minus mult_minus_left)
- also have "\<dots> \<le> real (ub_cos prec (- ?ux))"
+ also have "\<dots> \<le> (ub_cos prec (- ?ux))"
using lb_cos_minus[OF pi_ux ux_0, of prec] by simp
- finally have "cos x \<le> real (ub_cos prec (- ?ux))"
+ finally have "cos x \<le> (ub_cos prec (- ?ux))"
unfolding cos_periodic_int . }
note negative_ux = this
- { assume "?ux \<le> ?lpi" and x_ge_0: "0 \<le> x - real k * 2 * pi"
+ { assume "?ux \<le> ?lpi" and x_ge_0: "0 \<le> x - k * (2 * pi)"
with lpi ux
- have pi_ux: "real ?ux \<le> pi" and ux_0: "0 \<le> real ?ux"
+ have pi_ux: "?ux \<le> pi" and ux_0: "0 \<le> real ?ux"
by (simp_all add: le_float_def)
- have "real (lb_cos prec ?ux) \<le> cos (real ?ux)"
+ have "(lb_cos prec ?ux) \<le> cos ?ux"
using lb_cos[OF ux_0 pi_ux] by simp
- also have "\<dots> \<le> cos (x + real (-k) * 2 * pi)"
+ also have "\<dots> \<le> cos (x + (-k) * (2 * pi))"
using cos_monotone_0_pi'[OF x_ge_0 ux pi_ux]
by (simp only: real_of_float_minus real_of_int_minus
cos_minus diff_minus mult_minus_left)
- finally have "real (lb_cos prec ?ux) \<le> cos x"
+ finally have "(lb_cos prec ?ux) \<le> cos x"
unfolding cos_periodic_int . }
note positive_ux = this
- show "real l \<le> cos x \<and> cos x \<le> real u"
+ show "l \<le> cos x \<and> cos x \<le> u"
proof (cases "- ?lpi \<le> ?lx \<and> ?ux \<le> 0")
case True with bnds
have l: "l = lb_cos prec (-?lx)"
@@ -1285,8 +1295,8 @@
by (auto simp add: bnds_cos_def Let_def)
from True lpi[THEN le_imp_neg_le] lx ux
- have "- pi \<le> x - real k * 2 * pi"
- and "x - real k * 2 * pi \<le> 0"
+ have "- pi \<le> x - k * (2 * pi)"
+ and "x - k * (2 * pi) \<le> 0"
by (auto simp add: le_float_def)
with True negative_ux negative_lx
show ?thesis unfolding l u by simp
@@ -1298,8 +1308,8 @@
by (auto simp add: bnds_cos_def Let_def)
from True lpi lx ux
- have "0 \<le> x - real k * 2 * pi"
- and "x - real k * 2 * pi \<le> pi"
+ have "0 \<le> x - k * (2 * pi)"
+ and "x - k * (2 * pi) \<le> pi"
by (auto simp add: le_float_def)
with True positive_ux positive_lx
show ?thesis unfolding l u by simp
@@ -1311,7 +1321,7 @@
by (auto simp add: bnds_cos_def Let_def)
show ?thesis unfolding u l using negative_lx positive_ux Cond
- by (cases "x - real k * 2 * pi < 0", simp_all add: real_of_float_min)
+ by (cases "x - k * (2 * pi) < 0", simp_all add: real_of_float_min)
next case False note 3 = this show ?thesis
proof (cases "0 \<le> ?lx \<and> ?ux \<le> 2 * ?lpi")
case True note Cond = this with bnds 1 2 3
@@ -1320,37 +1330,37 @@
by (auto simp add: bnds_cos_def Let_def)
have "cos x \<le> real u"
- proof (cases "x - real k * 2 * pi < pi")
- case True hence "x - real k * 2 * pi \<le> pi" by simp
+ proof (cases "x - k * (2 * pi) < pi")
+ case True hence "x - k * (2 * pi) \<le> pi" by simp
from positive_lx[OF Cond[THEN conjunct1] this]
show ?thesis unfolding u by (simp add: real_of_float_max)
next
- case False hence "pi \<le> x - real k * 2 * pi" by simp
- hence pi_x: "- pi \<le> x - real k * 2 * pi - 2 * pi" by simp
-
- have "real ?ux \<le> 2 * pi" using Cond lpi by (auto simp add: le_float_def)
- hence "x - real k * 2 * pi - 2 * pi \<le> 0" using ux by simp
+ case False hence "pi \<le> x - k * (2 * pi)" by simp
+ hence pi_x: "- pi \<le> x - k * (2 * pi) - 2 * pi" by simp
+
+ have "?ux \<le> 2 * pi" using Cond lpi by (auto simp add: le_float_def)
+ hence "x - k * (2 * pi) - 2 * pi \<le> 0" using ux by simp
have ux_0: "real (?ux - 2 * ?lpi) \<le> 0"
using Cond by (auto simp add: le_float_def)
from 2 and Cond have "\<not> ?ux \<le> ?lpi" by auto
hence "- ?lpi \<le> ?ux - 2 * ?lpi" by (auto simp add: le_float_def)
- hence pi_ux: "- pi \<le> real (?ux - 2 * ?lpi)"
+ hence pi_ux: "- pi \<le> (?ux - 2 * ?lpi)"
using lpi[THEN le_imp_neg_le] by (auto simp add: le_float_def)
- have x_le_ux: "x - real k * 2 * pi - 2 * pi \<le> real (?ux - 2 * ?lpi)"
+ have x_le_ux: "x - k * (2 * pi) - 2 * pi \<le> (?ux - 2 * ?lpi)"
using ux lpi by auto
- have "cos x = cos (x + real (-k) * 2 * pi + real (-1 :: int) * 2 * pi)"
+ have "cos x = cos (x + (-k) * (2 * pi) + (-1::int) * (2 * pi))"
unfolding cos_periodic_int ..
- also have "\<dots> \<le> cos (real (?ux - 2 * ?lpi))"
+ also have "\<dots> \<le> cos ((?ux - 2 * ?lpi))"
using cos_monotone_minus_pi_0'[OF pi_x x_le_ux ux_0]
by (simp only: real_of_float_minus real_of_int_minus real_of_one
number_of_Min diff_minus mult_minus_left mult_1_left)
- also have "\<dots> = cos (real (- (?ux - 2 * ?lpi)))"
+ also have "\<dots> = cos ((- (?ux - 2 * ?lpi)))"
unfolding real_of_float_minus cos_minus ..
- also have "\<dots> \<le> real (ub_cos prec (- (?ux - 2 * ?lpi)))"
+ also have "\<dots> \<le> (ub_cos prec (- (?ux - 2 * ?lpi)))"
using lb_cos_minus[OF pi_ux ux_0] by simp
finally show ?thesis unfolding u by (simp add: real_of_float_max)
qed
@@ -1362,37 +1372,37 @@
and u: "u = max (ub_cos prec (?lx + 2 * ?lpi)) (ub_cos prec (-?ux))"
by (auto simp add: bnds_cos_def Let_def)
- have "cos x \<le> real u"
- proof (cases "-pi < x - real k * 2 * pi")
- case True hence "-pi \<le> x - real k * 2 * pi" by simp
+ have "cos x \<le> u"
+ proof (cases "-pi < x - k * (2 * pi)")
+ case True hence "-pi \<le> x - k * (2 * pi)" by simp
from negative_ux[OF this Cond[THEN conjunct2]]
show ?thesis unfolding u by (simp add: real_of_float_max)
next
- case False hence "x - real k * 2 * pi \<le> -pi" by simp
- hence pi_x: "x - real k * 2 * pi + 2 * pi \<le> pi" by simp
-
- have "-2 * pi \<le> real ?lx" using Cond lpi by (auto simp add: le_float_def)
-
- hence "0 \<le> x - real k * 2 * pi + 2 * pi" using lx by simp
+ case False hence "x - k * (2 * pi) \<le> -pi" by simp
+ hence pi_x: "x - k * (2 * pi) + 2 * pi \<le> pi" by simp
+
+ have "-2 * pi \<le> ?lx" using Cond lpi by (auto simp add: le_float_def)
+
+ hence "0 \<le> x - k * (2 * pi) + 2 * pi" using lx by simp
have lx_0: "0 \<le> real (?lx + 2 * ?lpi)"
using Cond lpi by (auto simp add: le_float_def)
from 1 and Cond have "\<not> -?lpi \<le> ?lx" by auto
hence "?lx + 2 * ?lpi \<le> ?lpi" by (auto simp add: le_float_def)
- hence pi_lx: "real (?lx + 2 * ?lpi) \<le> pi"
+ hence pi_lx: "(?lx + 2 * ?lpi) \<le> pi"
using lpi[THEN le_imp_neg_le] by (auto simp add: le_float_def)
- have lx_le_x: "real (?lx + 2 * ?lpi) \<le> x - real k * 2 * pi + 2 * pi"
+ have lx_le_x: "(?lx + 2 * ?lpi) \<le> x - k * (2 * pi) + 2 * pi"
using lx lpi by auto
- have "cos x = cos (x + real (-k) * 2 * pi + real (1 :: int) * 2 * pi)"
+ have "cos x = cos (x + (-k) * (2 * pi) + (1 :: int) * (2 * pi))"
unfolding cos_periodic_int ..
- also have "\<dots> \<le> cos (real (?lx + 2 * ?lpi))"
+ also have "\<dots> \<le> cos ((?lx + 2 * ?lpi))"
using cos_monotone_0_pi'[OF lx_0 lx_le_x pi_x]
by (simp only: real_of_float_minus real_of_int_minus real_of_one
number_of_Min diff_minus mult_minus_left mult_1_left)
- also have "\<dots> \<le> real (ub_cos prec (?lx + 2 * ?lpi))"
+ also have "\<dots> \<le> (ub_cos prec (?lx + 2 * ?lpi))"
using lb_cos[OF lx_0 pi_lx] by simp
finally show ?thesis unfolding u by (simp add: real_of_float_max)
qed
@@ -1413,7 +1423,7 @@
"lb_exp_horner prec (Suc n) i k x = lapprox_rat prec 1 (int k) + x * ub_exp_horner prec n (i + 1) (k * i) x"
lemma bnds_exp_horner: assumes "real x \<le> 0"
- shows "exp (real x) \<in> { real (lb_exp_horner prec (get_even n) 1 1 x) .. real (ub_exp_horner prec (get_odd n) 1 1 x) }"
+ shows "exp x \<in> { lb_exp_horner prec (get_even n) 1 1 x .. ub_exp_horner prec (get_odd n) 1 1 x }"
proof -
{ fix n
have F: "\<And> m. ((\<lambda>i. i + 1) ^^ n) m = n + m" by (induct n, auto)
@@ -1422,18 +1432,18 @@
note bounds = horner_bounds_nonpos[where f="fact" and lb="lb_exp_horner prec" and ub="ub_exp_horner prec" and j'=0 and s=1,
OF assms f_eq lb_exp_horner.simps ub_exp_horner.simps]
- { have "real (lb_exp_horner prec (get_even n) 1 1 x) \<le> (\<Sum>j = 0..<get_even n. 1 / real (fact j) * real x ^ j)"
+ { have "lb_exp_horner prec (get_even n) 1 1 x \<le> (\<Sum>j = 0..<get_even n. 1 / real (fact j) * real x ^ j)"
using bounds(1) by auto
- also have "\<dots> \<le> exp (real x)"
+ also have "\<dots> \<le> exp x"
proof -
- obtain t where "\<bar>t\<bar> \<le> \<bar>real x\<bar>" and "exp (real x) = (\<Sum>m = 0..<get_even n. (real x) ^ m / real (fact m)) + exp t / real (fact (get_even n)) * (real x) ^ (get_even n)"
+ obtain t where "\<bar>t\<bar> \<le> \<bar>real x\<bar>" and "exp x = (\<Sum>m = 0..<get_even n. real x ^ m / real (fact m)) + exp t / real (fact (get_even n)) * (real x) ^ (get_even n)"
using Maclaurin_exp_le by blast
moreover have "0 \<le> exp t / real (fact (get_even n)) * (real x) ^ (get_even n)"
by (auto intro!: mult_nonneg_nonneg divide_nonneg_pos simp add: get_even zero_le_even_power exp_gt_zero)
ultimately show ?thesis
using get_odd exp_gt_zero by (auto intro!: mult_nonneg_nonneg)
qed
- finally have "real (lb_exp_horner prec (get_even n) 1 1 x) \<le> exp (real x)" .
+ finally have "lb_exp_horner prec (get_even n) 1 1 x \<le> exp x" .
} moreover
{
have x_less_zero: "real x ^ get_odd n \<le> 0"
@@ -1446,15 +1456,15 @@
show ?thesis by (rule less_imp_le, auto simp add: power_less_zero_eq get_odd `real x < 0`)
qed
- obtain t where "\<bar>t\<bar> \<le> \<bar>real x\<bar>" and "exp (real x) = (\<Sum>m = 0..<get_odd n. (real x) ^ m / real (fact m)) + exp t / real (fact (get_odd n)) * (real x) ^ (get_odd n)"
+ obtain t where "\<bar>t\<bar> \<le> \<bar>real x\<bar>" and "exp x = (\<Sum>m = 0..<get_odd n. (real x) ^ m / real (fact m)) + exp t / real (fact (get_odd n)) * (real x) ^ (get_odd n)"
using Maclaurin_exp_le by blast
moreover have "exp t / real (fact (get_odd n)) * (real x) ^ (get_odd n) \<le> 0"
by (auto intro!: mult_nonneg_nonpos divide_nonpos_pos simp add: x_less_zero exp_gt_zero)
- ultimately have "exp (real x) \<le> (\<Sum>j = 0..<get_odd n. 1 / real (fact j) * real x ^ j)"
+ ultimately have "exp x \<le> (\<Sum>j = 0..<get_odd n. 1 / real (fact j) * real x ^ j)"
using get_odd exp_gt_zero by (auto intro!: mult_nonneg_nonneg)
- also have "\<dots> \<le> real (ub_exp_horner prec (get_odd n) 1 1 x)"
+ also have "\<dots> \<le> ub_exp_horner prec (get_odd n) 1 1 x"
using bounds(2) by auto
- finally have "exp (real x) \<le> real (ub_exp_horner prec (get_odd n) 1 1 x)" .
+ finally have "exp x \<le> ub_exp_horner prec (get_odd n) 1 1 x" .
} ultimately show ?thesis by auto
qed
@@ -1477,11 +1487,11 @@
proof -
have eq4: "4 = Suc (Suc (Suc (Suc 0)))" by auto
- have "1 / 4 = real (Float 1 -2)" unfolding Float_num by auto
- also have "\<dots> \<le> real (lb_exp_horner 1 (get_even 4) 1 1 (- 1))"
+ have "1 / 4 = (Float 1 -2)" unfolding Float_num by auto
+ also have "\<dots> \<le> lb_exp_horner 1 (get_even 4) 1 1 (- 1)"
unfolding get_even_def eq4
by (auto simp add: lapprox_posrat_def rapprox_posrat_def normfloat.simps)
- also have "\<dots> \<le> exp (real (- 1 :: float))" using bnds_exp_horner[where x="- 1"] by auto
+ also have "\<dots> \<le> exp (- 1 :: float)" using bnds_exp_horner[where x="- 1"] by auto
finally show ?thesis unfolding real_of_float_minus real_of_float_1 .
qed
@@ -1492,7 +1502,7 @@
have pos_horner: "\<And> x. 0 < ?horner x" unfolding Let_def by (cases "?lb_horner x \<le> 0", auto simp add: le_float_def less_float_def)
moreover { fix x :: float fix num :: nat
have "0 < real (?horner x) ^ num" using `0 < ?horner x`[unfolded less_float_def real_of_float_0] by (rule zero_less_power)
- also have "\<dots> = real ((?horner x) ^ num)" using float_power by auto
+ also have "\<dots> = (?horner x) ^ num" using float_power by auto
finally have "0 < real ((?horner x) ^ num)" .
}
ultimately show ?thesis
@@ -1501,7 +1511,7 @@
qed
lemma exp_boundaries': assumes "x \<le> 0"
- shows "exp (real x) \<in> { real (lb_exp prec x) .. real (ub_exp prec x)}"
+ shows "exp x \<in> { (lb_exp prec x) .. (ub_exp prec x)}"
proof -
let "?lb_exp_horner x" = "lb_exp_horner prec (get_even (prec + 2)) 1 1 x"
let "?ub_exp_horner x" = "ub_exp_horner prec (get_odd (prec + 2)) 1 1 x"
@@ -1513,9 +1523,9 @@
show ?thesis
proof (cases "?lb_exp_horner x \<le> 0")
from `\<not> x < - 1` have "- 1 \<le> real x" unfolding less_float_def by auto
- hence "exp (- 1) \<le> exp (real x)" unfolding exp_le_cancel_iff .
+ hence "exp (- 1) \<le> exp x" unfolding exp_le_cancel_iff .
from order_trans[OF exp_m1_ge_quarter this]
- have "real (Float 1 -2) \<le> exp (real x)" unfolding Float_num .
+ have "Float 1 -2 \<le> exp x" unfolding Float_num .
moreover case True
ultimately show ?thesis using bnds_exp_horner `real x \<le> 0` `\<not> x > 0` `\<not> x < - 1` by auto
next
@@ -1539,27 +1549,27 @@
hence "(0::nat) < 2 ^ nat e" by auto
ultimately have "0 < ?num" by auto
hence "real ?num \<noteq> 0" by auto
- have e_nat: "int (nat e) = e" using `0 \<le> e` by auto
- have num_eq: "real ?num = real (- floor_fl x)" using `0 < nat (- m)`
+ have e_nat: "(nat e) = e" using `0 \<le> e` by auto
+ have num_eq: "real ?num = - floor_fl x" using `0 < nat (- m)`
unfolding Float_floor real_of_float_minus real_of_float_simp real_of_nat_mult pow2_int[of "nat e", unfolded e_nat] real_of_nat_power by auto
have "0 < - floor_fl x" using `0 < ?num`[unfolded real_of_nat_less_iff[symmetric]] unfolding less_float_def num_eq[symmetric] real_of_float_0 real_of_nat_zero .
hence "real (floor_fl x) < 0" unfolding less_float_def by auto
- have "exp (real x) \<le> real (ub_exp prec x)"
+ have "exp x \<le> ub_exp prec x"
proof -
have div_less_zero: "real (float_divr prec x (- floor_fl x)) \<le> 0"
using float_divr_nonpos_pos_upper_bound[OF `x \<le> 0` `0 < - floor_fl x`] unfolding le_float_def real_of_float_0 .
- have "exp (real x) = exp (real ?num * (real x / real ?num))" using `real ?num \<noteq> 0` by auto
- also have "\<dots> = exp (real x / real ?num) ^ ?num" unfolding exp_real_of_nat_mult ..
- also have "\<dots> \<le> exp (real (float_divr prec x (- floor_fl x))) ^ ?num" unfolding num_eq
+ have "exp x = exp (?num * (x / ?num))" using `real ?num \<noteq> 0` by auto
+ also have "\<dots> = exp (x / ?num) ^ ?num" unfolding exp_real_of_nat_mult ..
+ also have "\<dots> \<le> exp (float_divr prec x (- floor_fl x)) ^ ?num" unfolding num_eq
by (rule power_mono, rule exp_le_cancel_iff[THEN iffD2], rule float_divr) auto
- also have "\<dots> \<le> real ((?ub_exp_horner (float_divr prec x (- floor_fl x))) ^ ?num)" unfolding float_power
+ also have "\<dots> \<le> (?ub_exp_horner (float_divr prec x (- floor_fl x))) ^ ?num" unfolding float_power
by (rule power_mono, rule bnds_exp_horner[OF div_less_zero, unfolded atLeastAtMost_iff, THEN conjunct2], auto)
finally show ?thesis unfolding ub_exp.simps if_not_P[OF `\<not> 0 < x`] if_P[OF `x < - 1`] float.cases Float_floor Let_def .
qed
moreover
- have "real (lb_exp prec x) \<le> exp (real x)"
+ have "lb_exp prec x \<le> exp x"
proof -
let ?divl = "float_divl prec x (- Float m e)"
let ?horner = "?lb_exp_horner ?divl"
@@ -1571,25 +1581,25 @@
have div_less_zero: "real (float_divl prec x (- floor_fl x)) \<le> 0"
using `real (floor_fl x) < 0` `real x \<le> 0` by (auto intro!: order_trans[OF float_divl] divide_nonpos_neg)
- have "real ((?lb_exp_horner (float_divl prec x (- floor_fl x))) ^ ?num) \<le>
- exp (real (float_divl prec x (- floor_fl x))) ^ ?num" unfolding float_power
+ have "(?lb_exp_horner (float_divl prec x (- floor_fl x))) ^ ?num \<le>
+ exp (float_divl prec x (- floor_fl x)) ^ ?num" unfolding float_power
using `0 \<le> real ?horner`[unfolded Float_floor[symmetric]] bnds_exp_horner[OF div_less_zero, unfolded atLeastAtMost_iff, THEN conjunct1] by (auto intro!: power_mono)
- also have "\<dots> \<le> exp (real x / real ?num) ^ ?num" unfolding num_eq
+ also have "\<dots> \<le> exp (x / ?num) ^ ?num" unfolding num_eq
using float_divl by (auto intro!: power_mono simp del: real_of_float_minus)
- also have "\<dots> = exp (real ?num * (real x / real ?num))" unfolding exp_real_of_nat_mult ..
- also have "\<dots> = exp (real x)" using `real ?num \<noteq> 0` by auto
+ also have "\<dots> = exp (?num * (x / ?num))" unfolding exp_real_of_nat_mult ..
+ also have "\<dots> = exp x" using `real ?num \<noteq> 0` by auto
finally show ?thesis
unfolding lb_exp.simps if_not_P[OF `\<not> 0 < x`] if_P[OF `x < - 1`] float.cases Float_floor Let_def if_not_P[OF False] by auto
next
case True
have "real (floor_fl x) \<noteq> 0" and "real (floor_fl x) \<le> 0" using `real (floor_fl x) < 0` by auto
from divide_right_mono_neg[OF floor_fl[of x] `real (floor_fl x) \<le> 0`, unfolded divide_self[OF `real (floor_fl x) \<noteq> 0`]]
- have "- 1 \<le> real x / real (- floor_fl x)" unfolding real_of_float_minus by auto
+ have "- 1 \<le> x / (- floor_fl x)" unfolding real_of_float_minus by auto
from order_trans[OF exp_m1_ge_quarter this[unfolded exp_le_cancel_iff[where x="- 1", symmetric]]]
- have "real (Float 1 -2) \<le> exp (real x / real (- floor_fl x))" unfolding Float_num .
- hence "real (Float 1 -2) ^ ?num \<le> exp (real x / real (- floor_fl x)) ^ ?num"
+ have "Float 1 -2 \<le> exp (x / (- floor_fl x))" unfolding Float_num .
+ hence "real (Float 1 -2) ^ ?num \<le> exp (x / (- floor_fl x)) ^ ?num"
by (auto intro!: power_mono simp add: Float_num)
- also have "\<dots> = exp (real x)" unfolding num_eq exp_real_of_nat_mult[symmetric] using `real (floor_fl x) \<noteq> 0` by auto
+ also have "\<dots> = exp x" unfolding num_eq exp_real_of_nat_mult[symmetric] using `real (floor_fl x) \<noteq> 0` by auto
finally show ?thesis
unfolding lb_exp.simps if_not_P[OF `\<not> 0 < x`] if_P[OF `x < - 1`] float.cases Float_floor Let_def if_P[OF True] float_power .
qed
@@ -1598,7 +1608,7 @@
qed
qed
-lemma exp_boundaries: "exp (real x) \<in> { real (lb_exp prec x) .. real (ub_exp prec x)}"
+lemma exp_boundaries: "exp x \<in> { lb_exp prec x .. ub_exp prec x }"
proof -
show ?thesis
proof (cases "0 < x")
@@ -1607,51 +1617,51 @@
next
case True hence "-x \<le> 0" unfolding less_float_def le_float_def by auto
- have "real (lb_exp prec x) \<le> exp (real x)"
+ have "lb_exp prec x \<le> exp x"
proof -
from exp_boundaries'[OF `-x \<le> 0`]
- have ub_exp: "exp (- real x) \<le> real (ub_exp prec (-x))" unfolding atLeastAtMost_iff real_of_float_minus by auto
-
- have "real (float_divl prec 1 (ub_exp prec (-x))) \<le> 1 / real (ub_exp prec (-x))" using float_divl[where x=1] by auto
- also have "\<dots> \<le> exp (real x)"
+ have ub_exp: "exp (- real x) \<le> ub_exp prec (-x)" unfolding atLeastAtMost_iff real_of_float_minus by auto
+
+ have "float_divl prec 1 (ub_exp prec (-x)) \<le> 1 / ub_exp prec (-x)" using float_divl[where x=1] by auto
+ also have "\<dots> \<le> exp x"
using ub_exp[unfolded inverse_le_iff_le[OF order_less_le_trans[OF exp_gt_zero ub_exp] exp_gt_zero, symmetric]]
unfolding exp_minus nonzero_inverse_inverse_eq[OF exp_not_eq_zero] inverse_eq_divide by auto
finally show ?thesis unfolding lb_exp.simps if_P[OF True] .
qed
moreover
- have "exp (real x) \<le> real (ub_exp prec x)"
+ have "exp x \<le> ub_exp prec x"
proof -
have "\<not> 0 < -x" using `0 < x` unfolding less_float_def by auto
from exp_boundaries'[OF `-x \<le> 0`]
- have lb_exp: "real (lb_exp prec (-x)) \<le> exp (- real x)" unfolding atLeastAtMost_iff real_of_float_minus by auto
-
- have "exp (real x) \<le> real (1 :: float) / real (lb_exp prec (-x))"
+ have lb_exp: "lb_exp prec (-x) \<le> exp (- real x)" unfolding atLeastAtMost_iff real_of_float_minus by auto
+
+ have "exp x \<le> (1 :: float) / lb_exp prec (-x)"
using lb_exp[unfolded inverse_le_iff_le[OF exp_gt_zero lb_exp_pos[OF `\<not> 0 < -x`, unfolded less_float_def real_of_float_0],
symmetric]]
unfolding exp_minus nonzero_inverse_inverse_eq[OF exp_not_eq_zero] inverse_eq_divide real_of_float_1 by auto
- also have "\<dots> \<le> real (float_divr prec 1 (lb_exp prec (-x)))" using float_divr .
+ also have "\<dots> \<le> float_divr prec 1 (lb_exp prec (-x))" using float_divr .
finally show ?thesis unfolding ub_exp.simps if_P[OF True] .
qed
ultimately show ?thesis by auto
qed
qed
-lemma bnds_exp: "\<forall> x lx ux. (l, u) = (lb_exp prec lx, ub_exp prec ux) \<and> x \<in> {real lx .. real ux} \<longrightarrow> real l \<le> exp x \<and> exp x \<le> real u"
+lemma bnds_exp: "\<forall> (x::real) lx ux. (l, u) = (lb_exp prec lx, ub_exp prec ux) \<and> x \<in> {lx .. ux} \<longrightarrow> l \<le> exp x \<and> exp x \<le> u"
proof (rule allI, rule allI, rule allI, rule impI)
- fix x lx ux
- assume "(l, u) = (lb_exp prec lx, ub_exp prec ux) \<and> x \<in> {real lx .. real ux}"
- hence l: "lb_exp prec lx = l " and u: "ub_exp prec ux = u" and x: "x \<in> {real lx .. real ux}" by auto
+ fix x::real and lx ux
+ assume "(l, u) = (lb_exp prec lx, ub_exp prec ux) \<and> x \<in> {lx .. ux}"
+ hence l: "lb_exp prec lx = l " and u: "ub_exp prec ux = u" and x: "x \<in> {lx .. ux}" by auto
{ from exp_boundaries[of lx prec, unfolded l]
- have "real l \<le> exp (real lx)" by (auto simp del: lb_exp.simps)
+ have "l \<le> exp lx" by (auto simp del: lb_exp.simps)
also have "\<dots> \<le> exp x" using x by auto
- finally have "real l \<le> exp x" .
+ finally have "l \<le> exp x" .
} moreover
- { have "exp x \<le> exp (real ux)" using x by auto
- also have "\<dots> \<le> real u" using exp_boundaries[of ux prec, unfolded u] by (auto simp del: ub_exp.simps)
- finally have "exp x \<le> real u" .
- } ultimately show "real l \<le> exp x \<and> exp x \<le> real u" ..
+ { have "exp x \<le> exp ux" using x by auto
+ also have "\<dots> \<le> u" using exp_boundaries[of ux prec, unfolded u] by (auto simp del: ub_exp.simps)
+ finally have "exp x \<le> u" .
+ } ultimately show "l \<le> exp x \<and> exp x \<le> u" ..
qed
section "Logarithm"
@@ -1692,8 +1702,8 @@
lemma ln_float_bounds:
assumes "0 \<le> real x" and "real x < 1"
- shows "real (x * lb_ln_horner prec (get_even n) 1 x) \<le> ln (real x + 1)" (is "?lb \<le> ?ln")
- and "ln (real x + 1) \<le> real (x * ub_ln_horner prec (get_odd n) 1 x)" (is "?ln \<le> ?ub")
+ shows "x * lb_ln_horner prec (get_even n) 1 x \<le> ln (x + 1)" (is "?lb \<le> ?ln")
+ and "ln (x + 1) \<le> x * ub_ln_horner prec (get_odd n) 1 x" (is "?ln \<le> ?ub")
proof -
obtain ev where ev: "get_even n = 2 * ev" using get_even_double ..
obtain od where od: "get_odd n = 2 * od + 1" using get_odd_double ..
@@ -1734,18 +1744,18 @@
in (Float 1 -1 * lb_ln_horner prec (get_even prec) 1 (Float 1 -1)) +
(third * lb_ln_horner prec (get_even prec) 1 third))"
-lemma ub_ln2: "ln 2 \<le> real (ub_ln2 prec)" (is "?ub_ln2")
- and lb_ln2: "real (lb_ln2 prec) \<le> ln 2" (is "?lb_ln2")
+lemma ub_ln2: "ln 2 \<le> ub_ln2 prec" (is "?ub_ln2")
+ and lb_ln2: "lb_ln2 prec \<le> ln 2" (is "?lb_ln2")
proof -
let ?uthird = "rapprox_rat (max prec 1) 1 3"
let ?lthird = "lapprox_rat prec 1 3"
have ln2_sum: "ln 2 = ln (1/2 + 1) + ln (1 / 3 + 1)"
using ln_add[of "3 / 2" "1 / 2"] by auto
- have lb3: "real ?lthird \<le> 1 / 3" using lapprox_rat[of prec 1 3] by auto
+ have lb3: "?lthird \<le> 1 / 3" using lapprox_rat[of prec 1 3] by auto
hence lb3_ub: "real ?lthird < 1" by auto
have lb3_lb: "0 \<le> real ?lthird" using lapprox_rat_bottom[of 1 3] by auto
- have ub3: "1 / 3 \<le> real ?uthird" using rapprox_rat[of 1 3] by auto
+ have ub3: "1 / 3 \<le> ?uthird" using rapprox_rat[of 1 3] by auto
hence ub3_lb: "0 \<le> real ?uthird" by auto
have lb2: "0 \<le> real (Float 1 -1)" and ub2: "real (Float 1 -1) < 1" unfolding Float_num by auto
@@ -1761,16 +1771,16 @@
show ?ub_ln2 unfolding ub_ln2_def Let_def real_of_float_add ln2_sum Float_num(4)[symmetric]
proof (rule add_mono, fact ln_float_bounds(2)[OF lb2 ub2])
have "ln (1 / 3 + 1) \<le> ln (real ?uthird + 1)" unfolding ln_le_cancel_iff[OF third_gt0 uthird_gt0] using ub3 by auto
- also have "\<dots> \<le> real (?uthird * ub_ln_horner prec (get_odd prec) 1 ?uthird)"
+ also have "\<dots> \<le> ?uthird * ub_ln_horner prec (get_odd prec) 1 ?uthird"
using ln_float_bounds(2)[OF ub3_lb ub3_ub] .
- finally show "ln (1 / 3 + 1) \<le> real (?uthird * ub_ln_horner prec (get_odd prec) 1 ?uthird)" .
+ finally show "ln (1 / 3 + 1) \<le> ?uthird * ub_ln_horner prec (get_odd prec) 1 ?uthird" .
qed
show ?lb_ln2 unfolding lb_ln2_def Let_def real_of_float_add ln2_sum Float_num(4)[symmetric]
proof (rule add_mono, fact ln_float_bounds(1)[OF lb2 ub2])
- have "real (?lthird * lb_ln_horner prec (get_even prec) 1 ?lthird) \<le> ln (real ?lthird + 1)"
+ have "?lthird * lb_ln_horner prec (get_even prec) 1 ?lthird \<le> ln (real ?lthird + 1)"
using ln_float_bounds(1)[OF lb3_lb lb3_ub] .
also have "\<dots> \<le> ln (1 / 3 + 1)" unfolding ln_le_cancel_iff[OF lthird_gt0 third_gt0] using lb3 by auto
- finally show "real (?lthird * lb_ln_horner prec (get_even prec) 1 ?lthird) \<le> ln (1 / 3 + 1)" .
+ finally show "?lthird * lb_ln_horner prec (get_even prec) 1 ?lthird \<le> ln (1 / 3 + 1)" .
qed
qed
@@ -1806,7 +1816,7 @@
show False using `float_divr prec 1 x < 1` unfolding less_float_def le_float_def by auto
qed
-lemma ln_shifted_float: assumes "0 < m" shows "ln (real (Float m e)) = ln 2 * real (e + (bitlen m - 1)) + ln (real (Float m (- (bitlen m - 1))))"
+lemma ln_shifted_float: assumes "0 < m" shows "ln (Float m e) = ln 2 * (e + (bitlen m - 1)) + ln (Float m (- (bitlen m - 1)))"
proof -
let ?B = "2^nat (bitlen m - 1)"
have "0 < real m" and "\<And>X. (0 :: real) < 2^X" and "0 < (2 :: real)" and "m \<noteq> 0" using assms by auto
@@ -1830,7 +1840,7 @@
qed
lemma ub_ln_lb_ln_bounds': assumes "1 \<le> x"
- shows "real (the (lb_ln prec x)) \<le> ln (real x) \<and> ln (real x) \<le> real (the (ub_ln prec x))"
+ shows "the (lb_ln prec x) \<le> ln x \<and> ln x \<le> the (ub_ln prec x)"
(is "?lb \<le> ?ln \<and> ?ln \<le> ?ub")
proof (cases "x < Float 1 1")
case True
@@ -1838,7 +1848,7 @@
have "\<not> x \<le> 0" and "\<not> x < 1" using `1 \<le> x` unfolding less_float_def le_float_def by auto
hence "0 \<le> real (x - 1)" using `1 \<le> x` unfolding less_float_def Float_num by auto
- have [simp]: "real (Float 3 -1) = 3 / 2" by (simp add: real_of_float_def pow2_def)
+ have [simp]: "(Float 3 -1) = 3 / 2" by (simp add: real_of_float_def pow2_def)
show ?thesis
proof (cases "x \<le> Float 3 -1")
@@ -1847,10 +1857,10 @@
using ln_float_bounds[OF `0 \<le> real (x - 1)` `real (x - 1) < 1`, of prec] `\<not> x \<le> 0` `\<not> x < 1` True
by auto
next
- case False hence *: "3 / 2 < real x" by (auto simp add: le_float_def)
-
- with ln_add[of "3 / 2" "real x - 3 / 2"]
- have add: "ln (real x) = ln (3 / 2) + ln (real x * 2 / 3)"
+ case False hence *: "3 / 2 < x" by (auto simp add: le_float_def)
+
+ with ln_add[of "3 / 2" "x - 3 / 2"]
+ have add: "ln x = ln (3 / 2) + ln (real x * 2 / 3)"
by (auto simp add: algebra_simps diff_divide_distrib)
let "?ub_horner x" = "x * ub_ln_horner prec (get_odd prec) 1 x"
@@ -1858,7 +1868,7 @@
{ have up: "real (rapprox_rat prec 2 3) \<le> 1"
by (rule rapprox_rat_le1) simp_all
- have low: "2 / 3 \<le> real (rapprox_rat prec 2 3)"
+ have low: "2 / 3 \<le> rapprox_rat prec 2 3"
by (rule order_trans[OF _ rapprox_rat]) simp
from mult_less_le_imp_less[OF * low] *
have pos: "0 < real (x * rapprox_rat prec 2 3 - 1)" by auto
@@ -1871,26 +1881,26 @@
show "0 < real x * 2 / 3" using * by simp
show "0 < real (x * rapprox_rat prec 2 3 - 1) + 1" using pos by auto
qed
- also have "\<dots> \<le> real (?ub_horner (x * rapprox_rat prec 2 3 - 1))"
+ also have "\<dots> \<le> ?ub_horner (x * rapprox_rat prec 2 3 - 1)"
proof (rule ln_float_bounds(2))
from mult_less_le_imp_less[OF `real x < 2` up] low *
show "real (x * rapprox_rat prec 2 3 - 1) < 1" by auto
show "0 \<le> real (x * rapprox_rat prec 2 3 - 1)" using pos by auto
qed
- finally have "ln (real x)
- \<le> real (?ub_horner (Float 1 -1))
- + real (?ub_horner (x * rapprox_rat prec 2 3 - 1))"
+ finally have "ln x
+ \<le> ?ub_horner (Float 1 -1)
+ + ?ub_horner (x * rapprox_rat prec 2 3 - 1)"
using ln_float_bounds(2)[of "Float 1 -1" prec prec] add by auto }
moreover
{ let ?max = "max (x * lapprox_rat prec 2 3 - 1) 0"
- have up: "real (lapprox_rat prec 2 3) \<le> 2/3"
+ have up: "lapprox_rat prec 2 3 \<le> 2/3"
by (rule order_trans[OF lapprox_rat], simp)
have low: "0 \<le> real (lapprox_rat prec 2 3)"
using lapprox_rat_bottom[of 2 3 prec] by simp
- have "real (?lb_horner ?max)
+ have "?lb_horner ?max
\<le> ln (real ?max + 1)"
proof (rule ln_float_bounds(1))
from mult_less_le_imp_less[OF `real x < 2` up] * low
@@ -1906,8 +1916,8 @@
by (cases "0 < real x * real (lapprox_posrat prec 2 3) - 1",
auto simp add: real_of_float_max min_max.sup_absorb1)
qed
- finally have "real (?lb_horner (Float 1 -1)) + real (?lb_horner ?max)
- \<le> ln (real x)"
+ finally have "?lb_horner (Float 1 -1) + ?lb_horner ?max
+ \<le> ln x"
using ln_float_bounds(1)[of "Float 1 -1" prec prec] add by auto }
ultimately
show ?thesis unfolding lb_ln.simps unfolding ub_ln.simps Let_def
@@ -1927,7 +1937,7 @@
have "0 < m" and "m \<noteq> 0" using float_pos_m_pos `0 < x` Float by auto
{
- have "real (lb_ln2 prec * ?s) \<le> ln 2 * real (e + (bitlen m - 1))" (is "?lb2 \<le> _")
+ have "lb_ln2 prec * ?s \<le> ln 2 * (e + (bitlen m - 1))" (is "?lb2 \<le> _")
unfolding real_of_float_mult real_of_float_ge0_exp[OF order_refl] nat_0 power_0 mult_1_right
using lb_ln2[of prec]
proof (rule mult_right_mono)
@@ -1939,8 +1949,8 @@
from bitlen_div[OF `0 < m`, unfolded normalized_float[OF `m \<noteq> 0`, symmetric]]
have "0 \<le> real (?x - 1)" and "real (?x - 1) < 1" by auto
from ln_float_bounds(1)[OF this]
- have "real ((?x - 1) * lb_ln_horner prec (get_even prec) 1 (?x - 1)) \<le> ln (real ?x)" (is "?lb_horner \<le> _") by auto
- ultimately have "?lb2 + ?lb_horner \<le> ln (real x)"
+ have "(?x - 1) * lb_ln_horner prec (get_even prec) 1 (?x - 1) \<le> ln ?x" (is "?lb_horner \<le> _") by auto
+ ultimately have "?lb2 + ?lb_horner \<le> ln x"
unfolding Float ln_shifted_float[OF `0 < m`, of e] by auto
}
moreover
@@ -1948,9 +1958,9 @@
from bitlen_div[OF `0 < m`, unfolded normalized_float[OF `m \<noteq> 0`, symmetric]]
have "0 \<le> real (?x - 1)" and "real (?x - 1) < 1" by auto
from ln_float_bounds(2)[OF this]
- have "ln (real ?x) \<le> real ((?x - 1) * ub_ln_horner prec (get_odd prec) 1 (?x - 1))" (is "_ \<le> ?ub_horner") by auto
+ have "ln ?x \<le> (?x - 1) * ub_ln_horner prec (get_odd prec) 1 (?x - 1)" (is "_ \<le> ?ub_horner") by auto
moreover
- have "ln 2 * real (e + (bitlen m - 1)) \<le> real (ub_ln2 prec * ?s)" (is "_ \<le> ?ub2")
+ have "ln 2 * (e + (bitlen m - 1)) \<le> ub_ln2 prec * ?s" (is "_ \<le> ?ub2")
unfolding real_of_float_mult real_of_float_ge0_exp[OF order_refl] nat_0 power_0 mult_1_right
using ub_ln2[of prec]
proof (rule mult_right_mono)
@@ -1958,7 +1968,7 @@
from float_gt1_scale[OF this]
show "0 \<le> real (e + (bitlen m - 1))" by auto
qed
- ultimately have "ln (real x) \<le> ?ub2 + ?ub_horner"
+ ultimately have "ln x \<le> ?ub2 + ?ub_horner"
unfolding Float ln_shifted_float[OF `0 < m`, of e] by auto
}
ultimately show ?thesis unfolding lb_ln.simps unfolding ub_ln.simps
@@ -1969,7 +1979,7 @@
qed
lemma ub_ln_lb_ln_bounds: assumes "0 < x"
- shows "real (the (lb_ln prec x)) \<le> ln (real x) \<and> ln (real x) \<le> real (the (ub_ln prec x))"
+ shows "the (lb_ln prec x) \<le> ln x \<and> ln x \<le> the (ub_ln prec x)"
(is "?lb \<le> ?ln \<and> ?ln \<le> ?ub")
proof (cases "x < 1")
case False hence "1 \<le> x" unfolding less_float_def le_float_def by auto
@@ -1985,27 +1995,27 @@
have A': "1 \<le> ?divl" using float_divl_pos_less1_bound[OF `0 < x` `x < 1`] unfolding le_float_def less_float_def by auto
hence B: "0 < real ?divl" unfolding le_float_def by auto
- have "ln (real ?divl) \<le> ln (1 / real x)" unfolding ln_le_cancel_iff[OF B A] using float_divl[of _ 1 x] by auto
- hence "ln (real x) \<le> - ln (real ?divl)" unfolding nonzero_inverse_eq_divide[OF `real x \<noteq> 0`, symmetric] ln_inverse[OF `0 < real x`] by auto
+ have "ln ?divl \<le> ln (1 / x)" unfolding ln_le_cancel_iff[OF B A] using float_divl[of _ 1 x] by auto
+ hence "ln x \<le> - ln ?divl" unfolding nonzero_inverse_eq_divide[OF `real x \<noteq> 0`, symmetric] ln_inverse[OF `0 < real x`] by auto
from this ub_ln_lb_ln_bounds'[OF A', THEN conjunct1, THEN le_imp_neg_le]
- have "?ln \<le> real (- the (lb_ln prec ?divl))" unfolding real_of_float_minus by (rule order_trans)
+ have "?ln \<le> - the (lb_ln prec ?divl)" unfolding real_of_float_minus by (rule order_trans)
} moreover
{
let ?divr = "float_divr prec 1 x"
have A': "1 \<le> ?divr" using float_divr_pos_less1_lower_bound[OF `0 < x` `x < 1`] unfolding le_float_def less_float_def by auto
hence B: "0 < real ?divr" unfolding le_float_def by auto
- have "ln (1 / real x) \<le> ln (real ?divr)" unfolding ln_le_cancel_iff[OF A B] using float_divr[of 1 x] by auto
- hence "- ln (real ?divr) \<le> ln (real x)" unfolding nonzero_inverse_eq_divide[OF `real x \<noteq> 0`, symmetric] ln_inverse[OF `0 < real x`] by auto
+ have "ln (1 / x) \<le> ln ?divr" unfolding ln_le_cancel_iff[OF A B] using float_divr[of 1 x] by auto
+ hence "- ln ?divr \<le> ln x" unfolding nonzero_inverse_eq_divide[OF `real x \<noteq> 0`, symmetric] ln_inverse[OF `0 < real x`] by auto
from ub_ln_lb_ln_bounds'[OF A', THEN conjunct2, THEN le_imp_neg_le] this
- have "real (- the (ub_ln prec ?divr)) \<le> ?ln" unfolding real_of_float_minus by (rule order_trans)
+ have "- the (ub_ln prec ?divr) \<le> ?ln" unfolding real_of_float_minus by (rule order_trans)
}
ultimately show ?thesis unfolding lb_ln.simps[where x=x] ub_ln.simps[where x=x]
unfolding if_not_P[OF `\<not> x \<le> 0`] if_P[OF True] by auto
qed
lemma lb_ln: assumes "Some y = lb_ln prec x"
- shows "real y \<le> ln (real x)" and "0 < real x"
+ shows "y \<le> ln x" and "0 < real x"
proof -
have "0 < x"
proof (rule ccontr)
@@ -2013,12 +2023,12 @@
thus False using assms by auto
qed
thus "0 < real x" unfolding less_float_def by auto
- have "real (the (lb_ln prec x)) \<le> ln (real x)" using ub_ln_lb_ln_bounds[OF `0 < x`] ..
- thus "real y \<le> ln (real x)" unfolding assms[symmetric] by auto
+ have "the (lb_ln prec x) \<le> ln x" using ub_ln_lb_ln_bounds[OF `0 < x`] ..
+ thus "y \<le> ln x" unfolding assms[symmetric] by auto
qed
lemma ub_ln: assumes "Some y = ub_ln prec x"
- shows "ln (real x) \<le> real y" and "0 < real x"
+ shows "ln x \<le> y" and "0 < real x"
proof -
have "0 < x"
proof (rule ccontr)
@@ -2026,25 +2036,25 @@
thus False using assms by auto
qed
thus "0 < real x" unfolding less_float_def by auto
- have "ln (real x) \<le> real (the (ub_ln prec x))" using ub_ln_lb_ln_bounds[OF `0 < x`] ..
- thus "ln (real x) \<le> real y" unfolding assms[symmetric] by auto
+ have "ln x \<le> the (ub_ln prec x)" using ub_ln_lb_ln_bounds[OF `0 < x`] ..
+ thus "ln x \<le> y" unfolding assms[symmetric] by auto
qed
-lemma bnds_ln: "\<forall> x lx ux. (Some l, Some u) = (lb_ln prec lx, ub_ln prec ux) \<and> x \<in> {real lx .. real ux} \<longrightarrow> real l \<le> ln x \<and> ln x \<le> real u"
+lemma bnds_ln: "\<forall> (x::real) lx ux. (Some l, Some u) = (lb_ln prec lx, ub_ln prec ux) \<and> x \<in> {lx .. ux} \<longrightarrow> l \<le> ln x \<and> ln x \<le> u"
proof (rule allI, rule allI, rule allI, rule impI)
- fix x lx ux
- assume "(Some l, Some u) = (lb_ln prec lx, ub_ln prec ux) \<and> x \<in> {real lx .. real ux}"
- hence l: "Some l = lb_ln prec lx " and u: "Some u = ub_ln prec ux" and x: "x \<in> {real lx .. real ux}" by auto
-
- have "ln (real ux) \<le> real u" and "0 < real ux" using ub_ln u by auto
- have "real l \<le> ln (real lx)" and "0 < real lx" and "0 < x" using lb_ln[OF l] x by auto
-
- from ln_le_cancel_iff[OF `0 < real lx` `0 < x`] `real l \<le> ln (real lx)`
- have "real l \<le> ln x" using x unfolding atLeastAtMost_iff by auto
+ fix x::real and lx ux
+ assume "(Some l, Some u) = (lb_ln prec lx, ub_ln prec ux) \<and> x \<in> {lx .. ux}"
+ hence l: "Some l = lb_ln prec lx " and u: "Some u = ub_ln prec ux" and x: "x \<in> {lx .. ux}" by auto
+
+ have "ln ux \<le> u" and "0 < real ux" using ub_ln u by auto
+ have "l \<le> ln lx" and "0 < real lx" and "0 < x" using lb_ln[OF l] x by auto
+
+ from ln_le_cancel_iff[OF `0 < real lx` `0 < x`] `l \<le> ln lx`
+ have "l \<le> ln x" using x unfolding atLeastAtMost_iff by auto
moreover
- from ln_le_cancel_iff[OF `0 < x` `0 < real ux`] `ln (real ux) \<le> real u`
- have "ln x \<le> real u" using x unfolding atLeastAtMost_iff by auto
- ultimately show "real l \<le> ln x \<and> ln x \<le> real u" ..
+ from ln_le_cancel_iff[OF `0 < x` `0 < real ux`] `ln ux \<le> real u`
+ have "ln x \<le> u" using x unfolding atLeastAtMost_iff by auto
+ ultimately show "l \<le> ln x \<and> ln x \<le> u" ..
qed
section "Implement floatarith"
@@ -2084,7 +2094,7 @@
"interpret_floatarith (Exp a) vs = exp (interpret_floatarith a vs)" |
"interpret_floatarith (Ln a) vs = ln (interpret_floatarith a vs)" |
"interpret_floatarith (Power a n) vs = (interpret_floatarith a vs)^n" |
-"interpret_floatarith (Num f) vs = real f" |
+"interpret_floatarith (Num f) vs = f" |
"interpret_floatarith (Var n) vs = vs ! n"
lemma interpret_floatarith_divide: "interpret_floatarith (Mult a (Inverse b)) vs = (interpret_floatarith a vs) / (interpret_floatarith b vs)"
@@ -2223,9 +2233,9 @@
qed
lemma approx_approx':
- assumes Pa: "\<And>l u. Some (l, u) = approx prec a vs \<Longrightarrow> real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u"
+ assumes Pa: "\<And>l u. Some (l, u) = approx prec a vs \<Longrightarrow> l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u"
and approx': "Some (l, u) = approx' prec a vs"
- shows "real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u"
+ shows "l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u"
proof -
obtain l' u' where S: "Some (l', u') = approx prec a vs"
using approx' unfolding approx'.simps by (cases "approx prec a vs", auto)
@@ -2238,18 +2248,18 @@
lemma lift_bin':
assumes lift_bin'_Some: "Some (l, u) = lift_bin' (approx' prec a bs) (approx' prec b bs) f"
- and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u" (is "\<And>l u. _ = ?g a \<Longrightarrow> ?P l u a")
- and Pb: "\<And>l u. Some (l, u) = approx prec b bs \<Longrightarrow> real l \<le> interpret_floatarith b xs \<and> interpret_floatarith b xs \<le> real u"
- shows "\<exists> l1 u1 l2 u2. (real l1 \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u1) \<and>
- (real l2 \<le> interpret_floatarith b xs \<and> interpret_floatarith b xs \<le> real u2) \<and>
+ and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u" (is "\<And>l u. _ = ?g a \<Longrightarrow> ?P l u a")
+ and Pb: "\<And>l u. Some (l, u) = approx prec b bs \<Longrightarrow> l \<le> interpret_floatarith b xs \<and> interpret_floatarith b xs \<le> u"
+ shows "\<exists> l1 u1 l2 u2. (l1 \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u1) \<and>
+ (l2 \<le> interpret_floatarith b xs \<and> interpret_floatarith b xs \<le> u2) \<and>
l = fst (f l1 u1 l2 u2) \<and> u = snd (f l1 u1 l2 u2)"
proof -
{ fix l u assume "Some (l, u) = approx' prec a bs"
with approx_approx'[of prec a bs, OF _ this] Pa
- have "real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u" by auto } note Pa = this
+ have "l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u" by auto } note Pa = this
{ fix l u assume "Some (l, u) = approx' prec b bs"
with approx_approx'[of prec b bs, OF _ this] Pb
- have "real l \<le> interpret_floatarith b xs \<and> interpret_floatarith b xs \<le> real u" by auto } note Pb = this
+ have "l \<le> interpret_floatarith b xs \<and> interpret_floatarith b xs \<le> u" by auto } note Pb = this
from lift_bin'_f[where g="\<lambda>a. approx' prec a bs" and P = ?P, OF lift_bin'_Some, OF Pa Pb]
show ?thesis by auto
@@ -2280,26 +2290,26 @@
lemma lift_un':
assumes lift_un'_Some: "Some (l, u) = lift_un' (approx' prec a bs) f"
- and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u" (is "\<And>l u. _ = ?g a \<Longrightarrow> ?P l u a")
- shows "\<exists> l1 u1. (real l1 \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u1) \<and>
+ and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u" (is "\<And>l u. _ = ?g a \<Longrightarrow> ?P l u a")
+ shows "\<exists> l1 u1. (l1 \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u1) \<and>
l = fst (f l1 u1) \<and> u = snd (f l1 u1)"
proof -
{ fix l u assume "Some (l, u) = approx' prec a bs"
with approx_approx'[of prec a bs, OF _ this] Pa
- have "real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u" by auto } note Pa = this
+ have "l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u" by auto } note Pa = this
from lift_un'_f[where g="\<lambda>a. approx' prec a bs" and P = ?P, OF lift_un'_Some, OF Pa]
show ?thesis by auto
qed
lemma lift_un'_bnds:
- assumes bnds: "\<forall> x lx ux. (l, u) = f lx ux \<and> x \<in> { real lx .. real ux } \<longrightarrow> real l \<le> f' x \<and> f' x \<le> real u"
+ assumes bnds: "\<forall> (x::real) lx ux. (l, u) = f lx ux \<and> x \<in> { lx .. ux } \<longrightarrow> l \<le> f' x \<and> f' x \<le> u"
and lift_un'_Some: "Some (l, u) = lift_un' (approx' prec a bs) f"
- and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u"
+ and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u"
shows "real l \<le> f' (interpret_floatarith a xs) \<and> f' (interpret_floatarith a xs) \<le> real u"
proof -
from lift_un'[OF lift_un'_Some Pa]
- obtain l1 u1 where "real l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> real u1" and "l = fst (f l1 u1)" and "u = snd (f l1 u1)" by blast
- hence "(l, u) = f l1 u1" and "interpret_floatarith a xs \<in> {real l1 .. real u1}" by auto
+ obtain l1 u1 where "l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> u1" and "l = fst (f l1 u1)" and "u = snd (f l1 u1)" by blast
+ hence "(l, u) = f l1 u1" and "interpret_floatarith a xs \<in> {l1 .. u1}" by auto
thus ?thesis using bnds by auto
qed
@@ -2345,46 +2355,46 @@
lemma lift_un:
assumes lift_un_Some: "Some (l, u) = lift_un (approx' prec a bs) f"
- and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u" (is "\<And>l u. _ = ?g a \<Longrightarrow> ?P l u a")
- shows "\<exists> l1 u1. (real l1 \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u1) \<and>
+ and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u" (is "\<And>l u. _ = ?g a \<Longrightarrow> ?P l u a")
+ shows "\<exists> l1 u1. (l1 \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u1) \<and>
Some l = fst (f l1 u1) \<and> Some u = snd (f l1 u1)"
proof -
{ fix l u assume "Some (l, u) = approx' prec a bs"
with approx_approx'[of prec a bs, OF _ this] Pa
- have "real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u" by auto } note Pa = this
+ have "l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u" by auto } note Pa = this
from lift_un_f[where g="\<lambda>a. approx' prec a bs" and P = ?P, OF lift_un_Some, OF Pa]
show ?thesis by auto
qed
lemma lift_un_bnds:
- assumes bnds: "\<forall> x lx ux. (Some l, Some u) = f lx ux \<and> x \<in> { real lx .. real ux } \<longrightarrow> real l \<le> f' x \<and> f' x \<le> real u"
+ assumes bnds: "\<forall> (x::real) lx ux. (Some l, Some u) = f lx ux \<and> x \<in> { lx .. ux } \<longrightarrow> l \<le> f' x \<and> f' x \<le> u"
and lift_un_Some: "Some (l, u) = lift_un (approx' prec a bs) f"
- and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> real l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> real u"
+ and Pa: "\<And>l u. Some (l, u) = approx prec a bs \<Longrightarrow> l \<le> interpret_floatarith a xs \<and> interpret_floatarith a xs \<le> u"
shows "real l \<le> f' (interpret_floatarith a xs) \<and> f' (interpret_floatarith a xs) \<le> real u"
proof -
from lift_un[OF lift_un_Some Pa]
- obtain l1 u1 where "real l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> real u1" and "Some l = fst (f l1 u1)" and "Some u = snd (f l1 u1)" by blast
- hence "(Some l, Some u) = f l1 u1" and "interpret_floatarith a xs \<in> {real l1 .. real u1}" by auto
+ obtain l1 u1 where "l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> u1" and "Some l = fst (f l1 u1)" and "Some u = snd (f l1 u1)" by blast
+ hence "(Some l, Some u) = f l1 u1" and "interpret_floatarith a xs \<in> {l1 .. u1}" by auto
thus ?thesis using bnds by auto
qed
lemma approx:
assumes "bounded_by xs vs"
and "Some (l, u) = approx prec arith vs" (is "_ = ?g arith")
- shows "real l \<le> interpret_floatarith arith xs \<and> interpret_floatarith arith xs \<le> real u" (is "?P l u arith")
+ shows "l \<le> interpret_floatarith arith xs \<and> interpret_floatarith arith xs \<le> u" (is "?P l u arith")
using `Some (l, u) = approx prec arith vs`
proof (induct arith arbitrary: l u x)
case (Add a b)
from lift_bin'[OF Add.prems[unfolded approx.simps]] Add.hyps
obtain l1 u1 l2 u2 where "l = l1 + l2" and "u = u1 + u2"
- "real l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> real u1"
- "real l2 \<le> interpret_floatarith b xs" and "interpret_floatarith b xs \<le> real u2" unfolding fst_conv snd_conv by blast
+ "l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> u1"
+ "l2 \<le> interpret_floatarith b xs" and "interpret_floatarith b xs \<le> u2" unfolding fst_conv snd_conv by blast
thus ?case unfolding interpret_floatarith.simps by auto
next
case (Minus a)
from lift_un'[OF Minus.prems[unfolded approx.simps]] Minus.hyps
obtain l1 u1 where "l = -u1" and "u = -l1"
- "real l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> real u1" unfolding fst_conv snd_conv by blast
+ "l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> u1" unfolding fst_conv snd_conv by blast
thus ?case unfolding interpret_floatarith.simps using real_of_float_minus by auto
next
case (Mult a b)
@@ -2392,8 +2402,8 @@
obtain l1 u1 l2 u2
where l: "l = float_nprt l1 * float_pprt u2 + float_nprt u1 * float_nprt u2 + float_pprt l1 * float_pprt l2 + float_pprt u1 * float_nprt l2"
and u: "u = float_pprt u1 * float_pprt u2 + float_pprt l1 * float_nprt u2 + float_nprt u1 * float_pprt l2 + float_nprt l1 * float_nprt l2"
- and "real l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> real u1"
- and "real l2 \<le> interpret_floatarith b xs" and "interpret_floatarith b xs \<le> real u2" unfolding fst_conv snd_conv by blast
+ and "l1 \<le> interpret_floatarith a xs" and "interpret_floatarith a xs \<le> u1"
+ and "l2 \<le> interpret_floatarith b xs" and "interpret_floatarith b xs \<le> u2" unfolding fst_conv snd_conv by blast
thus ?case unfolding interpret_floatarith.simps l u real_of_float_add real_of_float_mult real_of_float_nprt real_of_float_pprt
using mult_le_prts mult_ge_prts by auto
next
@@ -2401,13 +2411,13 @@
from lift_un[OF Inverse.prems[unfolded approx.simps], unfolded if_distrib[of fst] if_distrib[of snd] fst_conv snd_conv] Inverse.hyps
obtain l1 u1 where l': "Some l = (if 0 < l1 \<or> u1 < 0 then Some (float_divl prec 1 u1) else None)"
and u': "Some u = (if 0 < l1 \<or> u1 < 0 then Some (float_divr prec 1 l1) else None)"
- and l1: "real l1 \<le> interpret_floatarith a xs" and u1: "interpret_floatarith a xs \<le> real u1" by blast
+ and l1: "l1 \<le> interpret_floatarith a xs" and u1: "interpret_floatarith a xs \<le> u1" by blast
have either: "0 < l1 \<or> u1 < 0" proof (rule ccontr) assume P: "\<not> (0 < l1 \<or> u1 < 0)" show False using l' unfolding if_not_P[OF P] by auto qed
moreover have l1_le_u1: "real l1 \<le> real u1" using l1 u1 by auto
ultimately have "real l1 \<noteq> 0" and "real u1 \<noteq> 0" unfolding less_float_def by auto
- have inv: "inverse (real u1) \<le> inverse (interpret_floatarith a xs)
- \<and> inverse (interpret_floatarith a xs) \<le> inverse (real l1)"
+ have inv: "inverse u1 \<le> inverse (interpret_floatarith a xs)
+ \<and> inverse (interpret_floatarith a xs) \<le> inverse l1"
proof (cases "0 < l1")
case True hence "0 < real u1" and "0 < real l1" "0 < interpret_floatarith a xs"
unfolding less_float_def using l1_le_u1 l1 by auto
@@ -2426,33 +2436,33 @@
qed
from l' have "l = float_divl prec 1 u1" by (cases "0 < l1 \<or> u1 < 0", auto)
- hence "real l \<le> inverse (real u1)" unfolding nonzero_inverse_eq_divide[OF `real u1 \<noteq> 0`] using float_divl[of prec 1 u1] by auto
+ hence "l \<le> inverse u1" unfolding nonzero_inverse_eq_divide[OF `real u1 \<noteq> 0`] using float_divl[of prec 1 u1] by auto
also have "\<dots> \<le> inverse (interpret_floatarith a xs)" using inv by auto
- finally have "real l \<le> inverse (interpret_floatarith a xs)" .
+ finally have "l \<le> inverse (interpret_floatarith a xs)" .
moreover
from u' have "u = float_divr prec 1 l1" by (cases "0 < l1 \<or> u1 < 0", auto)
- hence "inverse (real l1) \<le> real u" unfolding nonzero_inverse_eq_divide[OF `real l1 \<noteq> 0`] using float_divr[of 1 l1 prec] by auto
- hence "inverse (interpret_floatarith a xs) \<le> real u" by (rule order_trans[OF inv[THEN conjunct2]])
+ hence "inverse l1 \<le> u" unfolding nonzero_inverse_eq_divide[OF `real l1 \<noteq> 0`] using float_divr[of 1 l1 prec] by auto
+ hence "inverse (interpret_floatarith a xs) \<le> u" by (rule order_trans[OF inv[THEN conjunct2]])
ultimately show ?case unfolding interpret_floatarith.simps using l1 u1 by auto
next
case (Abs x)
from lift_un'[OF Abs.prems[unfolded approx.simps], unfolded fst_conv snd_conv] Abs.hyps
obtain l1 u1 where l': "l = (if l1 < 0 \<and> 0 < u1 then 0 else min \<bar>l1\<bar> \<bar>u1\<bar>)" and u': "u = max \<bar>l1\<bar> \<bar>u1\<bar>"
- and l1: "real l1 \<le> interpret_floatarith x xs" and u1: "interpret_floatarith x xs \<le> real u1" by blast
+ and l1: "l1 \<le> interpret_floatarith x xs" and u1: "interpret_floatarith x xs \<le> u1" by blast
thus ?case unfolding l' u' by (cases "l1 < 0 \<and> 0 < u1", auto simp add: real_of_float_min real_of_float_max real_of_float_abs less_float_def)
next
case (Min a b)
from lift_bin'[OF Min.prems[unfolded approx.simps], unfolded fst_conv snd_conv] Min.hyps
obtain l1 u1 l2 u2 where l': "l = min l1 l2" and u': "u = min u1 u2"
- and l1: "real l1 \<le> interpret_floatarith a xs" and u1: "interpret_floatarith a xs \<le> real u1"
- and l1: "real l2 \<le> interpret_floatarith b xs" and u1: "interpret_floatarith b xs \<le> real u2" by blast
+ and l1: "l1 \<le> interpret_floatarith a xs" and u1: "interpret_floatarith a xs \<le> u1"
+ and l1: "l2 \<le> interpret_floatarith b xs" and u1: "interpret_floatarith b xs \<le> u2" by blast
thus ?case unfolding l' u' by (auto simp add: real_of_float_min)
next
case (Max a b)
from lift_bin'[OF Max.prems[unfolded approx.simps], unfolded fst_conv snd_conv] Max.hyps
obtain l1 u1 l2 u2 where l': "l = max l1 l2" and u': "u = max u1 u2"
- and l1: "real l1 \<le> interpret_floatarith a xs" and u1: "interpret_floatarith a xs \<le> real u1"
- and l1: "real l2 \<le> interpret_floatarith b xs" and u1: "interpret_floatarith b xs \<le> real u2" by blast
+ and l1: "l1 \<le> interpret_floatarith a xs" and u1: "interpret_floatarith a xs \<le> u1"
+ and l1: "l2 \<le> interpret_floatarith b xs" and u1: "interpret_floatarith b xs \<le> u2" by blast
thus ?case unfolding l' u' by (auto simp add: real_of_float_max)
next case (Cos a) with lift_un'_bnds[OF bnds_cos] show ?case by auto
next case (Arctan a) with lift_un'_bnds[OF bnds_arctan] show ?case by auto
@@ -2511,8 +2521,8 @@
lemma lazy_conj: "(if A then B else False) = (A \<and> B)" by simp
lemma approx_form_approx_form':
- assumes "approx_form' prec f s n l u bs ss" and "x \<in> { real l .. real u }"
- obtains l' u' where "x \<in> { real l' .. real u' }"
+ assumes "approx_form' prec f s n l u bs ss" and "(x::real) \<in> { l .. u }"
+ obtains l' u' where "x \<in> { l' .. u' }"
and "approx_form prec f (bs[n := Some (l', u')]) ss"
using assms proof (induct s arbitrary: l u)
case 0
@@ -2522,18 +2532,18 @@
case (Suc s)
let ?m = "(l + u) * Float 1 -1"
- have "real l \<le> real ?m" and "real ?m \<le> real u"
+ have "real l \<le> ?m" and "?m \<le> real u"
unfolding le_float_def using Suc.prems by auto
- with `x \<in> { real l .. real u }`
- have "x \<in> { real l .. real ?m} \<or> x \<in> { real ?m .. real u }" by auto
+ with `x \<in> { l .. u }`
+ have "x \<in> { l .. ?m} \<or> x \<in> { ?m .. u }" by auto
thus thesis
proof (rule disjE)
- assume *: "x \<in> { real l .. real ?m }"
+ assume *: "x \<in> { l .. ?m }"
with Suc.hyps[OF _ _ *] Suc.prems
show thesis by (simp add: Let_def lazy_conj)
next
- assume *: "x \<in> { real ?m .. real u }"
+ assume *: "x \<in> { ?m .. u }"
with Suc.hyps[OF _ _ *] Suc.prems
show thesis by (simp add: Let_def lazy_conj)
qed
@@ -2553,12 +2563,13 @@
and u_eq: "Some (l', u) = approx prec b vs"
and approx_form': "approx_form' prec f (ss ! n) n l u vs ss"
by (cases "approx prec a vs", simp) (cases "approx prec b vs", auto)
+
{ assume "xs ! n \<in> { interpret_floatarith a xs .. interpret_floatarith b xs }"
with approx[OF Bound.prems(2) l_eq] and approx[OF Bound.prems(2) u_eq]
- have "xs ! n \<in> { real l .. real u}" by auto
+ have "xs ! n \<in> { l .. u}" by auto
from approx_form_approx_form'[OF approx_form' this]
- obtain lx ux where bnds: "xs ! n \<in> { real lx .. real ux }"
+ obtain lx ux where bnds: "xs ! n \<in> { lx .. ux }"
and approx_form: "approx_form prec f (vs[n := Some (lx, ux)]) ss" .
from `bounded_by xs vs` bnds
@@ -2579,9 +2590,9 @@
{ assume bnds: "xs ! n = interpret_floatarith a xs"
with approx[OF Assign.prems(2) bnd_eq]
- have "xs ! n \<in> { real l .. real u}" by auto
+ have "xs ! n \<in> { l .. u}" by auto
from approx_form_approx_form'[OF approx_form' this]
- obtain lx ux where bnds: "xs ! n \<in> { real lx .. real ux }"
+ obtain lx ux where bnds: "xs ! n \<in> { lx .. ux }"
and approx_form: "approx_form prec f (vs[n := Some (lx, ux)]) ss" .
from `bounded_by xs vs` bnds
@@ -2789,13 +2800,13 @@
assumes "n < length xs" and bnd: "bounded_by xs vs"
and isD: "isDERIV_approx prec n f vs"
and app: "Some (l, u) = approx prec (DERIV_floatarith n f) vs" (is "_ = approx _ ?D _")
- shows "\<exists>x. real l \<le> x \<and> x \<le> real u \<and>
+ shows "\<exists>(x::real). l \<le> x \<and> x \<le> u \<and>
DERIV (\<lambda> x. interpret_floatarith f (xs[n := x])) (xs!n) :> x"
(is "\<exists> x. _ \<and> _ \<and> DERIV (?i f) _ :> _")
proof (rule exI[of _ "?i ?D (xs!n)"], rule conjI[OF _ conjI])
let "?i f x" = "interpret_floatarith f (xs[n := x])"
from approx[OF bnd app]
- show "real l \<le> ?i ?D (xs!n)" and "?i ?D (xs!n) \<le> real u"
+ show "l \<le> ?i ?D (xs!n)" and "?i ?D (xs!n) \<le> u"
using `n < length xs` by auto
from DERIV_floatarith[OF `n < length xs`, of f "xs!n"] isDERIV_approx[OF bnd isD]
show "DERIV (?i f) (xs!n) :> (?i ?D (xs!n))" by simp
@@ -2845,24 +2856,24 @@
lemma approx_tse_generic:
assumes "bounded_by xs vs"
- and bnd_c: "bounded_by (xs[x := real c]) vs" and "x < length vs" and "x < length xs"
+ and bnd_c: "bounded_by (xs[x := c]) vs" and "x < length vs" and "x < length xs"
and bnd_x: "vs ! x = Some (lx, ux)"
and ate: "Some (l, u) = approx_tse prec x s c k f vs"
- shows "\<exists> n. (\<forall> m < n. \<forall> z \<in> {real lx .. real ux}.
+ shows "\<exists> n. (\<forall> m < n. \<forall> (z::real) \<in> {lx .. ux}.
DERIV (\<lambda> y. interpret_floatarith ((DERIV_floatarith x ^^ m) f) (xs[x := y])) z :>
(interpret_floatarith ((DERIV_floatarith x ^^ (Suc m)) f) (xs[x := z])))
- \<and> (\<forall> t \<in> {real lx .. real ux}. (\<Sum> i = 0..<n. inverse (real (\<Prod> j \<in> {k..<k+i}. j)) *
- interpret_floatarith ((DERIV_floatarith x ^^ i) f) (xs[x := real c]) *
- (xs!x - real c)^i) +
+ \<and> (\<forall> (t::real) \<in> {lx .. ux}. (\<Sum> i = 0..<n. inverse (real (\<Prod> j \<in> {k..<k+i}. j)) *
+ interpret_floatarith ((DERIV_floatarith x ^^ i) f) (xs[x := c]) *
+ (xs!x - c)^i) +
inverse (real (\<Prod> j \<in> {k..<k+n}. j)) *
interpret_floatarith ((DERIV_floatarith x ^^ n) f) (xs[x := t]) *
- (xs!x - real c)^n \<in> {real l .. real u})" (is "\<exists> n. ?taylor f k l u n")
+ (xs!x - c)^n \<in> {l .. u})" (is "\<exists> n. ?taylor f k l u n")
using ate proof (induct s arbitrary: k f l u)
case 0
- { fix t assume "t \<in> {real lx .. real ux}"
+ { fix t::real assume "t \<in> {lx .. ux}"
note bounded_by_update_var[OF `bounded_by xs vs` bnd_x this]
from approx[OF this 0[unfolded approx_tse.simps]]
- have "(interpret_floatarith f (xs[x := t])) \<in> {real l .. real u}"
+ have "(interpret_floatarith f (xs[x := t])) \<in> {l .. u}"
by (auto simp add: algebra_simps)
} thus ?case by (auto intro!: exI[of _ 0])
next
@@ -2872,10 +2883,10 @@
case False
note ap = Suc.prems[unfolded approx_tse.simps if_not_P[OF False]]
- { fix t assume "t \<in> {real lx .. real ux}"
+ { fix t::real assume "t \<in> {lx .. ux}"
note bounded_by_update_var[OF `bounded_by xs vs` bnd_x this]
from approx[OF this ap]
- have "(interpret_floatarith f (xs[x := t])) \<in> {real l .. real u}"
+ have "(interpret_floatarith f (xs[x := t])) \<in> {l .. u}"
by (auto simp add: algebra_simps)
} thus ?thesis by (auto intro!: exI[of _ 0])
next
@@ -2892,11 +2903,11 @@
by (auto elim!: lift_bin) blast
from bnd_c `x < length xs`
- have bnd: "bounded_by (xs[x:=real c]) (vs[x:= Some (c,c)])"
+ have bnd: "bounded_by (xs[x:=c]) (vs[x:= Some (c,c)])"
by (auto intro!: bounded_by_update)
from approx[OF this a]
- have f_c: "interpret_floatarith ((DERIV_floatarith x ^^ 0) f) (xs[x := real c]) \<in> { real l1 .. real u1 }"
+ have f_c: "interpret_floatarith ((DERIV_floatarith x ^^ 0) f) (xs[x := c]) \<in> { l1 .. u1 }"
(is "?f 0 (real c) \<in> _")
by auto
@@ -2906,14 +2917,14 @@
note funpow_Suc = this[symmetric]
from Suc.hyps[OF ate, unfolded this]
obtain n
- where DERIV_hyp: "\<And> m z. \<lbrakk> m < n ; z \<in> { real lx .. real ux } \<rbrakk> \<Longrightarrow> DERIV (?f (Suc m)) z :> ?f (Suc (Suc m)) z"
- and hyp: "\<forall> t \<in> {real lx .. real ux}. (\<Sum> i = 0..<n. inverse (real (\<Prod> j \<in> {Suc k..<Suc k + i}. j)) * ?f (Suc i) (real c) * (xs!x - real c)^i) +
- inverse (real (\<Prod> j \<in> {Suc k..<Suc k + n}. j)) * ?f (Suc n) t * (xs!x - real c)^n \<in> {real l2 .. real u2}"
+ where DERIV_hyp: "\<And> m z. \<lbrakk> m < n ; (z::real) \<in> { lx .. ux } \<rbrakk> \<Longrightarrow> DERIV (?f (Suc m)) z :> ?f (Suc (Suc m)) z"
+ and hyp: "\<forall> t \<in> {real lx .. real ux}. (\<Sum> i = 0..<n. inverse (real (\<Prod> j \<in> {Suc k..<Suc k + i}. j)) * ?f (Suc i) c * (xs!x - c)^i) +
+ inverse (real (\<Prod> j \<in> {Suc k..<Suc k + n}. j)) * ?f (Suc n) t * (xs!x - c)^n \<in> {l2 .. u2}"
(is "\<forall> t \<in> _. ?X (Suc k) f n t \<in> _")
by blast
- { fix m z
- assume "m < Suc n" and bnd_z: "z \<in> { real lx .. real ux }"
+ { fix m and z::real
+ assume "m < Suc n" and bnd_z: "z \<in> { lx .. ux }"
have "DERIV (?f m) z :> ?f (Suc m) z"
proof (cases m)
case 0
@@ -2931,26 +2942,26 @@
have setsum_move0: "\<And> k F. setsum F {0..<Suc k} = F 0 + setsum (\<lambda> k. F (Suc k)) {0..<k}"
unfolding setsum_shift_bounds_Suc_ivl[symmetric]
unfolding setsum_head_upt_Suc[OF zero_less_Suc] ..
- def C \<equiv> "xs!x - real c"
-
- { fix t assume t: "t \<in> {real lx .. real ux}"
+ def C \<equiv> "xs!x - c"
+
+ { fix t::real assume t: "t \<in> {lx .. ux}"
hence "bounded_by [xs!x] [vs!x]"
using `bounded_by xs vs`[THEN bounded_byE, OF `x < length vs`]
by (cases "vs!x", auto simp add: bounded_by_def)
with hyp[THEN bspec, OF t] f_c
- have "bounded_by [?f 0 (real c), ?X (Suc k) f n t, xs!x] [Some (l1, u1), Some (l2, u2), vs!x]"
+ have "bounded_by [?f 0 c, ?X (Suc k) f n t, xs!x] [Some (l1, u1), Some (l2, u2), vs!x]"
by (auto intro!: bounded_by_Cons)
from approx[OF this final, unfolded atLeastAtMost_iff[symmetric]]
- have "?X (Suc k) f n t * (xs!x - real c) * inverse (real k) + ?f 0 (real c) \<in> {real l .. real u}"
+ have "?X (Suc k) f n t * (xs!x - real c) * inverse k + ?f 0 c \<in> {l .. u}"
by (auto simp add: algebra_simps)
- also have "?X (Suc k) f n t * (xs!x - real c) * inverse (real k) + ?f 0 (real c) =
- (\<Sum> i = 0..<Suc n. inverse (real (\<Prod> j \<in> {k..<k+i}. j)) * ?f i (real c) * (xs!x - real c)^i) +
- inverse (real (\<Prod> j \<in> {k..<k+Suc n}. j)) * ?f (Suc n) t * (xs!x - real c)^Suc n" (is "_ = ?T")
+ also have "?X (Suc k) f n t * (xs!x - real c) * inverse (real k) + ?f 0 c =
+ (\<Sum> i = 0..<Suc n. inverse (real (\<Prod> j \<in> {k..<k+i}. j)) * ?f i c * (xs!x - c)^i) +
+ inverse (real (\<Prod> j \<in> {k..<k+Suc n}. j)) * ?f (Suc n) t * (xs!x - c)^Suc n" (is "_ = ?T")
unfolding funpow_Suc C_def[symmetric] setsum_move0 setprod_head_Suc
by (auto simp add: algebra_simps)
(simp only: mult_left_commute [of _ "inverse (real k)"] setsum_right_distrib [symmetric])
- finally have "?T \<in> {real l .. real u}" . }
+ finally have "?T \<in> {l .. u}" . }
thus ?thesis using DERIV by blast
qed
qed
@@ -2965,28 +2976,28 @@
lemma approx_tse:
assumes "bounded_by xs vs"
- and bnd_x: "vs ! x = Some (lx, ux)" and bnd_c: "real c \<in> {real lx .. real ux}"
+ and bnd_x: "vs ! x = Some (lx, ux)" and bnd_c: "real c \<in> {lx .. ux}"
and "x < length vs" and "x < length xs"
and ate: "Some (l, u) = approx_tse prec x s c 1 f vs"
- shows "interpret_floatarith f xs \<in> { real l .. real u }"
+ shows "interpret_floatarith f xs \<in> { l .. u }"
proof -
def F \<equiv> "\<lambda> n z. interpret_floatarith ((DERIV_floatarith x ^^ n) f) (xs[x := z])"
hence F0: "F 0 = (\<lambda> z. interpret_floatarith f (xs[x := z]))" by auto
- hence "bounded_by (xs[x := real c]) vs" and "x < length vs" "x < length xs"
+ hence "bounded_by (xs[x := c]) vs" and "x < length vs" "x < length xs"
using `bounded_by xs vs` bnd_x bnd_c `x < length vs` `x < length xs`
by (auto intro!: bounded_by_update_var)
from approx_tse_generic[OF `bounded_by xs vs` this bnd_x ate]
obtain n
where DERIV: "\<forall> m z. m < n \<and> real lx \<le> z \<and> z \<le> real ux \<longrightarrow> DERIV (F m) z :> F (Suc m) z"
- and hyp: "\<And> t. t \<in> {real lx .. real ux} \<Longrightarrow>
- (\<Sum> j = 0..<n. inverse (real (fact j)) * F j (real c) * (xs!x - real c)^j) +
- inverse (real (fact n)) * F n t * (xs!x - real c)^n
- \<in> {real l .. real u}" (is "\<And> t. _ \<Longrightarrow> ?taylor t \<in> _")
+ and hyp: "\<And> (t::real). t \<in> {lx .. ux} \<Longrightarrow>
+ (\<Sum> j = 0..<n. inverse (real (fact j)) * F j c * (xs!x - c)^j) +
+ inverse (real (fact n)) * F n t * (xs!x - c)^n
+ \<in> {l .. u}" (is "\<And> t. _ \<Longrightarrow> ?taylor t \<in> _")
unfolding F_def atLeastAtMost_iff[symmetric] setprod_fact by blast
- have bnd_xs: "xs ! x \<in> { real lx .. real ux }"
+ have bnd_xs: "xs ! x \<in> { lx .. ux }"
using `bounded_by xs vs`[THEN bounded_byE, OF `x < length vs`] bnd_x by auto
show ?thesis
@@ -2995,28 +3006,28 @@
next
case (Suc n')
show ?thesis
- proof (cases "xs ! x = real c")
+ proof (cases "xs ! x = c")
case True
from True[symmetric] hyp[OF bnd_xs] Suc show ?thesis
unfolding F_def Suc setsum_head_upt_Suc[OF zero_less_Suc] setsum_shift_bounds_Suc_ivl by auto
next
case False
- have "real lx \<le> real c" "real c \<le> real ux" "real lx \<le> xs!x" "xs!x \<le> real ux"
+ have "lx \<le> real c" "real c \<le> ux" "lx \<le> xs!x" "xs!x \<le> ux"
using Suc bnd_c `bounded_by xs vs`[THEN bounded_byE, OF `x < length vs`] bnd_x by auto
from Taylor.taylor[OF zero_less_Suc, of F, OF F0 DERIV[unfolded Suc] this False]
- obtain t where t_bnd: "if xs ! x < real c then xs ! x < t \<and> t < real c else real c < t \<and> t < xs ! x"
+ obtain t::real where t_bnd: "if xs ! x < c then xs ! x < t \<and> t < c else c < t \<and> t < xs ! x"
and fl_eq: "interpret_floatarith f (xs[x := xs ! x]) =
- (\<Sum>m = 0..<Suc n'. F m (real c) / real (fact m) * (xs ! x - real c) ^ m) +
- F (Suc n') t / real (fact (Suc n')) * (xs ! x - real c) ^ Suc n'"
+ (\<Sum>m = 0..<Suc n'. F m c / real (fact m) * (xs ! x - c) ^ m) +
+ F (Suc n') t / real (fact (Suc n')) * (xs ! x - c) ^ Suc n'"
by blast
- from t_bnd bnd_xs bnd_c have *: "t \<in> {real lx .. real ux}"
- by (cases "xs ! x < real c", auto)
+ from t_bnd bnd_xs bnd_c have *: "t \<in> {lx .. ux}"
+ by (cases "xs ! x < c", auto)
have "interpret_floatarith f (xs[x := xs ! x]) = ?taylor t"
unfolding fl_eq Suc by (auto simp add: algebra_simps divide_inverse)
- also have "\<dots> \<in> {real l .. real u}" using * by (rule hyp)
+ also have "\<dots> \<in> {l .. u}" using * by (rule hyp)
finally show ?thesis by simp
qed
qed
@@ -3032,8 +3043,9 @@
approx_tse_form' prec t f s m u cmp else False))"
lemma approx_tse_form':
- assumes "approx_tse_form' prec t f s l u cmp" and "x \<in> {real l .. real u}"
- shows "\<exists> l' u' ly uy. x \<in> { real l' .. real u' } \<and> real l \<le> real l' \<and> real u' \<le> real u \<and> cmp ly uy \<and>
+ fixes x :: real
+ assumes "approx_tse_form' prec t f s l u cmp" and "x \<in> {l .. u}"
+ shows "\<exists> l' u' ly uy. x \<in> { l' .. u' } \<and> real l \<le> l' \<and> u' \<le> real u \<and> cmp ly uy \<and>
approx_tse prec 0 t ((l' + u') * Float 1 -1) 1 f [Some (l', u')] = Some (ly, uy)"
using assms proof (induct s arbitrary: l u)
case 0
@@ -3049,66 +3061,68 @@
and u: "approx_tse_form' prec t f s ?m u cmp"
by (auto simp add: Let_def lazy_conj)
- have m_l: "real l \<le> real ?m" and m_u: "real ?m \<le> real u"
+ have m_l: "real l \<le> ?m" and m_u: "?m \<le> real u"
unfolding le_float_def using Suc.prems by auto
- with `x \<in> { real l .. real u }`
- have "x \<in> { real l .. real ?m} \<or> x \<in> { real ?m .. real u }" by auto
+ with `x \<in> { l .. u }`
+ have "x \<in> { l .. ?m} \<or> x \<in> { ?m .. u }" by auto
thus ?case
proof (rule disjE)
- assume "x \<in> { real l .. real ?m}"
+ assume "x \<in> { l .. ?m}"
from Suc.hyps[OF l this]
obtain l' u' ly uy
- where "x \<in> { real l' .. real u' } \<and> real l \<le> real l' \<and> real u' \<le> real ?m \<and> cmp ly uy \<and>
+ where "x \<in> { l' .. u' } \<and> real l \<le> l' \<and> real u' \<le> ?m \<and> cmp ly uy \<and>
approx_tse prec 0 t ((l' + u') * Float 1 -1) 1 f [Some (l', u')] = Some (ly, uy)" by blast
with m_u show ?thesis by (auto intro!: exI)
next
- assume "x \<in> { real ?m .. real u }"
+ assume "x \<in> { ?m .. u }"
from Suc.hyps[OF u this]
obtain l' u' ly uy
- where "x \<in> { real l' .. real u' } \<and> real ?m \<le> real l' \<and> real u' \<le> real u \<and> cmp ly uy \<and>
+ where "x \<in> { l' .. u' } \<and> ?m \<le> real l' \<and> u' \<le> real u \<and> cmp ly uy \<and>
approx_tse prec 0 t ((l' + u') * Float 1 -1) 1 f [Some (l', u')] = Some (ly, uy)" by blast
with m_u show ?thesis by (auto intro!: exI)
qed
qed
lemma approx_tse_form'_less:
+ fixes x :: real
assumes tse: "approx_tse_form' prec t (Add a (Minus b)) s l u (\<lambda> l u. 0 < l)"
- and x: "x \<in> {real l .. real u}"
+ and x: "x \<in> {l .. u}"
shows "interpret_floatarith b [x] < interpret_floatarith a [x]"
proof -
from approx_tse_form'[OF tse x]
obtain l' u' ly uy
- where x': "x \<in> { real l' .. real u' }" and "real l \<le> real l'"
- and "real u' \<le> real u" and "0 < ly"
+ where x': "x \<in> { l' .. u' }" and "l \<le> real l'"
+ and "real u' \<le> u" and "0 < ly"
and tse: "approx_tse prec 0 t ((l' + u') * Float 1 -1) 1 (Add a (Minus b)) [Some (l', u')] = Some (ly, uy)"
by blast
hence "bounded_by [x] [Some (l', u')]" by (auto simp add: bounded_by_def)
from approx_tse[OF this _ _ _ _ tse[symmetric], of l' u'] x'
- have "real ly \<le> interpret_floatarith a [x] - interpret_floatarith b [x]"
+ have "ly \<le> interpret_floatarith a [x] - interpret_floatarith b [x]"
by (auto simp add: diff_minus)
from order_less_le_trans[OF `0 < ly`[unfolded less_float_def] this]
show ?thesis by auto
qed
lemma approx_tse_form'_le:
+ fixes x :: real
assumes tse: "approx_tse_form' prec t (Add a (Minus b)) s l u (\<lambda> l u. 0 \<le> l)"
- and x: "x \<in> {real l .. real u}"
+ and x: "x \<in> {l .. u}"
shows "interpret_floatarith b [x] \<le> interpret_floatarith a [x]"
proof -
from approx_tse_form'[OF tse x]
obtain l' u' ly uy
- where x': "x \<in> { real l' .. real u' }" and "real l \<le> real l'"
- and "real u' \<le> real u" and "0 \<le> ly"
+ where x': "x \<in> { l' .. u' }" and "l \<le> real l'"
+ and "real u' \<le> u" and "0 \<le> ly"
and tse: "approx_tse prec 0 t ((l' + u') * Float 1 -1) 1 (Add a (Minus b)) [Some (l', u')] = Some (ly, uy)"
by blast
hence "bounded_by [x] [Some (l', u')]" by (auto simp add: bounded_by_def)
from approx_tse[OF this _ _ _ _ tse[symmetric], of l' u'] x'
- have "real ly \<le> interpret_floatarith a [x] - interpret_floatarith b [x]"
+ have "ly \<le> interpret_floatarith a [x] - interpret_floatarith b [x]"
by (auto simp add: diff_minus)
from order_trans[OF `0 \<le> ly`[unfolded le_float_def] this]
show ?thesis by auto
@@ -3146,7 +3160,7 @@
{ let "?f z" = "interpret_floatarith z [x]"
assume "?f i \<in> { ?f a .. ?f b }"
with approx[OF _ a[symmetric], of "[x]"] approx[OF _ b[symmetric], of "[x]"]
- have bnd: "x \<in> { real l .. real u'}" unfolding bounded_by_def i by auto
+ have bnd: "x \<in> { l .. u'}" unfolding bounded_by_def i by auto
have "interpret_form f' [x]"
proof (cases f')
@@ -3425,7 +3439,7 @@
| calculated_subterms (@{const HOL.implies} $ _ $ t) = calculated_subterms t
| calculated_subterms (@{term "op <= :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) = [t1, t2]
| calculated_subterms (@{term "op < :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) = [t1, t2]
- | calculated_subterms (@{term "op : :: real \<Rightarrow> real set \<Rightarrow> bool"} $ t1 $
+ | calculated_subterms (@{term "op : :: real \<Rightarrow> real set \<Rightarrow> bool"} $ t1 $
(@{term "atLeastAtMost :: real \<Rightarrow> real \<Rightarrow> real set"} $ t2 $ t3)) = [t1, t2, t3]
| calculated_subterms t = raise TERM ("calculated_subterms", [t])
@@ -3552,3 +3566,4 @@
*}
end
+
--- a/src/HOL/HOL.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/HOL.thy Thu Dec 02 11:18:44 2010 -0800
@@ -32,7 +32,7 @@
"Tools/async_manager.ML"
"Tools/try.ML"
("Tools/cnf_funcs.ML")
- ("Tools/functorial_mappers.ML")
+ ("Tools/type_mapper.ML")
begin
setup {* Intuitionistic.method_setup @{binding iprover} *}
@@ -712,7 +712,7 @@
and [Pure.elim?] = iffD1 iffD2 impE
use "Tools/hologic.ML"
-use "Tools/functorial_mappers.ML"
+use "Tools/type_mapper.ML"
subsubsection {* Atomizing meta-level connectives *}
--- a/src/HOL/IsaMakefile Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/IsaMakefile Thu Dec 02 11:18:44 2010 -0800
@@ -147,7 +147,7 @@
$(SRC)/Tools/solve_direct.ML \
$(SRC)/Tools/value.ML \
HOL.thy \
- Tools/functorial_mappers.ML \
+ Tools/type_mapper.ML \
Tools/hologic.ML \
Tools/recfun_codegen.ML \
Tools/simpdata.ML
@@ -1156,7 +1156,7 @@
Multivariate_Analysis/Finite_Cartesian_Product.thy \
Multivariate_Analysis/Integration.certs \
Multivariate_Analysis/Integration.thy \
- Multivariate_Analysis/Gauge_Measure.thy \
+ Multivariate_Analysis/Gauge_Measure.thy \
Multivariate_Analysis/L2_Norm.thy \
Multivariate_Analysis/Multivariate_Analysis.thy \
Multivariate_Analysis/Operator_Norm.thy \
@@ -1166,8 +1166,8 @@
Multivariate_Analysis/Topology_Euclidean_Space.thy \
Multivariate_Analysis/document/root.tex \
Multivariate_Analysis/normarith.ML Library/Glbs.thy \
- Library/Inner_Product.thy Library/Numeral_Type.thy \
- Library/Convex.thy Library/FrechetDeriv.thy \
+ Library/Indicator_Function.thy Library/Inner_Product.thy \
+ Library/Numeral_Type.thy Library/Convex.thy Library/FrechetDeriv.thy \
Library/Product_Vector.thy Library/Product_plus.thy
@cd Multivariate_Analysis; $(ISABELLE_TOOL) usedir -b -g true $(OUT)/HOL HOL-Multivariate_Analysis
@@ -1176,16 +1176,19 @@
HOL-Probability: HOL-Multivariate_Analysis $(OUT)/HOL-Probability
-$(OUT)/HOL-Probability: $(OUT)/HOL-Multivariate_Analysis Probability/ROOT.ML \
- Probability/Probability.thy Probability/Sigma_Algebra.thy \
- Probability/Caratheodory.thy \
- Probability/Borel.thy Probability/Measure.thy \
- Probability/Lebesgue_Integration.thy Probability/Lebesgue_Measure.thy \
- Probability/Positive_Infinite_Real.thy Probability/Product_Measure.thy \
- Probability/Probability_Space.thy Probability/Information.thy \
- Probability/ex/Dining_Cryptographers.thy Library/FuncSet.thy \
- Probability/Lebesgue_Measure.thy \
- Library/Nat_Bijection.thy Library/Countable.thy
+$(OUT)/HOL-Probability: $(OUT)/HOL-Multivariate_Analysis \
+ Probability/Borel_Space.thy Probability/Caratheodory.thy \
+ Probability/Complete_Measure.thy \
+ Probability/ex/Dining_Cryptographers.thy \
+ Probability/ex/Koepf_Duermuth_Countermeasure.thy \
+ Probability/Information.thy Probability/Lebesgue_Integration.thy \
+ Probability/Lebesgue_Measure.thy Probability/Measure.thy \
+ Probability/Positive_Infinite_Real.thy \
+ Probability/Probability_Space.thy Probability/Probability.thy \
+ Probability/Product_Measure.thy Probability/Radon_Nikodym.thy \
+ Probability/ROOT.ML Probability/Sigma_Algebra.thy \
+ Library/Countable.thy Library/FuncSet.thy \
+ Library/Nat_Bijection.thy
@cd Probability; $(ISABELLE_TOOL) usedir -b -g true $(OUT)/HOL-Multivariate_Analysis HOL-Probability
--- a/src/HOL/Library/Set_Algebras.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Library/Set_Algebras.thy Thu Dec 02 11:18:44 2010 -0800
@@ -354,4 +354,51 @@
- a : (- 1) *o C"
by (auto simp add: elt_set_times_def)
+lemma set_plus_image:
+ fixes S T :: "'n::semigroup_add set" shows "S \<oplus> T = (\<lambda>(x, y). x + y) ` (S \<times> T)"
+ unfolding set_plus_def by (fastsimp simp: image_iff)
+
+lemma set_setsum_alt:
+ assumes fin: "finite I"
+ shows "setsum_set S I = {setsum s I |s. \<forall>i\<in>I. s i \<in> S i}"
+ (is "_ = ?setsum I")
+using fin proof induct
+ case (insert x F)
+ have "setsum_set S (insert x F) = S x \<oplus> ?setsum F"
+ using insert.hyps by auto
+ also have "...= {s x + setsum s F |s. \<forall> i\<in>insert x F. s i \<in> S i}"
+ unfolding set_plus_def
+ proof safe
+ fix y s assume "y \<in> S x" "\<forall>i\<in>F. s i \<in> S i"
+ then show "\<exists>s'. y + setsum s F = s' x + setsum s' F \<and> (\<forall>i\<in>insert x F. s' i \<in> S i)"
+ using insert.hyps
+ by (intro exI[of _ "\<lambda>i. if i \<in> F then s i else y"]) (auto simp add: set_plus_def)
+ qed auto
+ finally show ?case
+ using insert.hyps by auto
+qed auto
+
+lemma setsum_set_cond_linear:
+ fixes f :: "('a::comm_monoid_add) set \<Rightarrow> ('b::comm_monoid_add) set"
+ assumes [intro!]: "\<And>A B. P A \<Longrightarrow> P B \<Longrightarrow> P (A \<oplus> B)" "P {0}"
+ and f: "\<And>A B. P A \<Longrightarrow> P B \<Longrightarrow> f (A \<oplus> B) = f A \<oplus> f B" "f {0} = {0}"
+ assumes all: "\<And>i. i \<in> I \<Longrightarrow> P (S i)"
+ shows "f (setsum_set S I) = setsum_set (f \<circ> S) I"
+proof cases
+ assume "finite I" from this all show ?thesis
+ proof induct
+ case (insert x F)
+ from `finite F` `\<And>i. i \<in> insert x F \<Longrightarrow> P (S i)` have "P (setsum_set S F)"
+ by induct auto
+ with insert show ?case
+ by (simp, subst f) auto
+ qed (auto intro!: f)
+qed (auto intro!: f)
+
+lemma setsum_set_linear:
+ fixes f :: "('a::comm_monoid_add) set => ('b::comm_monoid_add) set"
+ assumes "\<And>A B. f(A) \<oplus> f(B) = f(A \<oplus> B)" "f {0} = {0}"
+ shows "f (setsum_set S I) = setsum_set (f \<circ> S) I"
+ using setsum_set_cond_linear[of "\<lambda>x. True" f I S] assms by auto
+
end
--- a/src/HOL/Ln.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Ln.thy Thu Dec 02 11:18:44 2010 -0800
@@ -9,13 +9,13 @@
begin
lemma exp_first_two_terms: "exp x = 1 + x + suminf (%n.
- inverse(real (fact (n+2))) * (x ^ (n+2)))"
+ inverse(fact (n+2)) * (x ^ (n+2)))"
proof -
- have "exp x = suminf (%n. inverse(real (fact n)) * (x ^ n))"
+ have "exp x = suminf (%n. inverse(fact n) * (x ^ n))"
by (simp add: exp_def)
- also from summable_exp have "... = (SUM n : {0..<2}.
- inverse(real (fact n)) * (x ^ n)) + suminf (%n.
- inverse(real (fact (n+2))) * (x ^ (n+2)))" (is "_ = ?a + _")
+ also from summable_exp have "... = (SUM n::nat : {0..<2}.
+ inverse(fact n) * (x ^ n)) + suminf (%n.
+ inverse(fact(n+2)) * (x ^ (n+2)))" (is "_ = ?a + _")
by (rule suminf_split_initial_segment)
also have "?a = 1 + x"
by (simp add: numerals)
@@ -23,7 +23,7 @@
qed
lemma exp_tail_after_first_two_terms_summable:
- "summable (%n. inverse(real (fact (n+2))) * (x ^ (n+2)))"
+ "summable (%n. inverse(fact (n+2)) * (x ^ (n+2)))"
proof -
note summable_exp
thus ?thesis
@@ -31,20 +31,19 @@
qed
lemma aux1: assumes a: "0 <= x" and b: "x <= 1"
- shows "inverse (real (fact ((n::nat) + 2))) * x ^ (n + 2) <= (x^2/2) * ((1/2)^n)"
+ shows "inverse (fact ((n::nat) + 2)) * x ^ (n + 2) <= (x^2/2) * ((1/2)^n)"
proof (induct n)
- show "inverse (real (fact ((0::nat) + 2))) * x ^ (0 + 2) <=
+ show "inverse (fact ((0::nat) + 2)) * x ^ (0 + 2) <=
x ^ 2 / 2 * (1 / 2) ^ 0"
by (simp add: real_of_nat_Suc power2_eq_square)
next
fix n :: nat
- assume c: "inverse (real (fact (n + 2))) * x ^ (n + 2)
+ assume c: "inverse (fact (n + 2)) * x ^ (n + 2)
<= x ^ 2 / 2 * (1 / 2) ^ n"
- show "inverse (real (fact (Suc n + 2))) * x ^ (Suc n + 2)
+ show "inverse (fact (Suc n + 2)) * x ^ (Suc n + 2)
<= x ^ 2 / 2 * (1 / 2) ^ Suc n"
proof -
- have "inverse(real (fact (Suc n + 2))) <=
- (1 / 2) *inverse (real (fact (n+2)))"
+ have "inverse(fact (Suc n + 2)) <= (1/2) * inverse (fact (n+2))"
proof -
have "Suc n + 2 = Suc (n + 2)" by simp
then have "fact (Suc n + 2) = Suc (n + 2) * fact (n + 2)"
@@ -57,12 +56,12 @@
by (rule real_of_nat_mult)
finally have "real (fact (Suc n + 2)) =
real (Suc (n + 2)) * real (fact (n + 2))" .
- then have "inverse(real (fact (Suc n + 2))) =
- inverse(real (Suc (n + 2))) * inverse(real (fact (n + 2)))"
+ then have "inverse(fact (Suc n + 2)) =
+ inverse(Suc (n + 2)) * inverse(fact (n + 2))"
apply (rule ssubst)
apply (rule inverse_mult_distrib)
done
- also have "... <= (1/2) * inverse(real (fact (n + 2)))"
+ also have "... <= (1/2) * inverse(fact (n + 2))"
apply (rule mult_right_mono)
apply (subst inverse_eq_divide)
apply simp
@@ -78,8 +77,8 @@
apply (rule mult_nonneg_nonneg, rule a)+
apply (rule zero_le_power, rule a)
done
- ultimately have "inverse (real (fact (Suc n + 2))) * x ^ (Suc n + 2) <=
- (1 / 2 * inverse (real (fact (n + 2)))) * x ^ (n + 2)"
+ ultimately have "inverse (fact (Suc n + 2)) * x ^ (Suc n + 2) <=
+ (1 / 2 * inverse (fact (n + 2))) * x ^ (n + 2)"
apply (rule mult_mono)
apply (rule mult_nonneg_nonneg)
apply simp
@@ -88,7 +87,7 @@
apply (rule zero_le_power)
apply (rule a)
done
- also have "... = 1 / 2 * (inverse (real (fact (n + 2))) * x ^ (n + 2))"
+ also have "... = 1 / 2 * (inverse (fact (n + 2)) * x ^ (n + 2))"
by simp
also have "... <= 1 / 2 * (x ^ 2 / 2 * (1 / 2) ^ n)"
apply (rule mult_left_mono)
@@ -122,12 +121,12 @@
proof -
assume a: "0 <= x"
assume b: "x <= 1"
- have c: "exp x = 1 + x + suminf (%n. inverse(real (fact (n+2))) *
+ have c: "exp x = 1 + x + suminf (%n. inverse(fact (n+2)) *
(x ^ (n+2)))"
by (rule exp_first_two_terms)
- moreover have "suminf (%n. inverse(real (fact (n+2))) * (x ^ (n+2))) <= x^2"
+ moreover have "suminf (%n. inverse(fact (n+2)) * (x ^ (n+2))) <= x^2"
proof -
- have "suminf (%n. inverse(real (fact (n+2))) * (x ^ (n+2))) <=
+ have "suminf (%n. inverse(fact (n+2)) * (x ^ (n+2))) <=
suminf (%n. (x^2/2) * ((1/2)^n))"
apply (rule summable_le)
apply (auto simp only: aux1 prems)
--- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Thu Dec 02 11:18:44 2010 -0800
@@ -1,11 +1,12 @@
(* Title: HOL/Library/Convex_Euclidean_Space.thy
Author: Robert Himmelmann, TU Muenchen
+ Author: Bogdan Grechuk, University of Edinburgh
*)
header {* Convex sets, functions and related things. *}
theory Convex_Euclidean_Space
-imports Topology_Euclidean_Space Convex
+imports Topology_Euclidean_Space Convex Set_Algebras
begin
@@ -5419,4 +5420,225 @@
from this show ?thesis using `?lhs<=?rhs` by auto
qed
+subsection {* Convexity on direct sums *}
+
+lemma closure_sum:
+ fixes S T :: "('n::euclidean_space) set"
+ shows "closure S \<oplus> closure T \<subseteq> closure (S \<oplus> T)"
+proof-
+ have "(closure S) \<oplus> (closure T) = (\<lambda>(x,y). x + y) ` (closure S \<times> closure T)"
+ by (simp add: set_plus_image)
+ also have "... = (\<lambda>(x,y). x + y) ` closure (S \<times> T)"
+ using closure_direct_sum by auto
+ also have "... \<subseteq> closure (S \<oplus> T)"
+ using fst_snd_linear closure_linear_image[of "(\<lambda>(x,y). x + y)" "S \<times> T"]
+ by (auto simp: set_plus_image)
+ finally show ?thesis
+ by auto
+qed
+
+lemma convex_oplus:
+fixes S T :: "('n::euclidean_space) set"
+assumes "convex S" "convex T"
+shows "convex (S \<oplus> T)"
+proof-
+have "{x + y |x y. x : S & y : T} = {c. EX a:S. EX b:T. c = a + b}" by auto
+thus ?thesis unfolding set_plus_def using convex_sums[of S T] assms by auto
+qed
+
+lemma convex_hull_sum:
+fixes S T :: "('n::euclidean_space) set"
+shows "convex hull (S \<oplus> T) = (convex hull S) \<oplus> (convex hull T)"
+proof-
+have "(convex hull S) \<oplus> (convex hull T) =
+ (%z. fst z + snd z) ` ((convex hull S) <*> (convex hull T))"
+ by (simp add: set_plus_image)
+also have "... = (%z. fst z + snd z) ` (convex hull (S <*> T))" using convex_hull_direct_sum by auto
+also have "...= convex hull (S \<oplus> T)" using fst_snd_linear linear_conv_bounded_linear
+ convex_hull_linear_image[of "(%z. fst z + snd z)" "S <*> T"] by (auto simp add: set_plus_image)
+finally show ?thesis by auto
+qed
+
+lemma rel_interior_sum:
+fixes S T :: "('n::euclidean_space) set"
+assumes "convex S" "convex T"
+shows "rel_interior (S \<oplus> T) = (rel_interior S) \<oplus> (rel_interior T)"
+proof-
+have "(rel_interior S) \<oplus> (rel_interior T) = (%z. fst z + snd z) ` (rel_interior S <*> rel_interior T)"
+ by (simp add: set_plus_image)
+also have "... = (%z. fst z + snd z) ` rel_interior (S <*> T)" using rel_interior_direct_sum assms by auto
+also have "...= rel_interior (S \<oplus> T)" using fst_snd_linear convex_direct_sum assms
+ rel_interior_convex_linear_image[of "(%z. fst z + snd z)" "S <*> T"] by (auto simp add: set_plus_image)
+finally show ?thesis by auto
+qed
+
+lemma convex_sum_gen:
+ fixes S :: "'a \<Rightarrow> 'n::euclidean_space set"
+ assumes "\<And>i. i \<in> I \<Longrightarrow> (convex (S i))"
+ shows "convex (setsum_set S I)"
+proof cases
+ assume "finite I" from this assms show ?thesis
+ by induct (auto simp: convex_oplus)
+qed auto
+
+lemma convex_hull_sum_gen:
+fixes S :: "'a => ('n::euclidean_space) set"
+shows "convex hull (setsum_set S I) = setsum_set (%i. (convex hull (S i))) I"
+apply (subst setsum_set_linear) using convex_hull_sum convex_hull_singleton by auto
+
+
+lemma rel_interior_sum_gen:
+fixes S :: "'a => ('n::euclidean_space) set"
+assumes "!i:I. (convex (S i))"
+shows "rel_interior (setsum_set S I) = setsum_set (%i. (rel_interior (S i))) I"
+apply (subst setsum_set_cond_linear[of convex])
+ using rel_interior_sum rel_interior_sing[of "0"] assms by (auto simp add: convex_oplus)
+
+lemma convex_rel_open_direct_sum:
+fixes S T :: "('n::euclidean_space) set"
+assumes "convex S" "rel_open S" "convex T" "rel_open T"
+shows "convex (S <*> T) & rel_open (S <*> T)"
+by (metis assms convex_direct_sum rel_interior_direct_sum rel_open_def)
+
+lemma convex_rel_open_sum:
+fixes S T :: "('n::euclidean_space) set"
+assumes "convex S" "rel_open S" "convex T" "rel_open T"
+shows "convex (S \<oplus> T) & rel_open (S \<oplus> T)"
+by (metis assms convex_oplus rel_interior_sum rel_open_def)
+
+lemma convex_hull_finite_union_cones:
+assumes "finite I" "I ~= {}"
+assumes "!i:I. (convex (S i) & cone (S i) & (S i) ~= {})"
+shows "convex hull (Union (S ` I)) = setsum_set S I"
+ (is "?lhs = ?rhs")
+proof-
+{ fix x assume "x : ?lhs"
+ from this obtain c xs where x_def: "x=setsum (%i. c i *\<^sub>R xs i) I &
+ (!i:I. c i >= 0) & (setsum c I = 1) & (!i:I. xs i : S i)"
+ using convex_hull_finite_union[of I S] assms by auto
+ def s == "(%i. c i *\<^sub>R xs i)"
+ { fix i assume "i:I"
+ hence "s i : S i" using s_def x_def assms mem_cone[of "S i" "xs i" "c i"] by auto
+ } hence "!i:I. s i : S i" by auto
+ moreover have "x = setsum s I" using x_def s_def by auto
+ ultimately have "x : ?rhs" using set_setsum_alt[of I S] assms by auto
+}
+moreover
+{ fix x assume "x : ?rhs"
+ from this obtain s where x_def: "x=setsum s I & (!i:I. s i : S i)"
+ using set_setsum_alt[of I S] assms by auto
+ def xs == "(%i. of_nat(card I) *\<^sub>R s i)"
+ hence "x=setsum (%i. ((1 :: real)/of_nat(card I)) *\<^sub>R xs i) I" using x_def assms by auto
+ moreover have "!i:I. xs i : S i" using x_def xs_def assms by (simp add: cone_def)
+ moreover have "(!i:I. (1 :: real)/of_nat(card I) >= 0)" by auto
+ moreover have "setsum (%i. (1 :: real)/of_nat(card I)) I = 1" using assms by auto
+ ultimately have "x : ?lhs" apply (subst convex_hull_finite_union[of I S])
+ using assms apply blast
+ using assms apply blast
+ apply rule apply (rule_tac x="(%i. (1 :: real)/of_nat(card I))" in exI) by auto
+} ultimately show ?thesis by auto
+qed
+
+lemma convex_hull_union_cones_two:
+fixes S T :: "('m::euclidean_space) set"
+assumes "convex S" "cone S" "S ~= {}"
+assumes "convex T" "cone T" "T ~= {}"
+shows "convex hull (S Un T) = S \<oplus> T"
+proof-
+def I == "{(1::nat),2}"
+def A == "(%i. (if i=(1::nat) then S else T))"
+have "Union (A ` I) = S Un T" using A_def I_def by auto
+hence "convex hull (Union (A ` I)) = convex hull (S Un T)" by auto
+moreover have "convex hull Union (A ` I) = setsum_set A I"
+ apply (subst convex_hull_finite_union_cones[of I A]) using assms A_def I_def by auto
+moreover have
+ "setsum_set A I = S \<oplus> T" using A_def I_def
+ unfolding set_plus_def apply auto unfolding set_plus_def by auto
+ultimately show ?thesis by auto
+qed
+
+lemma rel_interior_convex_hull_union:
+fixes S :: "'a => ('n::euclidean_space) set"
+assumes "finite I"
+assumes "!i:I. convex (S i) & (S i) ~= {}"
+shows "rel_interior (convex hull (Union (S ` I))) = {setsum (%i. c i *\<^sub>R s i) I
+ |c s. (!i:I. c i > 0) & (setsum c I = 1) & (!i:I. s i : rel_interior(S i))}"
+(is "?lhs=?rhs")
+proof-
+{ assume "I={}" hence ?thesis using convex_hull_empty rel_interior_empty by auto }
+moreover
+{ assume "I ~= {}"
+ def C0 == "convex hull (Union (S ` I))"
+ have "!i:I. C0 >= S i" unfolding C0_def using hull_subset[of "Union (S ` I)"] by auto
+ def K0 == "cone hull ({(1 :: real)} <*> C0)"
+ def K == "(%i. cone hull ({(1 :: real)} <*> (S i)))"
+ have "!i:I. K i ~= {}" unfolding K_def using assms by (simp add: cone_hull_empty_iff[symmetric])
+ { fix i assume "i:I"
+ hence "convex (K i)" unfolding K_def apply (subst convex_cone_hull) apply (subst convex_direct_sum)
+ using assms by auto
+ }
+ hence convK: "!i:I. convex (K i)" by auto
+ { fix i assume "i:I"
+ hence "K0 >= K i" unfolding K0_def K_def apply (subst hull_mono) using `!i:I. C0 >= S i` by auto
+ }
+ hence "K0 >= Union (K ` I)" by auto
+ moreover have "K0 : convex" unfolding mem_def K0_def
+ apply (subst convex_cone_hull) apply (subst convex_direct_sum)
+ unfolding C0_def using convex_convex_hull by auto
+ ultimately have geq: "K0 >= convex hull (Union (K ` I))" using hull_minimal[of _ "K0" "convex"] by blast
+ have "!i:I. K i >= {(1 :: real)} <*> (S i)" using K_def by (simp add: hull_subset)
+ hence "Union (K ` I) >= {(1 :: real)} <*> Union (S ` I)" by auto
+ hence "convex hull Union (K ` I) >= convex hull ({(1 :: real)} <*> Union (S ` I))" by (simp add: hull_mono)
+ hence "convex hull Union (K ` I) >= {(1 :: real)} <*> C0" unfolding C0_def
+ using convex_hull_direct_sum[of "{(1 :: real)}" "Union (S ` I)"] convex_hull_singleton by auto
+ moreover have "convex hull(Union (K ` I)) : cone" unfolding mem_def apply (subst cone_convex_hull)
+ using cone_Union[of "K ` I"] apply auto unfolding K_def using cone_cone_hull by auto
+ ultimately have "convex hull (Union (K ` I)) >= K0"
+ unfolding K0_def using hull_minimal[of _ "convex hull (Union (K ` I))" "cone"] by blast
+ hence "K0 = convex hull (Union (K ` I))" using geq by auto
+ also have "...=setsum_set K I"
+ apply (subst convex_hull_finite_union_cones[of I K])
+ using assms apply blast
+ using `I ~= {}` apply blast
+ unfolding K_def apply rule
+ apply (subst convex_cone_hull) apply (subst convex_direct_sum)
+ using assms cone_cone_hull `!i:I. K i ~= {}` K_def by auto
+ finally have "K0 = setsum_set K I" by auto
+ hence *: "rel_interior K0 = setsum_set (%i. (rel_interior (K i))) I"
+ using rel_interior_sum_gen[of I K] convK by auto
+ { fix x assume "x : ?lhs"
+ hence "((1::real),x) : rel_interior K0" using K0_def C0_def
+ rel_interior_convex_cone_aux[of C0 "(1::real)" x] convex_convex_hull by auto
+ from this obtain k where k_def: "((1::real),x) = setsum k I & (!i:I. k i : rel_interior (K i))"
+ using `finite I` * set_setsum_alt[of I "(%i. rel_interior (K i))"] by auto
+ { fix i assume "i:I"
+ hence "(convex (S i)) & k i : rel_interior (cone hull {1} <*> S i)" using k_def K_def assms by auto
+ hence "EX ci si. k i = (ci, ci *\<^sub>R si) & 0 < ci & si : rel_interior (S i)"
+ using rel_interior_convex_cone[of "S i"] by auto
+ }
+ from this obtain c s where cs_def: "!i:I. (k i = (c i, c i *\<^sub>R s i) & 0 < c i
+ & s i : rel_interior (S i))" by metis
+ hence "x = (SUM i:I. c i *\<^sub>R s i) & setsum c I = 1" using k_def by (simp add: setsum_prod)
+ hence "x : ?rhs" using k_def apply auto
+ apply (rule_tac x="c" in exI) apply (rule_tac x="s" in exI) using cs_def by auto
+ }
+ moreover
+ { fix x assume "x : ?rhs"
+ from this obtain c s where cs_def: "x=setsum (%i. c i *\<^sub>R s i) I &
+ (!i:I. c i > 0) & (setsum c I = 1) & (!i:I. s i : rel_interior(S i))" by auto
+ def k == "(%i. (c i, c i *\<^sub>R s i))"
+ { fix i assume "i:I"
+ hence "k i : rel_interior (K i)"
+ using k_def K_def assms cs_def rel_interior_convex_cone[of "S i"] by auto
+ }
+ hence "((1::real),x) : rel_interior K0"
+ using K0_def * set_setsum_alt[of I "(%i. rel_interior (K i))"] assms k_def cs_def
+ apply auto apply (rule_tac x="k" in exI) by (simp add: setsum_prod)
+ hence "x : ?lhs" using K0_def C0_def
+ rel_interior_convex_cone_aux[of C0 "(1::real)" x] by (auto simp add: convex_convex_hull)
+ }
+ ultimately have ?thesis by blast
+} ultimately show ?thesis by blast
+qed
+
end
--- a/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy Thu Dec 02 11:18:44 2010 -0800
@@ -1272,7 +1272,7 @@
values [expected "{4::int}"] "{c. minus_int_test 9 5 c}"
values [expected "{9::int}"] "{a. minus_int_test a 4 5}"
-values [expected "{- 1::int}"] "{b. minus_int_test 4 b 5}"
+values [expected "{-1::int}"] "{b. minus_int_test 4 b 5}"
subsection {* minus on bool *}
--- a/src/HOL/Probability/Borel.thy Wed Dec 01 20:52:16 2010 -0800
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1390 +0,0 @@
-(* Author: Armin Heller, Johannes Hoelzl, TU Muenchen *)
-
-header {*Borel spaces*}
-
-theory Borel
- imports Sigma_Algebra Positive_Infinite_Real Multivariate_Analysis
-begin
-
-lemma LIMSEQ_max:
- "u ----> (x::real) \<Longrightarrow> (\<lambda>i. max (u i) 0) ----> max x 0"
- by (fastsimp intro!: LIMSEQ_I dest!: LIMSEQ_D)
-
-section "Generic Borel spaces"
-
-definition "borel_space = sigma (UNIV::'a::topological_space set) open"
-abbreviation "borel_measurable M \<equiv> measurable M borel_space"
-
-interpretation borel_space: sigma_algebra borel_space
- using sigma_algebra_sigma by (auto simp: borel_space_def)
-
-lemma in_borel_measurable:
- "f \<in> borel_measurable M \<longleftrightarrow>
- (\<forall>S \<in> sets (sigma UNIV open).
- f -` S \<inter> space M \<in> sets M)"
- by (auto simp add: measurable_def borel_space_def)
-
-lemma in_borel_measurable_borel_space:
- "f \<in> borel_measurable M \<longleftrightarrow>
- (\<forall>S \<in> sets borel_space.
- f -` S \<inter> space M \<in> sets M)"
- by (auto simp add: measurable_def borel_space_def)
-
-lemma space_borel_space[simp]: "space borel_space = UNIV"
- unfolding borel_space_def by auto
-
-lemma borel_space_open[simp]:
- assumes "open A" shows "A \<in> sets borel_space"
-proof -
- have "A \<in> open" unfolding mem_def using assms .
- thus ?thesis unfolding borel_space_def sigma_def by (auto intro!: sigma_sets.Basic)
-qed
-
-lemma borel_space_closed[simp]:
- assumes "closed A" shows "A \<in> sets borel_space"
-proof -
- have "space borel_space - (- A) \<in> sets borel_space"
- using assms unfolding closed_def by (blast intro: borel_space_open)
- thus ?thesis by simp
-qed
-
-lemma (in sigma_algebra) borel_measurable_vimage:
- fixes f :: "'a \<Rightarrow> 'x::t2_space"
- assumes borel: "f \<in> borel_measurable M"
- shows "f -` {x} \<inter> space M \<in> sets M"
-proof (cases "x \<in> f ` space M")
- case True then obtain y where "x = f y" by auto
- from closed_sing[of "f y"]
- have "{f y} \<in> sets borel_space" by (rule borel_space_closed)
- with assms show ?thesis
- unfolding in_borel_measurable_borel_space `x = f y` by auto
-next
- case False hence "f -` {x} \<inter> space M = {}" by auto
- thus ?thesis by auto
-qed
-
-lemma (in sigma_algebra) borel_measurableI:
- fixes f :: "'a \<Rightarrow> 'x\<Colon>topological_space"
- assumes "\<And>S. open S \<Longrightarrow> f -` S \<inter> space M \<in> sets M"
- shows "f \<in> borel_measurable M"
- unfolding borel_space_def
-proof (rule measurable_sigma)
- fix S :: "'x set" assume "S \<in> open" thus "f -` S \<inter> space M \<in> sets M"
- using assms[of S] by (simp add: mem_def)
-qed simp_all
-
-lemma borel_space_singleton[simp, intro]:
- fixes x :: "'a::t1_space"
- shows "A \<in> sets borel_space \<Longrightarrow> insert x A \<in> sets borel_space"
- proof (rule borel_space.insert_in_sets)
- show "{x} \<in> sets borel_space"
- using closed_sing[of x] by (rule borel_space_closed)
- qed simp
-
-lemma (in sigma_algebra) borel_measurable_const[simp, intro]:
- "(\<lambda>x. c) \<in> borel_measurable M"
- by (auto intro!: measurable_const)
-
-lemma (in sigma_algebra) borel_measurable_indicator[simp, intro!]:
- assumes A: "A \<in> sets M"
- shows "indicator A \<in> borel_measurable M"
- unfolding indicator_def_raw using A
- by (auto intro!: measurable_If_set borel_measurable_const)
-
-lemma borel_measurable_translate:
- assumes "A \<in> sets borel_space" and trans: "\<And>B. open B \<Longrightarrow> f -` B \<in> sets borel_space"
- shows "f -` A \<in> sets borel_space"
-proof -
- have "A \<in> sigma_sets UNIV open" using assms
- by (simp add: borel_space_def sigma_def)
- thus ?thesis
- proof (induct rule: sigma_sets.induct)
- case (Basic a) thus ?case using trans[of a] by (simp add: mem_def)
- next
- case (Compl a)
- moreover have "UNIV \<in> sets borel_space"
- by (metis borel_space.top borel_space_def_raw mem_def space_sigma)
- ultimately show ?case
- by (auto simp: vimage_Diff borel_space.Diff)
- qed (auto simp add: vimage_UN)
-qed
-
-lemma (in sigma_algebra) borel_measurable_restricted:
- fixes f :: "'a \<Rightarrow> 'x\<Colon>{topological_space, semiring_1}" assumes "A \<in> sets M"
- shows "f \<in> borel_measurable (restricted_space A) \<longleftrightarrow>
- (\<lambda>x. f x * indicator A x) \<in> borel_measurable M"
- (is "f \<in> borel_measurable ?R \<longleftrightarrow> ?f \<in> borel_measurable M")
-proof -
- interpret R: sigma_algebra ?R by (rule restricted_sigma_algebra[OF `A \<in> sets M`])
- have *: "f \<in> borel_measurable ?R \<longleftrightarrow> ?f \<in> borel_measurable ?R"
- by (auto intro!: measurable_cong)
- show ?thesis unfolding *
- unfolding in_borel_measurable_borel_space
- proof (simp, safe)
- fix S :: "'x set" assume "S \<in> sets borel_space"
- "\<forall>S\<in>sets borel_space. ?f -` S \<inter> A \<in> op \<inter> A ` sets M"
- then have "?f -` S \<inter> A \<in> op \<inter> A ` sets M" by auto
- then have f: "?f -` S \<inter> A \<in> sets M"
- using `A \<in> sets M` sets_into_space by fastsimp
- show "?f -` S \<inter> space M \<in> sets M"
- proof cases
- assume "0 \<in> S"
- then have "?f -` S \<inter> space M = ?f -` S \<inter> A \<union> (space M - A)"
- using `A \<in> sets M` sets_into_space by auto
- then show ?thesis using f `A \<in> sets M` by (auto intro!: Un Diff)
- next
- assume "0 \<notin> S"
- then have "?f -` S \<inter> space M = ?f -` S \<inter> A"
- using `A \<in> sets M` sets_into_space
- by (auto simp: indicator_def split: split_if_asm)
- then show ?thesis using f by auto
- qed
- next
- fix S :: "'x set" assume "S \<in> sets borel_space"
- "\<forall>S\<in>sets borel_space. ?f -` S \<inter> space M \<in> sets M"
- then have f: "?f -` S \<inter> space M \<in> sets M" by auto
- then show "?f -` S \<inter> A \<in> op \<inter> A ` sets M"
- using `A \<in> sets M` sets_into_space
- apply (simp add: image_iff)
- apply (rule bexI[OF _ f])
- by auto
- qed
-qed
-
-lemma (in sigma_algebra) borel_measurable_subalgebra:
- assumes "N \<subseteq> sets M" "f \<in> borel_measurable (M\<lparr>sets:=N\<rparr>)"
- shows "f \<in> borel_measurable M"
- using assms unfolding measurable_def by auto
-
-section "Borel spaces on euclidean spaces"
-
-lemma lessThan_borel[simp, intro]:
- fixes a :: "'a\<Colon>ordered_euclidean_space"
- shows "{..< a} \<in> sets borel_space"
- by (blast intro: borel_space_open)
-
-lemma greaterThan_borel[simp, intro]:
- fixes a :: "'a\<Colon>ordered_euclidean_space"
- shows "{a <..} \<in> sets borel_space"
- by (blast intro: borel_space_open)
-
-lemma greaterThanLessThan_borel[simp, intro]:
- fixes a b :: "'a\<Colon>ordered_euclidean_space"
- shows "{a<..<b} \<in> sets borel_space"
- by (blast intro: borel_space_open)
-
-lemma atMost_borel[simp, intro]:
- fixes a :: "'a\<Colon>ordered_euclidean_space"
- shows "{..a} \<in> sets borel_space"
- by (blast intro: borel_space_closed)
-
-lemma atLeast_borel[simp, intro]:
- fixes a :: "'a\<Colon>ordered_euclidean_space"
- shows "{a..} \<in> sets borel_space"
- by (blast intro: borel_space_closed)
-
-lemma atLeastAtMost_borel[simp, intro]:
- fixes a b :: "'a\<Colon>ordered_euclidean_space"
- shows "{a..b} \<in> sets borel_space"
- by (blast intro: borel_space_closed)
-
-lemma greaterThanAtMost_borel[simp, intro]:
- fixes a b :: "'a\<Colon>ordered_euclidean_space"
- shows "{a<..b} \<in> sets borel_space"
- unfolding greaterThanAtMost_def by blast
-
-lemma atLeastLessThan_borel[simp, intro]:
- fixes a b :: "'a\<Colon>ordered_euclidean_space"
- shows "{a..<b} \<in> sets borel_space"
- unfolding atLeastLessThan_def by blast
-
-lemma hafspace_less_borel[simp, intro]:
- fixes a :: real
- shows "{x::'a::euclidean_space. a < x $$ i} \<in> sets borel_space"
- by (auto intro!: borel_space_open open_halfspace_component_gt)
-
-lemma hafspace_greater_borel[simp, intro]:
- fixes a :: real
- shows "{x::'a::euclidean_space. x $$ i < a} \<in> sets borel_space"
- by (auto intro!: borel_space_open open_halfspace_component_lt)
-
-lemma hafspace_less_eq_borel[simp, intro]:
- fixes a :: real
- shows "{x::'a::euclidean_space. a \<le> x $$ i} \<in> sets borel_space"
- by (auto intro!: borel_space_closed closed_halfspace_component_ge)
-
-lemma hafspace_greater_eq_borel[simp, intro]:
- fixes a :: real
- shows "{x::'a::euclidean_space. x $$ i \<le> a} \<in> sets borel_space"
- by (auto intro!: borel_space_closed closed_halfspace_component_le)
-
-lemma (in sigma_algebra) borel_measurable_less[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{w \<in> space M. f w < g w} \<in> sets M"
-proof -
- have "{w \<in> space M. f w < g w} =
- (\<Union>r. (f -` {..< of_rat r} \<inter> space M) \<inter> (g -` {of_rat r <..} \<inter> space M))"
- using Rats_dense_in_real by (auto simp add: Rats_def)
- then show ?thesis using f g
- by simp (blast intro: measurable_sets)
-qed
-
-lemma (in sigma_algebra) borel_measurable_le[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{w \<in> space M. f w \<le> g w} \<in> sets M"
-proof -
- have "{w \<in> space M. f w \<le> g w} = space M - {w \<in> space M. g w < f w}"
- by auto
- thus ?thesis using f g
- by simp blast
-qed
-
-lemma (in sigma_algebra) borel_measurable_eq[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{w \<in> space M. f w = g w} \<in> sets M"
-proof -
- have "{w \<in> space M. f w = g w} =
- {w \<in> space M. f w \<le> g w} \<inter> {w \<in> space M. g w \<le> f w}"
- by auto
- thus ?thesis using f g by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_neq[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{w \<in> space M. f w \<noteq> g w} \<in> sets M"
-proof -
- have "{w \<in> space M. f w \<noteq> g w} = space M - {w \<in> space M. f w = g w}"
- by auto
- thus ?thesis using f g by auto
-qed
-
-subsection "Borel space equals sigma algebras over intervals"
-
-lemma rational_boxes:
- fixes x :: "'a\<Colon>ordered_euclidean_space"
- assumes "0 < e"
- shows "\<exists>a b. (\<forall>i. a $$ i \<in> \<rat>) \<and> (\<forall>i. b $$ i \<in> \<rat>) \<and> x \<in> {a <..< b} \<and> {a <..< b} \<subseteq> ball x e"
-proof -
- def e' \<equiv> "e / (2 * sqrt (real (DIM ('a))))"
- then have e: "0 < e'" using assms by (auto intro!: divide_pos_pos)
- have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> y < x $$ i \<and> x $$ i - y < e'" (is "\<forall>i. ?th i")
- proof
- fix i from Rats_dense_in_real[of "x $$ i - e'" "x $$ i"] e
- show "?th i" by auto
- qed
- from choice[OF this] guess a .. note a = this
- have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> x $$ i < y \<and> y - x $$ i < e'" (is "\<forall>i. ?th i")
- proof
- fix i from Rats_dense_in_real[of "x $$ i" "x $$ i + e'"] e
- show "?th i" by auto
- qed
- from choice[OF this] guess b .. note b = this
- { fix y :: 'a assume *: "Chi a < y" "y < Chi b"
- have "dist x y = sqrt (\<Sum>i<DIM('a). (dist (x $$ i) (y $$ i))\<twosuperior>)"
- unfolding setL2_def[symmetric] by (rule euclidean_dist_l2)
- also have "\<dots> < sqrt (\<Sum>i<DIM('a). e^2 / real (DIM('a)))"
- proof (rule real_sqrt_less_mono, rule setsum_strict_mono)
- fix i assume i: "i \<in> {..<DIM('a)}"
- have "a i < y$$i \<and> y$$i < b i" using * i eucl_less[where 'a='a] by auto
- moreover have "a i < x$$i" "x$$i - a i < e'" using a by auto
- moreover have "x$$i < b i" "b i - x$$i < e'" using b by auto
- ultimately have "\<bar>x$$i - y$$i\<bar> < 2 * e'" by auto
- then have "dist (x $$ i) (y $$ i) < e/sqrt (real (DIM('a)))"
- unfolding e'_def by (auto simp: dist_real_def)
- then have "(dist (x $$ i) (y $$ i))\<twosuperior> < (e/sqrt (real (DIM('a))))\<twosuperior>"
- by (rule power_strict_mono) auto
- then show "(dist (x $$ i) (y $$ i))\<twosuperior> < e\<twosuperior> / real DIM('a)"
- by (simp add: power_divide)
- qed auto
- also have "\<dots> = e" using `0 < e` by (simp add: real_eq_of_nat DIM_positive)
- finally have "dist x y < e" . }
- with a b show ?thesis
- apply (rule_tac exI[of _ "Chi a"])
- apply (rule_tac exI[of _ "Chi b"])
- using eucl_less[where 'a='a] by auto
-qed
-
-lemma ex_rat_list:
- fixes x :: "'a\<Colon>ordered_euclidean_space"
- assumes "\<And> i. x $$ i \<in> \<rat>"
- shows "\<exists> r. length r = DIM('a) \<and> (\<forall> i < DIM('a). of_rat (r ! i) = x $$ i)"
-proof -
- have "\<forall>i. \<exists>r. x $$ i = of_rat r" using assms unfolding Rats_def by blast
- from choice[OF this] guess r ..
- then show ?thesis by (auto intro!: exI[of _ "map r [0 ..< DIM('a)]"])
-qed
-
-lemma open_UNION:
- fixes M :: "'a\<Colon>ordered_euclidean_space set"
- assumes "open M"
- shows "M = UNION {(a, b) | a b. {Chi (of_rat \<circ> op ! a) <..< Chi (of_rat \<circ> op ! b)} \<subseteq> M}
- (\<lambda> (a, b). {Chi (of_rat \<circ> op ! a) <..< Chi (of_rat \<circ> op ! b)})"
- (is "M = UNION ?idx ?box")
-proof safe
- fix x assume "x \<in> M"
- obtain e where e: "e > 0" "ball x e \<subseteq> M"
- using openE[OF assms `x \<in> M`] by auto
- then obtain a b where ab: "x \<in> {a <..< b}" "\<And>i. a $$ i \<in> \<rat>" "\<And>i. b $$ i \<in> \<rat>" "{a <..< b} \<subseteq> ball x e"
- using rational_boxes[OF e(1)] by blast
- then obtain p q where pq: "length p = DIM ('a)"
- "length q = DIM ('a)"
- "\<forall> i < DIM ('a). of_rat (p ! i) = a $$ i \<and> of_rat (q ! i) = b $$ i"
- using ex_rat_list[OF ab(2)] ex_rat_list[OF ab(3)] by blast
- hence p: "Chi (of_rat \<circ> op ! p) = a"
- using euclidean_eq[of "Chi (of_rat \<circ> op ! p)" a]
- unfolding o_def by auto
- from pq have q: "Chi (of_rat \<circ> op ! q) = b"
- using euclidean_eq[of "Chi (of_rat \<circ> op ! q)" b]
- unfolding o_def by auto
- have "x \<in> ?box (p, q)"
- using p q ab by auto
- thus "x \<in> UNION ?idx ?box" using ab e p q exI[of _ p] exI[of _ q] by auto
-qed auto
-
-lemma halfspace_span_open:
- "sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a})))
- \<subseteq> sets borel_space"
- by (auto intro!: borel_space.sigma_sets_subset[simplified] borel_space_open
- open_halfspace_component_lt simp: sets_sigma)
-
-lemma halfspace_lt_in_halfspace:
- "{x\<Colon>'a. x $$ i < a} \<in> sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a})))"
- unfolding sets_sigma by (rule sigma_sets.Basic) auto
-
-lemma halfspace_gt_in_halfspace:
- "{x\<Colon>'a. a < x $$ i} \<in> sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a})))"
- (is "?set \<in> sets ?SIGMA")
-proof -
- interpret sigma_algebra ?SIGMA by (rule sigma_algebra_sigma) simp
- have *: "?set = (\<Union>n. space ?SIGMA - {x\<Colon>'a. x $$ i < a + 1 / real (Suc n)})"
- proof (safe, simp_all add: not_less)
- fix x assume "a < x $$ i"
- with reals_Archimedean[of "x $$ i - a"]
- obtain n where "a + 1 / real (Suc n) < x $$ i"
- by (auto simp: inverse_eq_divide field_simps)
- then show "\<exists>n. a + 1 / real (Suc n) \<le> x $$ i"
- by (blast intro: less_imp_le)
- next
- fix x n
- have "a < a + 1 / real (Suc n)" by auto
- also assume "\<dots> \<le> x"
- finally show "a < x" .
- qed
- show "?set \<in> sets ?SIGMA" unfolding *
- by (safe intro!: countable_UN Diff halfspace_lt_in_halfspace)
-qed
-
-lemma (in sigma_algebra) sets_sigma_subset:
- assumes "A = space M"
- assumes "B \<subseteq> sets M"
- shows "sets (sigma A B) \<subseteq> sets M"
- by (unfold assms sets_sigma, rule sigma_sets_subset, rule assms)
-
-lemma open_span_halfspace:
- "sets borel_space \<subseteq> sets (sigma UNIV (range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. x $$ i < a})))"
- (is "_ \<subseteq> sets ?SIGMA")
-proof (unfold borel_space_def, rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) simp
- then interpret sigma_algebra ?SIGMA .
- fix S :: "'a set" assume "S \<in> open" then have "open S" unfolding mem_def .
- from open_UNION[OF this]
- obtain I where *: "S =
- (\<Union>(a, b)\<in>I.
- (\<Inter> i<DIM('a). {x. (Chi (real_of_rat \<circ> op ! a)::'a) $$ i < x $$ i}) \<inter>
- (\<Inter> i<DIM('a). {x. x $$ i < (Chi (real_of_rat \<circ> op ! b)::'a) $$ i}))"
- unfolding greaterThanLessThan_def
- unfolding eucl_greaterThan_eq_halfspaces[where 'a='a]
- unfolding eucl_lessThan_eq_halfspaces[where 'a='a]
- by blast
- show "S \<in> sets ?SIGMA"
- unfolding *
- by (auto intro!: countable_UN Int countable_INT halfspace_lt_in_halfspace halfspace_gt_in_halfspace)
-qed auto
-
-lemma halfspace_span_halfspace_le:
- "sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a}))) \<subseteq>
- sets (sigma UNIV (range (\<lambda> (a, i). {x. x $$ i \<le> a})))"
- (is "_ \<subseteq> sets ?SIGMA")
-proof (rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
- then interpret sigma_algebra ?SIGMA .
- fix a i
- have *: "{x::'a. x$$i < a} = (\<Union>n. {x. x$$i \<le> a - 1/real (Suc n)})"
- proof (safe, simp_all)
- fix x::'a assume *: "x$$i < a"
- with reals_Archimedean[of "a - x$$i"]
- obtain n where "x $$ i < a - 1 / (real (Suc n))"
- by (auto simp: field_simps inverse_eq_divide)
- then show "\<exists>n. x $$ i \<le> a - 1 / (real (Suc n))"
- by (blast intro: less_imp_le)
- next
- fix x::'a and n
- assume "x$$i \<le> a - 1 / real (Suc n)"
- also have "\<dots> < a" by auto
- finally show "x$$i < a" .
- qed
- show "{x. x$$i < a} \<in> sets ?SIGMA" unfolding *
- by (safe intro!: countable_UN)
- (auto simp: sets_sigma intro!: sigma_sets.Basic)
-qed auto
-
-lemma halfspace_span_halfspace_ge:
- "sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a}))) \<subseteq>
- sets (sigma UNIV (range (\<lambda> (a, i). {x. a \<le> x $$ i})))"
- (is "_ \<subseteq> sets ?SIGMA")
-proof (rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
- then interpret sigma_algebra ?SIGMA .
- fix a i have *: "{x::'a. x$$i < a} = space ?SIGMA - {x::'a. a \<le> x$$i}" by auto
- show "{x. x$$i < a} \<in> sets ?SIGMA" unfolding *
- by (safe intro!: Diff)
- (auto simp: sets_sigma intro!: sigma_sets.Basic)
-qed auto
-
-lemma halfspace_le_span_halfspace_gt:
- "sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i \<le> a}))) \<subseteq>
- sets (sigma UNIV (range (\<lambda> (a, i). {x. a < x $$ i})))"
- (is "_ \<subseteq> sets ?SIGMA")
-proof (rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
- then interpret sigma_algebra ?SIGMA .
- fix a i have *: "{x::'a. x$$i \<le> a} = space ?SIGMA - {x::'a. a < x$$i}" by auto
- show "{x. x$$i \<le> a} \<in> sets ?SIGMA" unfolding *
- by (safe intro!: Diff)
- (auto simp: sets_sigma intro!: sigma_sets.Basic)
-qed auto
-
-lemma halfspace_le_span_atMost:
- "sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i \<le> a}))) \<subseteq>
- sets (sigma UNIV (range (\<lambda>a. {..a\<Colon>'a\<Colon>ordered_euclidean_space})))"
- (is "_ \<subseteq> sets ?SIGMA")
-proof (rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
- then interpret sigma_algebra ?SIGMA .
- fix a i
- show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
- proof cases
- assume "i < DIM('a)"
- then have *: "{x::'a. x$$i \<le> a} = (\<Union>k::nat. {.. (\<chi>\<chi> n. if n = i then a else real k)})"
- proof (safe, simp_all add: eucl_le[where 'a='a] split: split_if_asm)
- fix x
- from real_arch_simple[of "Max ((\<lambda>i. x$$i)`{..<DIM('a)})"] guess k::nat ..
- then have "\<And>i. i < DIM('a) \<Longrightarrow> x$$i \<le> real k"
- by (subst (asm) Max_le_iff) auto
- then show "\<exists>k::nat. \<forall>ia. ia \<noteq> i \<longrightarrow> ia < DIM('a) \<longrightarrow> x $$ ia \<le> real k"
- by (auto intro!: exI[of _ k])
- qed
- show "{x. x$$i \<le> a} \<in> sets ?SIGMA" unfolding *
- by (safe intro!: countable_UN)
- (auto simp: sets_sigma intro!: sigma_sets.Basic)
- next
- assume "\<not> i < DIM('a)"
- then show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
- using top by auto
- qed
-qed auto
-
-lemma halfspace_le_span_greaterThan:
- "sets (sigma UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i \<le> a}))) \<subseteq>
- sets (sigma UNIV (range (\<lambda>a. {a<..})))"
- (is "_ \<subseteq> sets ?SIGMA")
-proof (rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
- then interpret sigma_algebra ?SIGMA .
- fix a i
- show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
- proof cases
- assume "i < DIM('a)"
- have "{x::'a. x$$i \<le> a} = space ?SIGMA - {x::'a. a < x$$i}" by auto
- also have *: "{x::'a. a < x$$i} = (\<Union>k::nat. {(\<chi>\<chi> n. if n = i then a else -real k) <..})" using `i <DIM('a)`
- proof (safe, simp_all add: eucl_less[where 'a='a] split: split_if_asm)
- fix x
- from real_arch_lt[of "Max ((\<lambda>i. -x$$i)`{..<DIM('a)})"]
- guess k::nat .. note k = this
- { fix i assume "i < DIM('a)"
- then have "-x$$i < real k"
- using k by (subst (asm) Max_less_iff) auto
- then have "- real k < x$$i" by simp }
- then show "\<exists>k::nat. \<forall>ia. ia \<noteq> i \<longrightarrow> ia < DIM('a) \<longrightarrow> -real k < x $$ ia"
- by (auto intro!: exI[of _ k])
- qed
- finally show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
- apply (simp only:)
- apply (safe intro!: countable_UN Diff)
- by (auto simp: sets_sigma intro!: sigma_sets.Basic)
- next
- assume "\<not> i < DIM('a)"
- then show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
- using top by auto
- qed
-qed auto
-
-lemma atMost_span_atLeastAtMost:
- "sets (sigma UNIV (range (\<lambda>a. {..a\<Colon>'a\<Colon>ordered_euclidean_space}))) \<subseteq>
- sets (sigma UNIV (range (\<lambda>(a,b). {a..b})))"
- (is "_ \<subseteq> sets ?SIGMA")
-proof (rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
- then interpret sigma_algebra ?SIGMA .
- fix a::'a
- have *: "{..a} = (\<Union>n::nat. {- real n *\<^sub>R One .. a})"
- proof (safe, simp_all add: eucl_le[where 'a='a])
- fix x
- from real_arch_simple[of "Max ((\<lambda>i. - x$$i)`{..<DIM('a)})"]
- guess k::nat .. note k = this
- { fix i assume "i < DIM('a)"
- with k have "- x$$i \<le> real k"
- by (subst (asm) Max_le_iff) (auto simp: field_simps)
- then have "- real k \<le> x$$i" by simp }
- then show "\<exists>n::nat. \<forall>i<DIM('a). - real n \<le> x $$ i"
- by (auto intro!: exI[of _ k])
- qed
- show "{..a} \<in> sets ?SIGMA" unfolding *
- by (safe intro!: countable_UN)
- (auto simp: sets_sigma intro!: sigma_sets.Basic)
-qed auto
-
-lemma borel_space_eq_greaterThanLessThan:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> (a, b). {a <..< (b :: 'a \<Colon> ordered_euclidean_space)})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
- show "sets borel_space \<subseteq> sets ?SIGMA"
- unfolding borel_space_def
- proof (rule sigma_algebra.sets_sigma_subset, safe)
- show "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
- then interpret sigma_algebra ?SIGMA .
- fix M :: "'a set" assume "M \<in> open"
- then have "open M" by (simp add: mem_def)
- show "M \<in> sets ?SIGMA"
- apply (subst open_UNION[OF `open M`])
- apply (safe intro!: countable_UN)
- by (auto simp add: sigma_def intro!: sigma_sets.Basic)
- qed auto
-qed
-
-lemma borel_space_eq_atMost:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> a. {.. a::'a\<Colon>ordered_euclidean_space})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets borel_space \<subseteq> sets ?SIGMA"
- using halfspace_le_span_atMost halfspace_span_halfspace_le open_span_halfspace
- by auto
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
-qed
-
-lemma borel_space_eq_atLeastAtMost:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> (a :: 'a\<Colon>ordered_euclidean_space, b). {a .. b})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets borel_space \<subseteq> sets ?SIGMA"
- using atMost_span_atLeastAtMost halfspace_le_span_atMost
- halfspace_span_halfspace_le open_span_halfspace
- by auto
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
-qed
-
-lemma borel_space_eq_greaterThan:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> (a :: 'a\<Colon>ordered_euclidean_space). {a <..})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets borel_space \<subseteq> sets ?SIGMA"
- using halfspace_le_span_greaterThan
- halfspace_span_halfspace_le open_span_halfspace
- by auto
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
-qed
-
-lemma borel_space_eq_halfspace_le:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. x$$i \<le> a})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets borel_space \<subseteq> sets ?SIGMA"
- using open_span_halfspace halfspace_span_halfspace_le by auto
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
-qed
-
-lemma borel_space_eq_halfspace_less:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. x$$i < a})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets borel_space \<subseteq> sets ?SIGMA"
- using open_span_halfspace .
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
-qed
-
-lemma borel_space_eq_halfspace_gt:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. a < x$$i})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets borel_space \<subseteq> sets ?SIGMA"
- using halfspace_le_span_halfspace_gt open_span_halfspace halfspace_span_halfspace_le by auto
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
-qed
-
-lemma borel_space_eq_halfspace_ge:
- "sets borel_space = sets (sigma UNIV (range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. a \<le> x$$i})))"
- (is "_ = sets ?SIGMA")
-proof (rule antisym)
- show "sets borel_space \<subseteq> sets ?SIGMA"
- using halfspace_span_halfspace_ge open_span_halfspace by auto
- show "sets ?SIGMA \<subseteq> sets borel_space"
- by (rule borel_space.sets_sigma_subset) auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_halfspacesI:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
- assumes "sets borel_space = sets (sigma UNIV (range F))"
- and "\<And>a i. S a i = f -` F (a,i) \<inter> space M"
- and "\<And>a i. \<not> i < DIM('c) \<Longrightarrow> S a i \<in> sets M"
- shows "f \<in> borel_measurable M = (\<forall>i<DIM('c). \<forall>a::real. S a i \<in> sets M)"
-proof safe
- fix a :: real and i assume i: "i < DIM('c)" and f: "f \<in> borel_measurable M"
- then show "S a i \<in> sets M" unfolding assms
- by (auto intro!: measurable_sets sigma_sets.Basic simp: assms(1) sigma_def)
-next
- assume a: "\<forall>i<DIM('c). \<forall>a. S a i \<in> sets M"
- { fix a i have "S a i \<in> sets M"
- proof cases
- assume "i < DIM('c)"
- with a show ?thesis unfolding assms(2) by simp
- next
- assume "\<not> i < DIM('c)"
- from assms(3)[OF this] show ?thesis .
- qed }
- then have "f \<in> measurable M (sigma UNIV (range F))"
- by (auto intro!: measurable_sigma simp: assms(2))
- then show "f \<in> borel_measurable M" unfolding measurable_def
- unfolding assms(1) by simp
-qed
-
-lemma (in sigma_algebra) borel_measurable_iff_halfspace_le:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
- shows "f \<in> borel_measurable M = (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. f w $$ i \<le> a} \<in> sets M)"
- by (rule borel_measurable_halfspacesI[OF borel_space_eq_halfspace_le]) auto
-
-lemma (in sigma_algebra) borel_measurable_iff_halfspace_less:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
- shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. f w $$ i < a} \<in> sets M)"
- by (rule borel_measurable_halfspacesI[OF borel_space_eq_halfspace_less]) auto
-
-lemma (in sigma_algebra) borel_measurable_iff_halfspace_ge:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
- shows "f \<in> borel_measurable M = (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. a \<le> f w $$ i} \<in> sets M)"
- by (rule borel_measurable_halfspacesI[OF borel_space_eq_halfspace_ge]) auto
-
-lemma (in sigma_algebra) borel_measurable_iff_halfspace_greater:
- fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
- shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. a < f w $$ i} \<in> sets M)"
- by (rule borel_measurable_halfspacesI[OF borel_space_eq_halfspace_gt]) auto
-
-lemma (in sigma_algebra) borel_measurable_iff_le:
- "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w \<le> a} \<in> sets M)"
- using borel_measurable_iff_halfspace_le[where 'c=real] by simp
-
-lemma (in sigma_algebra) borel_measurable_iff_less:
- "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w < a} \<in> sets M)"
- using borel_measurable_iff_halfspace_less[where 'c=real] by simp
-
-lemma (in sigma_algebra) borel_measurable_iff_ge:
- "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a \<le> f w} \<in> sets M)"
- using borel_measurable_iff_halfspace_ge[where 'c=real] by simp
-
-lemma (in sigma_algebra) borel_measurable_iff_greater:
- "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a < f w} \<in> sets M)"
- using borel_measurable_iff_halfspace_greater[where 'c=real] by simp
-
-lemma borel_measureable_euclidean_component:
- "(\<lambda>x::'a::euclidean_space. x $$ i) \<in> borel_measurable borel_space"
- unfolding borel_space_def[where 'a=real]
-proof (rule borel_space.measurable_sigma)
- fix S::"real set" assume "S \<in> open" then have "open S" unfolding mem_def .
- from open_vimage_euclidean_component[OF this]
- show "(\<lambda>x. x $$ i) -` S \<inter> space borel_space \<in> sets borel_space"
- by (auto intro: borel_space_open)
-qed auto
-
-lemma (in sigma_algebra) borel_measureable_euclidean_space:
- fixes f :: "'a \<Rightarrow> 'c::ordered_euclidean_space"
- shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i<DIM('c). (\<lambda>x. f x $$ i) \<in> borel_measurable M)"
-proof safe
- fix i assume "f \<in> borel_measurable M"
- then show "(\<lambda>x. f x $$ i) \<in> borel_measurable M"
- using measurable_comp[of f _ _ "\<lambda>x. x $$ i", unfolded comp_def]
- by (auto intro: borel_measureable_euclidean_component)
-next
- assume f: "\<forall>i<DIM('c). (\<lambda>x. f x $$ i) \<in> borel_measurable M"
- then show "f \<in> borel_measurable M"
- unfolding borel_measurable_iff_halfspace_le by auto
-qed
-
-subsection "Borel measurable operators"
-
-lemma (in sigma_algebra) affine_borel_measurable_vector:
- fixes f :: "'a \<Rightarrow> 'x::real_normed_vector"
- assumes "f \<in> borel_measurable M"
- shows "(\<lambda>x. a + b *\<^sub>R f x) \<in> borel_measurable M"
-proof (rule borel_measurableI)
- fix S :: "'x set" assume "open S"
- show "(\<lambda>x. a + b *\<^sub>R f x) -` S \<inter> space M \<in> sets M"
- proof cases
- assume "b \<noteq> 0"
- with `open S` have "((\<lambda>x. (- a + x) /\<^sub>R b) ` S) \<in> open" (is "?S \<in> open")
- by (auto intro!: open_affinity simp: scaleR.add_right mem_def)
- hence "?S \<in> sets borel_space"
- unfolding borel_space_def by (auto simp: sigma_def intro!: sigma_sets.Basic)
- moreover
- from `b \<noteq> 0` have "(\<lambda>x. a + b *\<^sub>R f x) -` S = f -` ?S"
- apply auto by (rule_tac x="a + b *\<^sub>R f x" in image_eqI, simp_all)
- ultimately show ?thesis using assms unfolding in_borel_measurable_borel_space
- by auto
- qed simp
-qed
-
-lemma (in sigma_algebra) affine_borel_measurable:
- fixes g :: "'a \<Rightarrow> real"
- assumes g: "g \<in> borel_measurable M"
- shows "(\<lambda>x. a + (g x) * b) \<in> borel_measurable M"
- using affine_borel_measurable_vector[OF assms] by (simp add: mult_commute)
-
-lemma (in sigma_algebra) borel_measurable_add[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "(\<lambda>x. f x + g x) \<in> borel_measurable M"
-proof -
- have 1: "\<And>a. {w\<in>space M. a \<le> f w + g w} = {w \<in> space M. a + g w * -1 \<le> f w}"
- by auto
- have "\<And>a. (\<lambda>w. a + (g w) * -1) \<in> borel_measurable M"
- by (rule affine_borel_measurable [OF g])
- then have "\<And>a. {w \<in> space M. (\<lambda>w. a + (g w) * -1)(w) \<le> f w} \<in> sets M" using f
- by auto
- then have "\<And>a. {w \<in> space M. a \<le> f w + g w} \<in> sets M"
- by (simp add: 1)
- then show ?thesis
- by (simp add: borel_measurable_iff_ge)
-qed
-
-lemma (in sigma_algebra) borel_measurable_square:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- shows "(\<lambda>x. (f x)^2) \<in> borel_measurable M"
-proof -
- {
- fix a
- have "{w \<in> space M. (f w)\<twosuperior> \<le> a} \<in> sets M"
- proof (cases rule: linorder_cases [of a 0])
- case less
- hence "{w \<in> space M. (f w)\<twosuperior> \<le> a} = {}"
- by auto (metis less order_le_less_trans power2_less_0)
- also have "... \<in> sets M"
- by (rule empty_sets)
- finally show ?thesis .
- next
- case equal
- hence "{w \<in> space M. (f w)\<twosuperior> \<le> a} =
- {w \<in> space M. f w \<le> 0} \<inter> {w \<in> space M. 0 \<le> f w}"
- by auto
- also have "... \<in> sets M"
- apply (insert f)
- apply (rule Int)
- apply (simp add: borel_measurable_iff_le)
- apply (simp add: borel_measurable_iff_ge)
- done
- finally show ?thesis .
- next
- case greater
- have "\<forall>x. (f x ^ 2 \<le> sqrt a ^ 2) = (- sqrt a \<le> f x & f x \<le> sqrt a)"
- by (metis abs_le_interval_iff abs_of_pos greater real_sqrt_abs
- real_sqrt_le_iff real_sqrt_power)
- hence "{w \<in> space M. (f w)\<twosuperior> \<le> a} =
- {w \<in> space M. -(sqrt a) \<le> f w} \<inter> {w \<in> space M. f w \<le> sqrt a}"
- using greater by auto
- also have "... \<in> sets M"
- apply (insert f)
- apply (rule Int)
- apply (simp add: borel_measurable_iff_ge)
- apply (simp add: borel_measurable_iff_le)
- done
- finally show ?thesis .
- qed
- }
- thus ?thesis by (auto simp add: borel_measurable_iff_le)
-qed
-
-lemma times_eq_sum_squares:
- fixes x::real
- shows"x*y = ((x+y)^2)/4 - ((x-y)^ 2)/4"
-by (simp add: power2_eq_square ring_distribs diff_divide_distrib [symmetric])
-
-lemma (in sigma_algebra) borel_measurable_uminus[simp, intro]:
- fixes g :: "'a \<Rightarrow> real"
- assumes g: "g \<in> borel_measurable M"
- shows "(\<lambda>x. - g x) \<in> borel_measurable M"
-proof -
- have "(\<lambda>x. - g x) = (\<lambda>x. 0 + (g x) * -1)"
- by simp
- also have "... \<in> borel_measurable M"
- by (fast intro: affine_borel_measurable g)
- finally show ?thesis .
-qed
-
-lemma (in sigma_algebra) borel_measurable_times[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "(\<lambda>x. f x * g x) \<in> borel_measurable M"
-proof -
- have 1: "(\<lambda>x. 0 + (f x + g x)\<twosuperior> * inverse 4) \<in> borel_measurable M"
- using assms by (fast intro: affine_borel_measurable borel_measurable_square)
- have "(\<lambda>x. -((f x + -g x) ^ 2 * inverse 4)) =
- (\<lambda>x. 0 + ((f x + -g x) ^ 2 * inverse -4))"
- by (simp add: minus_divide_right)
- also have "... \<in> borel_measurable M"
- using f g by (fast intro: affine_borel_measurable borel_measurable_square f g)
- finally have 2: "(\<lambda>x. -((f x + -g x) ^ 2 * inverse 4)) \<in> borel_measurable M" .
- show ?thesis
- apply (simp add: times_eq_sum_squares diff_minus)
- using 1 2 by simp
-qed
-
-lemma (in sigma_algebra) borel_measurable_diff[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "(\<lambda>x. f x - g x) \<in> borel_measurable M"
- unfolding diff_minus using assms by fast
-
-lemma (in sigma_algebra) borel_measurable_setsum[simp, intro]:
- fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> real"
- assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
- shows "(\<lambda>x. \<Sum>i\<in>S. f i x) \<in> borel_measurable M"
-proof cases
- assume "finite S"
- thus ?thesis using assms by induct auto
-qed simp
-
-lemma (in sigma_algebra) borel_measurable_inverse[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes "f \<in> borel_measurable M"
- shows "(\<lambda>x. inverse (f x)) \<in> borel_measurable M"
- unfolding borel_measurable_iff_ge unfolding inverse_eq_divide
-proof safe
- fix a :: real
- have *: "{w \<in> space M. a \<le> 1 / f w} =
- ({w \<in> space M. 0 < f w} \<inter> {w \<in> space M. a * f w \<le> 1}) \<union>
- ({w \<in> space M. f w < 0} \<inter> {w \<in> space M. 1 \<le> a * f w}) \<union>
- ({w \<in> space M. f w = 0} \<inter> {w \<in> space M. a \<le> 0})" by (auto simp: le_divide_eq)
- show "{w \<in> space M. a \<le> 1 / f w} \<in> sets M" using assms unfolding *
- by (auto intro!: Int Un)
-qed
-
-lemma (in sigma_algebra) borel_measurable_divide[simp, intro]:
- fixes f :: "'a \<Rightarrow> real"
- assumes "f \<in> borel_measurable M"
- and "g \<in> borel_measurable M"
- shows "(\<lambda>x. f x / g x) \<in> borel_measurable M"
- unfolding field_divide_inverse
- by (rule borel_measurable_inverse borel_measurable_times assms)+
-
-lemma (in sigma_algebra) borel_measurable_max[intro, simp]:
- fixes f g :: "'a \<Rightarrow> real"
- assumes "f \<in> borel_measurable M"
- assumes "g \<in> borel_measurable M"
- shows "(\<lambda>x. max (g x) (f x)) \<in> borel_measurable M"
- unfolding borel_measurable_iff_le
-proof safe
- fix a
- have "{x \<in> space M. max (g x) (f x) \<le> a} =
- {x \<in> space M. g x \<le> a} \<inter> {x \<in> space M. f x \<le> a}" by auto
- thus "{x \<in> space M. max (g x) (f x) \<le> a} \<in> sets M"
- using assms unfolding borel_measurable_iff_le
- by (auto intro!: Int)
-qed
-
-lemma (in sigma_algebra) borel_measurable_min[intro, simp]:
- fixes f g :: "'a \<Rightarrow> real"
- assumes "f \<in> borel_measurable M"
- assumes "g \<in> borel_measurable M"
- shows "(\<lambda>x. min (g x) (f x)) \<in> borel_measurable M"
- unfolding borel_measurable_iff_ge
-proof safe
- fix a
- have "{x \<in> space M. a \<le> min (g x) (f x)} =
- {x \<in> space M. a \<le> g x} \<inter> {x \<in> space M. a \<le> f x}" by auto
- thus "{x \<in> space M. a \<le> min (g x) (f x)} \<in> sets M"
- using assms unfolding borel_measurable_iff_ge
- by (auto intro!: Int)
-qed
-
-lemma (in sigma_algebra) borel_measurable_abs[simp, intro]:
- assumes "f \<in> borel_measurable M"
- shows "(\<lambda>x. \<bar>f x :: real\<bar>) \<in> borel_measurable M"
-proof -
- have *: "\<And>x. \<bar>f x\<bar> = max 0 (f x) + max 0 (- f x)" by (simp add: max_def)
- show ?thesis unfolding * using assms by auto
-qed
-
-section "Borel space over the real line with infinity"
-
-lemma borel_space_Real_measurable:
- "A \<in> sets borel_space \<Longrightarrow> Real -` A \<in> sets borel_space"
-proof (rule borel_measurable_translate)
- fix B :: "pinfreal set" assume "open B"
- then obtain T x where T: "open T" "Real ` (T \<inter> {0..}) = B - {\<omega>}" and
- x: "\<omega> \<in> B \<Longrightarrow> 0 \<le> x" "\<omega> \<in> B \<Longrightarrow> {Real x <..} \<subseteq> B"
- unfolding open_pinfreal_def by blast
-
- have "Real -` B = Real -` (B - {\<omega>})" by auto
- also have "\<dots> = Real -` (Real ` (T \<inter> {0..}))" using T by simp
- also have "\<dots> = (if 0 \<in> T then T \<union> {.. 0} else T \<inter> {0..})"
- apply (auto simp add: Real_eq_Real image_iff)
- apply (rule_tac x="max 0 x" in bexI)
- by (auto simp: max_def)
- finally show "Real -` B \<in> sets borel_space"
- using `open T` by auto
-qed simp
-
-lemma borel_space_real_measurable:
- "A \<in> sets borel_space \<Longrightarrow> (real -` A :: pinfreal set) \<in> sets borel_space"
-proof (rule borel_measurable_translate)
- fix B :: "real set" assume "open B"
- { fix x have "0 < real x \<longleftrightarrow> (\<exists>r>0. x = Real r)" by (cases x) auto }
- note Ex_less_real = this
- have *: "real -` B = (if 0 \<in> B then real -` (B \<inter> {0 <..}) \<union> {0, \<omega>} else real -` (B \<inter> {0 <..}))"
- by (force simp: Ex_less_real)
-
- have "open (real -` (B \<inter> {0 <..}) :: pinfreal set)"
- unfolding open_pinfreal_def using `open B`
- by (auto intro!: open_Int exI[of _ "B \<inter> {0 <..}"] simp: image_iff Ex_less_real)
- then show "(real -` B :: pinfreal set) \<in> sets borel_space" unfolding * by auto
-qed simp
-
-lemma (in sigma_algebra) borel_measurable_Real[intro, simp]:
- assumes "f \<in> borel_measurable M"
- shows "(\<lambda>x. Real (f x)) \<in> borel_measurable M"
- unfolding in_borel_measurable_borel_space
-proof safe
- fix S :: "pinfreal set" assume "S \<in> sets borel_space"
- from borel_space_Real_measurable[OF this]
- have "(Real \<circ> f) -` S \<inter> space M \<in> sets M"
- using assms
- unfolding vimage_compose in_borel_measurable_borel_space
- by auto
- thus "(\<lambda>x. Real (f x)) -` S \<inter> space M \<in> sets M" by (simp add: comp_def)
-qed
-
-lemma (in sigma_algebra) borel_measurable_real[intro, simp]:
- fixes f :: "'a \<Rightarrow> pinfreal"
- assumes "f \<in> borel_measurable M"
- shows "(\<lambda>x. real (f x)) \<in> borel_measurable M"
- unfolding in_borel_measurable_borel_space
-proof safe
- fix S :: "real set" assume "S \<in> sets borel_space"
- from borel_space_real_measurable[OF this]
- have "(real \<circ> f) -` S \<inter> space M \<in> sets M"
- using assms
- unfolding vimage_compose in_borel_measurable_borel_space
- by auto
- thus "(\<lambda>x. real (f x)) -` S \<inter> space M \<in> sets M" by (simp add: comp_def)
-qed
-
-lemma (in sigma_algebra) borel_measurable_Real_eq:
- assumes "\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> f x"
- shows "(\<lambda>x. Real (f x)) \<in> borel_measurable M \<longleftrightarrow> f \<in> borel_measurable M"
-proof
- have [simp]: "(\<lambda>x. Real (f x)) -` {\<omega>} \<inter> space M = {}"
- by auto
- assume "(\<lambda>x. Real (f x)) \<in> borel_measurable M"
- hence "(\<lambda>x. real (Real (f x))) \<in> borel_measurable M"
- by (rule borel_measurable_real)
- moreover have "\<And>x. x \<in> space M \<Longrightarrow> real (Real (f x)) = f x"
- using assms by auto
- ultimately show "f \<in> borel_measurable M"
- by (simp cong: measurable_cong)
-qed auto
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_eq_real:
- "f \<in> borel_measurable M \<longleftrightarrow>
- ((\<lambda>x. real (f x)) \<in> borel_measurable M \<and> f -` {\<omega>} \<inter> space M \<in> sets M)"
-proof safe
- assume "f \<in> borel_measurable M"
- then show "(\<lambda>x. real (f x)) \<in> borel_measurable M" "f -` {\<omega>} \<inter> space M \<in> sets M"
- by (auto intro: borel_measurable_vimage borel_measurable_real)
-next
- assume *: "(\<lambda>x. real (f x)) \<in> borel_measurable M" "f -` {\<omega>} \<inter> space M \<in> sets M"
- have "f -` {\<omega>} \<inter> space M = {x\<in>space M. f x = \<omega>}" by auto
- with * have **: "{x\<in>space M. f x = \<omega>} \<in> sets M" by simp
- have f: "f = (\<lambda>x. if f x = \<omega> then \<omega> else Real (real (f x)))"
- by (simp add: fun_eq_iff Real_real)
- show "f \<in> borel_measurable M"
- apply (subst f)
- apply (rule measurable_If)
- using * ** by auto
-qed
-
-lemma (in sigma_algebra) less_eq_ge_measurable:
- fixes f :: "'a \<Rightarrow> 'c::linorder"
- shows "{x\<in>space M. a < f x} \<in> sets M \<longleftrightarrow> {x\<in>space M. f x \<le> a} \<in> sets M"
-proof
- assume "{x\<in>space M. f x \<le> a} \<in> sets M"
- moreover have "{x\<in>space M. a < f x} = space M - {x\<in>space M. f x \<le> a}" by auto
- ultimately show "{x\<in>space M. a < f x} \<in> sets M" by auto
-next
- assume "{x\<in>space M. a < f x} \<in> sets M"
- moreover have "{x\<in>space M. f x \<le> a} = space M - {x\<in>space M. a < f x}" by auto
- ultimately show "{x\<in>space M. f x \<le> a} \<in> sets M" by auto
-qed
-
-lemma (in sigma_algebra) greater_eq_le_measurable:
- fixes f :: "'a \<Rightarrow> 'c::linorder"
- shows "{x\<in>space M. f x < a} \<in> sets M \<longleftrightarrow> {x\<in>space M. a \<le> f x} \<in> sets M"
-proof
- assume "{x\<in>space M. a \<le> f x} \<in> sets M"
- moreover have "{x\<in>space M. f x < a} = space M - {x\<in>space M. a \<le> f x}" by auto
- ultimately show "{x\<in>space M. f x < a} \<in> sets M" by auto
-next
- assume "{x\<in>space M. f x < a} \<in> sets M"
- moreover have "{x\<in>space M. a \<le> f x} = space M - {x\<in>space M. f x < a}" by auto
- ultimately show "{x\<in>space M. a \<le> f x} \<in> sets M" by auto
-qed
-
-lemma (in sigma_algebra) less_eq_le_pinfreal_measurable:
- fixes f :: "'a \<Rightarrow> pinfreal"
- shows "(\<forall>a. {x\<in>space M. a < f x} \<in> sets M) \<longleftrightarrow> (\<forall>a. {x\<in>space M. a \<le> f x} \<in> sets M)"
-proof
- assume a: "\<forall>a. {x\<in>space M. a \<le> f x} \<in> sets M"
- show "\<forall>a. {x \<in> space M. a < f x} \<in> sets M"
- proof
- fix a show "{x \<in> space M. a < f x} \<in> sets M"
- proof (cases a)
- case (preal r)
- have "{x\<in>space M. a < f x} = (\<Union>i. {x\<in>space M. a + inverse (of_nat (Suc i)) \<le> f x})"
- proof safe
- fix x assume "a < f x" and [simp]: "x \<in> space M"
- with ex_pinfreal_inverse_of_nat_Suc_less[of "f x - a"]
- obtain n where "a + inverse (of_nat (Suc n)) < f x"
- by (cases "f x", auto simp: pinfreal_minus_order)
- then have "a + inverse (of_nat (Suc n)) \<le> f x" by simp
- then show "x \<in> (\<Union>i. {x \<in> space M. a + inverse (of_nat (Suc i)) \<le> f x})"
- by auto
- next
- fix i x assume [simp]: "x \<in> space M"
- have "a < a + inverse (of_nat (Suc i))" using preal by auto
- also assume "a + inverse (of_nat (Suc i)) \<le> f x"
- finally show "a < f x" .
- qed
- with a show ?thesis by auto
- qed simp
- qed
-next
- assume a': "\<forall>a. {x \<in> space M. a < f x} \<in> sets M"
- then have a: "\<forall>a. {x \<in> space M. f x \<le> a} \<in> sets M" unfolding less_eq_ge_measurable .
- show "\<forall>a. {x \<in> space M. a \<le> f x} \<in> sets M" unfolding greater_eq_le_measurable[symmetric]
- proof
- fix a show "{x \<in> space M. f x < a} \<in> sets M"
- proof (cases a)
- case (preal r)
- show ?thesis
- proof cases
- assume "a = 0" then show ?thesis by simp
- next
- assume "a \<noteq> 0"
- have "{x\<in>space M. f x < a} = (\<Union>i. {x\<in>space M. f x \<le> a - inverse (of_nat (Suc i))})"
- proof safe
- fix x assume "f x < a" and [simp]: "x \<in> space M"
- with ex_pinfreal_inverse_of_nat_Suc_less[of "a - f x"]
- obtain n where "inverse (of_nat (Suc n)) < a - f x"
- using preal by (cases "f x") auto
- then have "f x \<le> a - inverse (of_nat (Suc n)) "
- using preal by (cases "f x") (auto split: split_if_asm)
- then show "x \<in> (\<Union>i. {x \<in> space M. f x \<le> a - inverse (of_nat (Suc i))})"
- by auto
- next
- fix i x assume [simp]: "x \<in> space M"
- assume "f x \<le> a - inverse (of_nat (Suc i))"
- also have "\<dots> < a" using `a \<noteq> 0` preal by auto
- finally show "f x < a" .
- qed
- with a show ?thesis by auto
- qed
- next
- case infinite
- have "f -` {\<omega>} \<inter> space M = (\<Inter>n. {x\<in>space M. of_nat n < f x})"
- proof (safe, simp_all, safe)
- fix x assume *: "\<forall>n::nat. Real (real n) < f x"
- show "f x = \<omega>" proof (rule ccontr)
- assume "f x \<noteq> \<omega>"
- with real_arch_lt[of "real (f x)"] obtain n where "f x < of_nat n"
- by (auto simp: pinfreal_noteq_omega_Ex)
- with *[THEN spec, of n] show False by auto
- qed
- qed
- with a' have \<omega>: "f -` {\<omega>} \<inter> space M \<in> sets M" by auto
- moreover have "{x \<in> space M. f x < a} = space M - f -` {\<omega>} \<inter> space M"
- using infinite by auto
- ultimately show ?thesis by auto
- qed
- qed
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_iff_greater:
- "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. a < f x} \<in> sets M)"
-proof safe
- fix a assume f: "f \<in> borel_measurable M"
- have "{x\<in>space M. a < f x} = f -` {a <..} \<inter> space M" by auto
- with f show "{x\<in>space M. a < f x} \<in> sets M"
- by (auto intro!: measurable_sets)
-next
- assume *: "\<forall>a. {x\<in>space M. a < f x} \<in> sets M"
- hence **: "\<forall>a. {x\<in>space M. f x < a} \<in> sets M"
- unfolding less_eq_le_pinfreal_measurable
- unfolding greater_eq_le_measurable .
-
- show "f \<in> borel_measurable M" unfolding borel_measurable_pinfreal_eq_real borel_measurable_iff_greater
- proof safe
- have "f -` {\<omega>} \<inter> space M = space M - {x\<in>space M. f x < \<omega>}" by auto
- then show \<omega>: "f -` {\<omega>} \<inter> space M \<in> sets M" using ** by auto
-
- fix a
- have "{w \<in> space M. a < real (f w)} =
- (if 0 \<le> a then {w\<in>space M. Real a < f w} - (f -` {\<omega>} \<inter> space M) else space M)"
- proof (split split_if, safe del: notI)
- fix x assume "0 \<le> a"
- { assume "a < real (f x)" then show "Real a < f x" "x \<notin> f -` {\<omega>} \<inter> space M"
- using `0 \<le> a` by (cases "f x", auto) }
- { assume "Real a < f x" "x \<notin> f -` {\<omega>}" then show "a < real (f x)"
- using `0 \<le> a` by (cases "f x", auto) }
- next
- fix x assume "\<not> 0 \<le> a" then show "a < real (f x)" by (cases "f x") auto
- qed
- then show "{w \<in> space M. a < real (f w)} \<in> sets M"
- using \<omega> * by (auto intro!: Diff)
- qed
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_iff_less:
- "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. f x < a} \<in> sets M)"
- using borel_measurable_pinfreal_iff_greater unfolding less_eq_le_pinfreal_measurable greater_eq_le_measurable .
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_iff_le:
- "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. f x \<le> a} \<in> sets M)"
- using borel_measurable_pinfreal_iff_greater unfolding less_eq_ge_measurable .
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_iff_ge:
- "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. a \<le> f x} \<in> sets M)"
- using borel_measurable_pinfreal_iff_greater unfolding less_eq_le_pinfreal_measurable .
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_eq_const:
- fixes f :: "'a \<Rightarrow> pinfreal" assumes "f \<in> borel_measurable M"
- shows "{x\<in>space M. f x = c} \<in> sets M"
-proof -
- have "{x\<in>space M. f x = c} = (f -` {c} \<inter> space M)" by auto
- then show ?thesis using assms by (auto intro!: measurable_sets)
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_neq_const:
- fixes f :: "'a \<Rightarrow> pinfreal"
- assumes "f \<in> borel_measurable M"
- shows "{x\<in>space M. f x \<noteq> c} \<in> sets M"
-proof -
- have "{x\<in>space M. f x \<noteq> c} = space M - (f -` {c} \<inter> space M)" by auto
- then show ?thesis using assms by (auto intro!: measurable_sets)
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_less[intro,simp]:
- fixes f g :: "'a \<Rightarrow> pinfreal"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{x \<in> space M. f x < g x} \<in> sets M"
-proof -
- have "(\<lambda>x. real (f x)) \<in> borel_measurable M"
- "(\<lambda>x. real (g x)) \<in> borel_measurable M"
- using assms by (auto intro!: borel_measurable_real)
- from borel_measurable_less[OF this]
- have "{x \<in> space M. real (f x) < real (g x)} \<in> sets M" .
- moreover have "{x \<in> space M. f x \<noteq> \<omega>} \<in> sets M" using f by (rule borel_measurable_pinfreal_neq_const)
- moreover have "{x \<in> space M. g x = \<omega>} \<in> sets M" using g by (rule borel_measurable_pinfreal_eq_const)
- moreover have "{x \<in> space M. g x \<noteq> \<omega>} \<in> sets M" using g by (rule borel_measurable_pinfreal_neq_const)
- moreover have "{x \<in> space M. f x < g x} = ({x \<in> space M. g x = \<omega>} \<inter> {x \<in> space M. f x \<noteq> \<omega>}) \<union>
- ({x \<in> space M. g x \<noteq> \<omega>} \<inter> {x \<in> space M. f x \<noteq> \<omega>} \<inter> {x \<in> space M. real (f x) < real (g x)})"
- by (auto simp: real_of_pinfreal_strict_mono_iff)
- ultimately show ?thesis by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_le[intro,simp]:
- fixes f :: "'a \<Rightarrow> pinfreal"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{x \<in> space M. f x \<le> g x} \<in> sets M"
-proof -
- have "{x \<in> space M. f x \<le> g x} = space M - {x \<in> space M. g x < f x}" by auto
- then show ?thesis using g f by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_eq[intro,simp]:
- fixes f :: "'a \<Rightarrow> pinfreal"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{w \<in> space M. f w = g w} \<in> sets M"
-proof -
- have "{x \<in> space M. f x = g x} = {x \<in> space M. g x \<le> f x} \<inter> {x \<in> space M. f x \<le> g x}" by auto
- then show ?thesis using g f by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_neq[intro,simp]:
- fixes f :: "'a \<Rightarrow> pinfreal"
- assumes f: "f \<in> borel_measurable M"
- assumes g: "g \<in> borel_measurable M"
- shows "{w \<in> space M. f w \<noteq> g w} \<in> sets M"
-proof -
- have "{w \<in> space M. f w \<noteq> g w} = space M - {w \<in> space M. f w = g w}" by auto
- thus ?thesis using f g by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_add[intro, simp]:
- fixes f :: "'a \<Rightarrow> pinfreal"
- assumes measure: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
- shows "(\<lambda>x. f x + g x) \<in> borel_measurable M"
-proof -
- have *: "(\<lambda>x. f x + g x) =
- (\<lambda>x. if f x = \<omega> then \<omega> else if g x = \<omega> then \<omega> else Real (real (f x) + real (g x)))"
- by (auto simp: fun_eq_iff pinfreal_noteq_omega_Ex)
- show ?thesis using assms unfolding *
- by (auto intro!: measurable_If)
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_times[intro, simp]:
- fixes f :: "'a \<Rightarrow> pinfreal" assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
- shows "(\<lambda>x. f x * g x) \<in> borel_measurable M"
-proof -
- have *: "(\<lambda>x. f x * g x) =
- (\<lambda>x. if f x = 0 then 0 else if g x = 0 then 0 else if f x = \<omega> then \<omega> else if g x = \<omega> then \<omega> else
- Real (real (f x) * real (g x)))"
- by (auto simp: fun_eq_iff pinfreal_noteq_omega_Ex)
- show ?thesis using assms unfolding *
- by (auto intro!: measurable_If)
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_setsum[simp, intro]:
- fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> pinfreal"
- assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
- shows "(\<lambda>x. \<Sum>i\<in>S. f i x) \<in> borel_measurable M"
-proof cases
- assume "finite S"
- thus ?thesis using assms
- by induct auto
-qed (simp add: borel_measurable_const)
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_min[intro, simp]:
- fixes f g :: "'a \<Rightarrow> pinfreal"
- assumes "f \<in> borel_measurable M"
- assumes "g \<in> borel_measurable M"
- shows "(\<lambda>x. min (g x) (f x)) \<in> borel_measurable M"
- using assms unfolding min_def by (auto intro!: measurable_If)
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_max[intro]:
- fixes f g :: "'a \<Rightarrow> pinfreal"
- assumes "f \<in> borel_measurable M"
- and "g \<in> borel_measurable M"
- shows "(\<lambda>x. max (g x) (f x)) \<in> borel_measurable M"
- using assms unfolding max_def by (auto intro!: measurable_If)
-
-lemma (in sigma_algebra) borel_measurable_SUP[simp, intro]:
- fixes f :: "'d\<Colon>countable \<Rightarrow> 'a \<Rightarrow> pinfreal"
- assumes "\<And>i. i \<in> A \<Longrightarrow> f i \<in> borel_measurable M"
- shows "(SUP i : A. f i) \<in> borel_measurable M" (is "?sup \<in> borel_measurable M")
- unfolding borel_measurable_pinfreal_iff_greater
-proof safe
- fix a
- have "{x\<in>space M. a < ?sup x} = (\<Union>i\<in>A. {x\<in>space M. a < f i x})"
- by (auto simp: less_Sup_iff SUPR_def[where 'a=pinfreal] SUPR_fun_expand[where 'c=pinfreal])
- then show "{x\<in>space M. a < ?sup x} \<in> sets M"
- using assms by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_INF[simp, intro]:
- fixes f :: "'d :: countable \<Rightarrow> 'a \<Rightarrow> pinfreal"
- assumes "\<And>i. i \<in> A \<Longrightarrow> f i \<in> borel_measurable M"
- shows "(INF i : A. f i) \<in> borel_measurable M" (is "?inf \<in> borel_measurable M")
- unfolding borel_measurable_pinfreal_iff_less
-proof safe
- fix a
- have "{x\<in>space M. ?inf x < a} = (\<Union>i\<in>A. {x\<in>space M. f i x < a})"
- by (auto simp: Inf_less_iff INFI_def[where 'a=pinfreal] INFI_fun_expand)
- then show "{x\<in>space M. ?inf x < a} \<in> sets M"
- using assms by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_pinfreal_diff:
- fixes f g :: "'a \<Rightarrow> pinfreal"
- assumes "f \<in> borel_measurable M"
- assumes "g \<in> borel_measurable M"
- shows "(\<lambda>x. f x - g x) \<in> borel_measurable M"
- unfolding borel_measurable_pinfreal_iff_greater
-proof safe
- fix a
- have "{x \<in> space M. a < f x - g x} = {x \<in> space M. g x + a < f x}"
- by (simp add: pinfreal_less_minus_iff)
- then show "{x \<in> space M. a < f x - g x} \<in> sets M"
- using assms by auto
-qed
-
-lemma (in sigma_algebra) borel_measurable_psuminf:
- assumes "\<And>i. f i \<in> borel_measurable M"
- shows "(\<lambda>x. (\<Sum>\<^isub>\<infinity> i. f i x)) \<in> borel_measurable M"
- using assms unfolding psuminf_def
- by (auto intro!: borel_measurable_SUP[unfolded SUPR_fun_expand])
-
-section "LIMSEQ is borel measurable"
-
-lemma (in sigma_algebra) borel_measurable_LIMSEQ:
- fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> real"
- assumes u': "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. u i x) ----> u' x"
- and u: "\<And>i. u i \<in> borel_measurable M"
- shows "u' \<in> borel_measurable M"
-proof -
- let "?pu x i" = "max (u i x) 0"
- let "?nu x i" = "max (- u i x) 0"
-
- { fix x assume x: "x \<in> space M"
- have "(?pu x) ----> max (u' x) 0"
- "(?nu x) ----> max (- u' x) 0"
- using u'[OF x] by (auto intro!: LIMSEQ_max LIMSEQ_minus)
- from LIMSEQ_imp_lim_INF[OF _ this(1)] LIMSEQ_imp_lim_INF[OF _ this(2)]
- have "(SUP n. INF m. Real (u (n + m) x)) = Real (u' x)"
- "(SUP n. INF m. Real (- u (n + m) x)) = Real (- u' x)"
- by (simp_all add: Real_max'[symmetric]) }
- note eq = this
-
- have *: "\<And>x. real (Real (u' x)) - real (Real (- u' x)) = u' x"
- by auto
-
- have "(SUP n. INF m. (\<lambda>x. Real (u (n + m) x))) \<in> borel_measurable M"
- "(SUP n. INF m. (\<lambda>x. Real (- u (n + m) x))) \<in> borel_measurable M"
- using u by (auto intro: borel_measurable_SUP borel_measurable_INF borel_measurable_Real)
- with eq[THEN measurable_cong, of M "\<lambda>x. x" borel_space]
- have "(\<lambda>x. Real (u' x)) \<in> borel_measurable M"
- "(\<lambda>x. Real (- u' x)) \<in> borel_measurable M"
- unfolding SUPR_fun_expand INFI_fun_expand by auto
- note this[THEN borel_measurable_real]
- from borel_measurable_diff[OF this]
- show ?thesis unfolding * .
-qed
-
-end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Probability/Borel_Space.thy Thu Dec 02 11:18:44 2010 -0800
@@ -0,0 +1,1451 @@
+(* Author: Armin Heller, Johannes Hoelzl, TU Muenchen *)
+
+header {*Borel spaces*}
+
+theory Borel_Space
+ imports Sigma_Algebra Positive_Infinite_Real Multivariate_Analysis
+begin
+
+lemma LIMSEQ_max:
+ "u ----> (x::real) \<Longrightarrow> (\<lambda>i. max (u i) 0) ----> max x 0"
+ by (fastsimp intro!: LIMSEQ_I dest!: LIMSEQ_D)
+
+section "Generic Borel spaces"
+
+definition "borel = sigma \<lparr> space = UNIV::'a::topological_space set, sets = open\<rparr>"
+abbreviation "borel_measurable M \<equiv> measurable M borel"
+
+interpretation borel: sigma_algebra borel
+ by (auto simp: borel_def intro!: sigma_algebra_sigma)
+
+lemma in_borel_measurable:
+ "f \<in> borel_measurable M \<longleftrightarrow>
+ (\<forall>S \<in> sets (sigma \<lparr> space = UNIV, sets = open\<rparr>).
+ f -` S \<inter> space M \<in> sets M)"
+ by (auto simp add: measurable_def borel_def)
+
+lemma in_borel_measurable_borel:
+ "f \<in> borel_measurable M \<longleftrightarrow>
+ (\<forall>S \<in> sets borel.
+ f -` S \<inter> space M \<in> sets M)"
+ by (auto simp add: measurable_def borel_def)
+
+lemma space_borel[simp]: "space borel = UNIV"
+ unfolding borel_def by auto
+
+lemma borel_open[simp]:
+ assumes "open A" shows "A \<in> sets borel"
+proof -
+ have "A \<in> open" unfolding mem_def using assms .
+ thus ?thesis unfolding borel_def sigma_def by (auto intro!: sigma_sets.Basic)
+qed
+
+lemma borel_closed[simp]:
+ assumes "closed A" shows "A \<in> sets borel"
+proof -
+ have "space borel - (- A) \<in> sets borel"
+ using assms unfolding closed_def by (blast intro: borel_open)
+ thus ?thesis by simp
+qed
+
+lemma (in sigma_algebra) borel_measurable_vimage:
+ fixes f :: "'a \<Rightarrow> 'x::t2_space"
+ assumes borel: "f \<in> borel_measurable M"
+ shows "f -` {x} \<inter> space M \<in> sets M"
+proof (cases "x \<in> f ` space M")
+ case True then obtain y where "x = f y" by auto
+ from closed_sing[of "f y"]
+ have "{f y} \<in> sets borel" by (rule borel_closed)
+ with assms show ?thesis
+ unfolding in_borel_measurable_borel `x = f y` by auto
+next
+ case False hence "f -` {x} \<inter> space M = {}" by auto
+ thus ?thesis by auto
+qed
+
+lemma (in sigma_algebra) borel_measurableI:
+ fixes f :: "'a \<Rightarrow> 'x\<Colon>topological_space"
+ assumes "\<And>S. open S \<Longrightarrow> f -` S \<inter> space M \<in> sets M"
+ shows "f \<in> borel_measurable M"
+ unfolding borel_def
+proof (rule measurable_sigma, simp_all)
+ fix S :: "'x set" assume "S \<in> open" thus "f -` S \<inter> space M \<in> sets M"
+ using assms[of S] by (simp add: mem_def)
+qed
+
+lemma borel_singleton[simp, intro]:
+ fixes x :: "'a::t1_space"
+ shows "A \<in> sets borel \<Longrightarrow> insert x A \<in> sets borel"
+ proof (rule borel.insert_in_sets)
+ show "{x} \<in> sets borel"
+ using closed_sing[of x] by (rule borel_closed)
+ qed simp
+
+lemma (in sigma_algebra) borel_measurable_const[simp, intro]:
+ "(\<lambda>x. c) \<in> borel_measurable M"
+ by (auto intro!: measurable_const)
+
+lemma (in sigma_algebra) borel_measurable_indicator[simp, intro!]:
+ assumes A: "A \<in> sets M"
+ shows "indicator A \<in> borel_measurable M"
+ unfolding indicator_def_raw using A
+ by (auto intro!: measurable_If_set borel_measurable_const)
+
+lemma (in sigma_algebra) borel_measurable_indicator_iff:
+ "(indicator A :: 'a \<Rightarrow> 'x::{t1_space, zero_neq_one}) \<in> borel_measurable M \<longleftrightarrow> A \<inter> space M \<in> sets M"
+ (is "?I \<in> borel_measurable M \<longleftrightarrow> _")
+proof
+ assume "?I \<in> borel_measurable M"
+ then have "?I -` {1} \<inter> space M \<in> sets M"
+ unfolding measurable_def by auto
+ also have "?I -` {1} \<inter> space M = A \<inter> space M"
+ unfolding indicator_def_raw by auto
+ finally show "A \<inter> space M \<in> sets M" .
+next
+ assume "A \<inter> space M \<in> sets M"
+ moreover have "?I \<in> borel_measurable M \<longleftrightarrow>
+ (indicator (A \<inter> space M) :: 'a \<Rightarrow> 'x) \<in> borel_measurable M"
+ by (intro measurable_cong) (auto simp: indicator_def)
+ ultimately show "?I \<in> borel_measurable M" by auto
+qed
+
+lemma borel_measurable_translate:
+ assumes "A \<in> sets borel" and trans: "\<And>B. open B \<Longrightarrow> f -` B \<in> sets borel"
+ shows "f -` A \<in> sets borel"
+proof -
+ have "A \<in> sigma_sets UNIV open" using assms
+ by (simp add: borel_def sigma_def)
+ thus ?thesis
+ proof (induct rule: sigma_sets.induct)
+ case (Basic a) thus ?case using trans[of a] by (simp add: mem_def)
+ next
+ case (Compl a)
+ moreover have "UNIV \<in> sets borel"
+ using borel.top by simp
+ ultimately show ?case
+ by (auto simp: vimage_Diff borel.Diff)
+ qed (auto simp add: vimage_UN)
+qed
+
+lemma (in sigma_algebra) borel_measurable_restricted:
+ fixes f :: "'a \<Rightarrow> 'x\<Colon>{topological_space, semiring_1}" assumes "A \<in> sets M"
+ shows "f \<in> borel_measurable (restricted_space A) \<longleftrightarrow>
+ (\<lambda>x. f x * indicator A x) \<in> borel_measurable M"
+ (is "f \<in> borel_measurable ?R \<longleftrightarrow> ?f \<in> borel_measurable M")
+proof -
+ interpret R: sigma_algebra ?R by (rule restricted_sigma_algebra[OF `A \<in> sets M`])
+ have *: "f \<in> borel_measurable ?R \<longleftrightarrow> ?f \<in> borel_measurable ?R"
+ by (auto intro!: measurable_cong)
+ show ?thesis unfolding *
+ unfolding in_borel_measurable_borel
+ proof (simp, safe)
+ fix S :: "'x set" assume "S \<in> sets borel"
+ "\<forall>S\<in>sets borel. ?f -` S \<inter> A \<in> op \<inter> A ` sets M"
+ then have "?f -` S \<inter> A \<in> op \<inter> A ` sets M" by auto
+ then have f: "?f -` S \<inter> A \<in> sets M"
+ using `A \<in> sets M` sets_into_space by fastsimp
+ show "?f -` S \<inter> space M \<in> sets M"
+ proof cases
+ assume "0 \<in> S"
+ then have "?f -` S \<inter> space M = ?f -` S \<inter> A \<union> (space M - A)"
+ using `A \<in> sets M` sets_into_space by auto
+ then show ?thesis using f `A \<in> sets M` by (auto intro!: Un Diff)
+ next
+ assume "0 \<notin> S"
+ then have "?f -` S \<inter> space M = ?f -` S \<inter> A"
+ using `A \<in> sets M` sets_into_space
+ by (auto simp: indicator_def split: split_if_asm)
+ then show ?thesis using f by auto
+ qed
+ next
+ fix S :: "'x set" assume "S \<in> sets borel"
+ "\<forall>S\<in>sets borel. ?f -` S \<inter> space M \<in> sets M"
+ then have f: "?f -` S \<inter> space M \<in> sets M" by auto
+ then show "?f -` S \<inter> A \<in> op \<inter> A ` sets M"
+ using `A \<in> sets M` sets_into_space
+ apply (simp add: image_iff)
+ apply (rule bexI[OF _ f])
+ by auto
+ qed
+qed
+
+lemma (in sigma_algebra) borel_measurable_subalgebra:
+ assumes "N \<subseteq> sets M" "f \<in> borel_measurable (M\<lparr>sets:=N\<rparr>)"
+ shows "f \<in> borel_measurable M"
+ using assms unfolding measurable_def by auto
+
+section "Borel spaces on euclidean spaces"
+
+lemma lessThan_borel[simp, intro]:
+ fixes a :: "'a\<Colon>ordered_euclidean_space"
+ shows "{..< a} \<in> sets borel"
+ by (blast intro: borel_open)
+
+lemma greaterThan_borel[simp, intro]:
+ fixes a :: "'a\<Colon>ordered_euclidean_space"
+ shows "{a <..} \<in> sets borel"
+ by (blast intro: borel_open)
+
+lemma greaterThanLessThan_borel[simp, intro]:
+ fixes a b :: "'a\<Colon>ordered_euclidean_space"
+ shows "{a<..<b} \<in> sets borel"
+ by (blast intro: borel_open)
+
+lemma atMost_borel[simp, intro]:
+ fixes a :: "'a\<Colon>ordered_euclidean_space"
+ shows "{..a} \<in> sets borel"
+ by (blast intro: borel_closed)
+
+lemma atLeast_borel[simp, intro]:
+ fixes a :: "'a\<Colon>ordered_euclidean_space"
+ shows "{a..} \<in> sets borel"
+ by (blast intro: borel_closed)
+
+lemma atLeastAtMost_borel[simp, intro]:
+ fixes a b :: "'a\<Colon>ordered_euclidean_space"
+ shows "{a..b} \<in> sets borel"
+ by (blast intro: borel_closed)
+
+lemma greaterThanAtMost_borel[simp, intro]:
+ fixes a b :: "'a\<Colon>ordered_euclidean_space"
+ shows "{a<..b} \<in> sets borel"
+ unfolding greaterThanAtMost_def by blast
+
+lemma atLeastLessThan_borel[simp, intro]:
+ fixes a b :: "'a\<Colon>ordered_euclidean_space"
+ shows "{a..<b} \<in> sets borel"
+ unfolding atLeastLessThan_def by blast
+
+lemma hafspace_less_borel[simp, intro]:
+ fixes a :: real
+ shows "{x::'a::euclidean_space. a < x $$ i} \<in> sets borel"
+ by (auto intro!: borel_open open_halfspace_component_gt)
+
+lemma hafspace_greater_borel[simp, intro]:
+ fixes a :: real
+ shows "{x::'a::euclidean_space. x $$ i < a} \<in> sets borel"
+ by (auto intro!: borel_open open_halfspace_component_lt)
+
+lemma hafspace_less_eq_borel[simp, intro]:
+ fixes a :: real
+ shows "{x::'a::euclidean_space. a \<le> x $$ i} \<in> sets borel"
+ by (auto intro!: borel_closed closed_halfspace_component_ge)
+
+lemma hafspace_greater_eq_borel[simp, intro]:
+ fixes a :: real
+ shows "{x::'a::euclidean_space. x $$ i \<le> a} \<in> sets borel"
+ by (auto intro!: borel_closed closed_halfspace_component_le)
+
+lemma (in sigma_algebra) borel_measurable_less[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{w \<in> space M. f w < g w} \<in> sets M"
+proof -
+ have "{w \<in> space M. f w < g w} =
+ (\<Union>r. (f -` {..< of_rat r} \<inter> space M) \<inter> (g -` {of_rat r <..} \<inter> space M))"
+ using Rats_dense_in_real by (auto simp add: Rats_def)
+ then show ?thesis using f g
+ by simp (blast intro: measurable_sets)
+qed
+
+lemma (in sigma_algebra) borel_measurable_le[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{w \<in> space M. f w \<le> g w} \<in> sets M"
+proof -
+ have "{w \<in> space M. f w \<le> g w} = space M - {w \<in> space M. g w < f w}"
+ by auto
+ thus ?thesis using f g
+ by simp blast
+qed
+
+lemma (in sigma_algebra) borel_measurable_eq[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{w \<in> space M. f w = g w} \<in> sets M"
+proof -
+ have "{w \<in> space M. f w = g w} =
+ {w \<in> space M. f w \<le> g w} \<inter> {w \<in> space M. g w \<le> f w}"
+ by auto
+ thus ?thesis using f g by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_neq[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{w \<in> space M. f w \<noteq> g w} \<in> sets M"
+proof -
+ have "{w \<in> space M. f w \<noteq> g w} = space M - {w \<in> space M. f w = g w}"
+ by auto
+ thus ?thesis using f g by auto
+qed
+
+subsection "Borel space equals sigma algebras over intervals"
+
+lemma rational_boxes:
+ fixes x :: "'a\<Colon>ordered_euclidean_space"
+ assumes "0 < e"
+ shows "\<exists>a b. (\<forall>i. a $$ i \<in> \<rat>) \<and> (\<forall>i. b $$ i \<in> \<rat>) \<and> x \<in> {a <..< b} \<and> {a <..< b} \<subseteq> ball x e"
+proof -
+ def e' \<equiv> "e / (2 * sqrt (real (DIM ('a))))"
+ then have e: "0 < e'" using assms by (auto intro!: divide_pos_pos)
+ have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> y < x $$ i \<and> x $$ i - y < e'" (is "\<forall>i. ?th i")
+ proof
+ fix i from Rats_dense_in_real[of "x $$ i - e'" "x $$ i"] e
+ show "?th i" by auto
+ qed
+ from choice[OF this] guess a .. note a = this
+ have "\<forall>i. \<exists>y. y \<in> \<rat> \<and> x $$ i < y \<and> y - x $$ i < e'" (is "\<forall>i. ?th i")
+ proof
+ fix i from Rats_dense_in_real[of "x $$ i" "x $$ i + e'"] e
+ show "?th i" by auto
+ qed
+ from choice[OF this] guess b .. note b = this
+ { fix y :: 'a assume *: "Chi a < y" "y < Chi b"
+ have "dist x y = sqrt (\<Sum>i<DIM('a). (dist (x $$ i) (y $$ i))\<twosuperior>)"
+ unfolding setL2_def[symmetric] by (rule euclidean_dist_l2)
+ also have "\<dots> < sqrt (\<Sum>i<DIM('a). e^2 / real (DIM('a)))"
+ proof (rule real_sqrt_less_mono, rule setsum_strict_mono)
+ fix i assume i: "i \<in> {..<DIM('a)}"
+ have "a i < y$$i \<and> y$$i < b i" using * i eucl_less[where 'a='a] by auto
+ moreover have "a i < x$$i" "x$$i - a i < e'" using a by auto
+ moreover have "x$$i < b i" "b i - x$$i < e'" using b by auto
+ ultimately have "\<bar>x$$i - y$$i\<bar> < 2 * e'" by auto
+ then have "dist (x $$ i) (y $$ i) < e/sqrt (real (DIM('a)))"
+ unfolding e'_def by (auto simp: dist_real_def)
+ then have "(dist (x $$ i) (y $$ i))\<twosuperior> < (e/sqrt (real (DIM('a))))\<twosuperior>"
+ by (rule power_strict_mono) auto
+ then show "(dist (x $$ i) (y $$ i))\<twosuperior> < e\<twosuperior> / real DIM('a)"
+ by (simp add: power_divide)
+ qed auto
+ also have "\<dots> = e" using `0 < e` by (simp add: real_eq_of_nat DIM_positive)
+ finally have "dist x y < e" . }
+ with a b show ?thesis
+ apply (rule_tac exI[of _ "Chi a"])
+ apply (rule_tac exI[of _ "Chi b"])
+ using eucl_less[where 'a='a] by auto
+qed
+
+lemma ex_rat_list:
+ fixes x :: "'a\<Colon>ordered_euclidean_space"
+ assumes "\<And> i. x $$ i \<in> \<rat>"
+ shows "\<exists> r. length r = DIM('a) \<and> (\<forall> i < DIM('a). of_rat (r ! i) = x $$ i)"
+proof -
+ have "\<forall>i. \<exists>r. x $$ i = of_rat r" using assms unfolding Rats_def by blast
+ from choice[OF this] guess r ..
+ then show ?thesis by (auto intro!: exI[of _ "map r [0 ..< DIM('a)]"])
+qed
+
+lemma open_UNION:
+ fixes M :: "'a\<Colon>ordered_euclidean_space set"
+ assumes "open M"
+ shows "M = UNION {(a, b) | a b. {Chi (of_rat \<circ> op ! a) <..< Chi (of_rat \<circ> op ! b)} \<subseteq> M}
+ (\<lambda> (a, b). {Chi (of_rat \<circ> op ! a) <..< Chi (of_rat \<circ> op ! b)})"
+ (is "M = UNION ?idx ?box")
+proof safe
+ fix x assume "x \<in> M"
+ obtain e where e: "e > 0" "ball x e \<subseteq> M"
+ using openE[OF assms `x \<in> M`] by auto
+ then obtain a b where ab: "x \<in> {a <..< b}" "\<And>i. a $$ i \<in> \<rat>" "\<And>i. b $$ i \<in> \<rat>" "{a <..< b} \<subseteq> ball x e"
+ using rational_boxes[OF e(1)] by blast
+ then obtain p q where pq: "length p = DIM ('a)"
+ "length q = DIM ('a)"
+ "\<forall> i < DIM ('a). of_rat (p ! i) = a $$ i \<and> of_rat (q ! i) = b $$ i"
+ using ex_rat_list[OF ab(2)] ex_rat_list[OF ab(3)] by blast
+ hence p: "Chi (of_rat \<circ> op ! p) = a"
+ using euclidean_eq[of "Chi (of_rat \<circ> op ! p)" a]
+ unfolding o_def by auto
+ from pq have q: "Chi (of_rat \<circ> op ! q) = b"
+ using euclidean_eq[of "Chi (of_rat \<circ> op ! q)" b]
+ unfolding o_def by auto
+ have "x \<in> ?box (p, q)"
+ using p q ab by auto
+ thus "x \<in> UNION ?idx ?box" using ab e p q exI[of _ p] exI[of _ q] by auto
+qed auto
+
+lemma halfspace_span_open:
+ "sigma_sets UNIV (range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a}))
+ \<subseteq> sets borel"
+ by (auto intro!: borel.sigma_sets_subset[simplified] borel_open
+ open_halfspace_component_lt)
+
+lemma halfspace_lt_in_halfspace:
+ "{x\<Colon>'a. x $$ i < a} \<in> sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a})\<rparr>)"
+ by (auto intro!: sigma_sets.Basic simp: sets_sigma)
+
+lemma halfspace_gt_in_halfspace:
+ "{x\<Colon>'a. a < x $$ i} \<in> sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a})\<rparr>)"
+ (is "?set \<in> sets ?SIGMA")
+proof -
+ interpret sigma_algebra "?SIGMA"
+ by (intro sigma_algebra_sigma_sets) (simp_all add: sets_sigma)
+ have *: "?set = (\<Union>n. space ?SIGMA - {x\<Colon>'a. x $$ i < a + 1 / real (Suc n)})"
+ proof (safe, simp_all add: not_less)
+ fix x assume "a < x $$ i"
+ with reals_Archimedean[of "x $$ i - a"]
+ obtain n where "a + 1 / real (Suc n) < x $$ i"
+ by (auto simp: inverse_eq_divide field_simps)
+ then show "\<exists>n. a + 1 / real (Suc n) \<le> x $$ i"
+ by (blast intro: less_imp_le)
+ next
+ fix x n
+ have "a < a + 1 / real (Suc n)" by auto
+ also assume "\<dots> \<le> x"
+ finally show "a < x" .
+ qed
+ show "?set \<in> sets ?SIGMA" unfolding *
+ by (safe intro!: countable_UN Diff halfspace_lt_in_halfspace)
+qed
+
+lemma open_span_halfspace:
+ "sets borel \<subseteq> sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. x $$ i < a})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) simp
+ then interpret sigma_algebra ?SIGMA .
+ { fix S :: "'a set" assume "S \<in> open" then have "open S" unfolding mem_def .
+ from open_UNION[OF this]
+ obtain I where *: "S =
+ (\<Union>(a, b)\<in>I.
+ (\<Inter> i<DIM('a). {x. (Chi (real_of_rat \<circ> op ! a)::'a) $$ i < x $$ i}) \<inter>
+ (\<Inter> i<DIM('a). {x. x $$ i < (Chi (real_of_rat \<circ> op ! b)::'a) $$ i}))"
+ unfolding greaterThanLessThan_def
+ unfolding eucl_greaterThan_eq_halfspaces[where 'a='a]
+ unfolding eucl_lessThan_eq_halfspaces[where 'a='a]
+ by blast
+ have "S \<in> sets ?SIGMA"
+ unfolding *
+ by (auto intro!: countable_UN Int countable_INT halfspace_lt_in_halfspace halfspace_gt_in_halfspace) }
+ then show ?thesis unfolding borel_def
+ by (intro sets_sigma_subset) auto
+qed
+
+lemma halfspace_span_halfspace_le:
+ "sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a})\<rparr>) \<subseteq>
+ sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x. x $$ i \<le> a})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ { fix a i
+ have *: "{x::'a. x$$i < a} = (\<Union>n. {x. x$$i \<le> a - 1/real (Suc n)})"
+ proof (safe, simp_all)
+ fix x::'a assume *: "x$$i < a"
+ with reals_Archimedean[of "a - x$$i"]
+ obtain n where "x $$ i < a - 1 / (real (Suc n))"
+ by (auto simp: field_simps inverse_eq_divide)
+ then show "\<exists>n. x $$ i \<le> a - 1 / (real (Suc n))"
+ by (blast intro: less_imp_le)
+ next
+ fix x::'a and n
+ assume "x$$i \<le> a - 1 / real (Suc n)"
+ also have "\<dots> < a" by auto
+ finally show "x$$i < a" .
+ qed
+ have "{x. x$$i < a} \<in> sets ?SIGMA" unfolding *
+ by (safe intro!: countable_UN)
+ (auto simp: sets_sigma intro!: sigma_sets.Basic) }
+ then show ?thesis by (intro sets_sigma_subset) auto
+qed
+
+lemma halfspace_span_halfspace_ge:
+ "sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i < a})\<rparr>) \<subseteq>
+ sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x. a \<le> x $$ i})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ { fix a i have *: "{x::'a. x$$i < a} = space ?SIGMA - {x::'a. a \<le> x$$i}" by auto
+ have "{x. x$$i < a} \<in> sets ?SIGMA" unfolding *
+ by (safe intro!: Diff)
+ (auto simp: sets_sigma intro!: sigma_sets.Basic) }
+ then show ?thesis by (intro sets_sigma_subset) auto
+qed
+
+lemma halfspace_le_span_halfspace_gt:
+ "sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i \<le> a})\<rparr>) \<subseteq>
+ sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x. a < x $$ i})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ { fix a i have *: "{x::'a. x$$i \<le> a} = space ?SIGMA - {x::'a. a < x$$i}" by auto
+ have "{x. x$$i \<le> a} \<in> sets ?SIGMA" unfolding *
+ by (safe intro!: Diff)
+ (auto simp: sets_sigma intro!: sigma_sets.Basic) }
+ then show ?thesis by (intro sets_sigma_subset) auto
+qed
+
+lemma halfspace_le_span_atMost:
+ "sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i \<le> a})\<rparr>) \<subseteq>
+ sets (sigma \<lparr>space=UNIV, sets=range (\<lambda>a. {..a\<Colon>'a\<Colon>ordered_euclidean_space})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ have "\<And>a i. {x. x$$i \<le> a} \<in> sets ?SIGMA"
+ proof cases
+ fix a i assume "i < DIM('a)"
+ then have *: "{x::'a. x$$i \<le> a} = (\<Union>k::nat. {.. (\<chi>\<chi> n. if n = i then a else real k)})"
+ proof (safe, simp_all add: eucl_le[where 'a='a] split: split_if_asm)
+ fix x
+ from real_arch_simple[of "Max ((\<lambda>i. x$$i)`{..<DIM('a)})"] guess k::nat ..
+ then have "\<And>i. i < DIM('a) \<Longrightarrow> x$$i \<le> real k"
+ by (subst (asm) Max_le_iff) auto
+ then show "\<exists>k::nat. \<forall>ia. ia \<noteq> i \<longrightarrow> ia < DIM('a) \<longrightarrow> x $$ ia \<le> real k"
+ by (auto intro!: exI[of _ k])
+ qed
+ show "{x. x$$i \<le> a} \<in> sets ?SIGMA" unfolding *
+ by (safe intro!: countable_UN)
+ (auto simp: sets_sigma intro!: sigma_sets.Basic)
+ next
+ fix a i assume "\<not> i < DIM('a)"
+ then show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
+ using top by auto
+ qed
+ then show ?thesis by (intro sets_sigma_subset) auto
+qed
+
+lemma halfspace_le_span_greaterThan:
+ "sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. x $$ i \<le> a})\<rparr>) \<subseteq>
+ sets (sigma \<lparr>space=UNIV, sets=range (\<lambda>a. {a<..})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ have "\<And>a i. {x. x$$i \<le> a} \<in> sets ?SIGMA"
+ proof cases
+ fix a i assume "i < DIM('a)"
+ have "{x::'a. x$$i \<le> a} = space ?SIGMA - {x::'a. a < x$$i}" by auto
+ also have *: "{x::'a. a < x$$i} = (\<Union>k::nat. {(\<chi>\<chi> n. if n = i then a else -real k) <..})" using `i <DIM('a)`
+ proof (safe, simp_all add: eucl_less[where 'a='a] split: split_if_asm)
+ fix x
+ from real_arch_lt[of "Max ((\<lambda>i. -x$$i)`{..<DIM('a)})"]
+ guess k::nat .. note k = this
+ { fix i assume "i < DIM('a)"
+ then have "-x$$i < real k"
+ using k by (subst (asm) Max_less_iff) auto
+ then have "- real k < x$$i" by simp }
+ then show "\<exists>k::nat. \<forall>ia. ia \<noteq> i \<longrightarrow> ia < DIM('a) \<longrightarrow> -real k < x $$ ia"
+ by (auto intro!: exI[of _ k])
+ qed
+ finally show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
+ apply (simp only:)
+ apply (safe intro!: countable_UN Diff)
+ by (auto simp: sets_sigma intro!: sigma_sets.Basic)
+ next
+ fix a i assume "\<not> i < DIM('a)"
+ then show "{x. x$$i \<le> a} \<in> sets ?SIGMA"
+ using top by auto
+ qed
+ then show ?thesis by (intro sets_sigma_subset) auto
+qed
+
+lemma halfspace_le_span_lessThan:
+ "sets (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x\<Colon>'a\<Colon>ordered_euclidean_space. a \<le> x $$ i})\<rparr>) \<subseteq>
+ sets (sigma \<lparr>space=UNIV, sets=range (\<lambda>a. {..<a})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ have "\<And>a i. {x. a \<le> x$$i} \<in> sets ?SIGMA"
+ proof cases
+ fix a i assume "i < DIM('a)"
+ have "{x::'a. a \<le> x$$i} = space ?SIGMA - {x::'a. x$$i < a}" by auto
+ also have *: "{x::'a. x$$i < a} = (\<Union>k::nat. {..< (\<chi>\<chi> n. if n = i then a else real k)})" using `i <DIM('a)`
+ proof (safe, simp_all add: eucl_less[where 'a='a] split: split_if_asm)
+ fix x
+ from real_arch_lt[of "Max ((\<lambda>i. x$$i)`{..<DIM('a)})"]
+ guess k::nat .. note k = this
+ { fix i assume "i < DIM('a)"
+ then have "x$$i < real k"
+ using k by (subst (asm) Max_less_iff) auto
+ then have "x$$i < real k" by simp }
+ then show "\<exists>k::nat. \<forall>ia. ia \<noteq> i \<longrightarrow> ia < DIM('a) \<longrightarrow> x $$ ia < real k"
+ by (auto intro!: exI[of _ k])
+ qed
+ finally show "{x. a \<le> x$$i} \<in> sets ?SIGMA"
+ apply (simp only:)
+ apply (safe intro!: countable_UN Diff)
+ by (auto simp: sets_sigma intro!: sigma_sets.Basic)
+ next
+ fix a i assume "\<not> i < DIM('a)"
+ then show "{x. a \<le> x$$i} \<in> sets ?SIGMA"
+ using top by auto
+ qed
+ then show ?thesis by (intro sets_sigma_subset) auto
+qed
+
+lemma atMost_span_atLeastAtMost:
+ "sets (sigma \<lparr>space=UNIV, sets=range (\<lambda>a. {..a\<Colon>'a\<Colon>ordered_euclidean_space})\<rparr>) \<subseteq>
+ sets (sigma \<lparr>space=UNIV, sets=range (\<lambda>(a,b). {a..b})\<rparr>)"
+ (is "_ \<subseteq> sets ?SIGMA")
+proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ { fix a::'a
+ have *: "{..a} = (\<Union>n::nat. {- real n *\<^sub>R One .. a})"
+ proof (safe, simp_all add: eucl_le[where 'a='a])
+ fix x
+ from real_arch_simple[of "Max ((\<lambda>i. - x$$i)`{..<DIM('a)})"]
+ guess k::nat .. note k = this
+ { fix i assume "i < DIM('a)"
+ with k have "- x$$i \<le> real k"
+ by (subst (asm) Max_le_iff) (auto simp: field_simps)
+ then have "- real k \<le> x$$i" by simp }
+ then show "\<exists>n::nat. \<forall>i<DIM('a). - real n \<le> x $$ i"
+ by (auto intro!: exI[of _ k])
+ qed
+ have "{..a} \<in> sets ?SIGMA" unfolding *
+ by (safe intro!: countable_UN)
+ (auto simp: sets_sigma intro!: sigma_sets.Basic) }
+ then show ?thesis by (intro sets_sigma_subset) auto
+qed
+
+lemma borel_eq_atMost:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> a. {.. a::'a\<Colon>ordered_euclidean_space})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using halfspace_le_span_atMost halfspace_span_halfspace_le open_span_halfspace
+ by auto
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma borel_eq_atLeastAtMost:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a :: 'a\<Colon>ordered_euclidean_space, b). {a .. b})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using atMost_span_atLeastAtMost halfspace_le_span_atMost
+ halfspace_span_halfspace_le open_span_halfspace
+ by auto
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma borel_eq_greaterThan:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a :: 'a\<Colon>ordered_euclidean_space). {a <..})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using halfspace_le_span_greaterThan
+ halfspace_span_halfspace_le open_span_halfspace
+ by auto
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma borel_eq_lessThan:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a :: 'a\<Colon>ordered_euclidean_space). {..< a})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using halfspace_le_span_lessThan
+ halfspace_span_halfspace_ge open_span_halfspace
+ by auto
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma borel_eq_greaterThanLessThan:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, b). {a <..< (b :: 'a \<Colon> ordered_euclidean_space)})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+ show "sets borel \<subseteq> sets ?SIGMA"
+ proof -
+ have "sigma_algebra ?SIGMA" by (rule sigma_algebra_sigma) auto
+ then interpret sigma_algebra ?SIGMA .
+ { fix M :: "'a set" assume "M \<in> open"
+ then have "open M" by (simp add: mem_def)
+ have "M \<in> sets ?SIGMA"
+ apply (subst open_UNION[OF `open M`])
+ apply (safe intro!: countable_UN)
+ by (auto simp add: sigma_def intro!: sigma_sets.Basic) }
+ then show ?thesis
+ unfolding borel_def by (intro sets_sigma_subset) auto
+ qed
+qed auto
+
+lemma borel_eq_halfspace_le:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. x$$i \<le> a})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using open_span_halfspace halfspace_span_halfspace_le by auto
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma borel_eq_halfspace_less:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. x$$i < a})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using open_span_halfspace .
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma borel_eq_halfspace_gt:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. a < x$$i})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using halfspace_le_span_halfspace_gt open_span_halfspace halfspace_span_halfspace_le by auto
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma borel_eq_halfspace_ge:
+ "borel = (sigma \<lparr>space=UNIV, sets=range (\<lambda> (a, i). {x::'a::ordered_euclidean_space. a \<le> x$$i})\<rparr>)"
+ (is "_ = ?SIGMA")
+proof (intro algebra.equality antisym)
+ show "sets borel \<subseteq> sets ?SIGMA"
+ using halfspace_span_halfspace_ge open_span_halfspace by auto
+ show "sets ?SIGMA \<subseteq> sets borel"
+ by (rule borel.sets_sigma_subset) auto
+qed auto
+
+lemma (in sigma_algebra) borel_measurable_halfspacesI:
+ fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
+ assumes "borel = (sigma \<lparr>space=UNIV, sets=range F\<rparr>)"
+ and "\<And>a i. S a i = f -` F (a,i) \<inter> space M"
+ and "\<And>a i. \<not> i < DIM('c) \<Longrightarrow> S a i \<in> sets M"
+ shows "f \<in> borel_measurable M = (\<forall>i<DIM('c). \<forall>a::real. S a i \<in> sets M)"
+proof safe
+ fix a :: real and i assume i: "i < DIM('c)" and f: "f \<in> borel_measurable M"
+ then show "S a i \<in> sets M" unfolding assms
+ by (auto intro!: measurable_sets sigma_sets.Basic simp: assms(1) sigma_def)
+next
+ assume a: "\<forall>i<DIM('c). \<forall>a. S a i \<in> sets M"
+ { fix a i have "S a i \<in> sets M"
+ proof cases
+ assume "i < DIM('c)"
+ with a show ?thesis unfolding assms(2) by simp
+ next
+ assume "\<not> i < DIM('c)"
+ from assms(3)[OF this] show ?thesis .
+ qed }
+ then have "f \<in> measurable M (sigma \<lparr>space=UNIV, sets=range F\<rparr>)"
+ by (auto intro!: measurable_sigma simp: assms(2))
+ then show "f \<in> borel_measurable M" unfolding measurable_def
+ unfolding assms(1) by simp
+qed
+
+lemma (in sigma_algebra) borel_measurable_iff_halfspace_le:
+ fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
+ shows "f \<in> borel_measurable M = (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. f w $$ i \<le> a} \<in> sets M)"
+ by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_le]) auto
+
+lemma (in sigma_algebra) borel_measurable_iff_halfspace_less:
+ fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
+ shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. f w $$ i < a} \<in> sets M)"
+ by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_less]) auto
+
+lemma (in sigma_algebra) borel_measurable_iff_halfspace_ge:
+ fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
+ shows "f \<in> borel_measurable M = (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. a \<le> f w $$ i} \<in> sets M)"
+ by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_ge]) auto
+
+lemma (in sigma_algebra) borel_measurable_iff_halfspace_greater:
+ fixes f :: "'a \<Rightarrow> 'c\<Colon>ordered_euclidean_space"
+ shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i<DIM('c). \<forall>a. {w \<in> space M. a < f w $$ i} \<in> sets M)"
+ by (rule borel_measurable_halfspacesI[OF borel_eq_halfspace_gt]) auto
+
+lemma (in sigma_algebra) borel_measurable_iff_le:
+ "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w \<le> a} \<in> sets M)"
+ using borel_measurable_iff_halfspace_le[where 'c=real] by simp
+
+lemma (in sigma_algebra) borel_measurable_iff_less:
+ "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w < a} \<in> sets M)"
+ using borel_measurable_iff_halfspace_less[where 'c=real] by simp
+
+lemma (in sigma_algebra) borel_measurable_iff_ge:
+ "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a \<le> f w} \<in> sets M)"
+ using borel_measurable_iff_halfspace_ge[where 'c=real] by simp
+
+lemma (in sigma_algebra) borel_measurable_iff_greater:
+ "(f::'a \<Rightarrow> real) \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a < f w} \<in> sets M)"
+ using borel_measurable_iff_halfspace_greater[where 'c=real] by simp
+
+lemma borel_measureable_euclidean_component:
+ "(\<lambda>x::'a::euclidean_space. x $$ i) \<in> borel_measurable borel"
+ unfolding borel_def[where 'a=real]
+proof (rule borel.measurable_sigma, simp_all)
+ fix S::"real set" assume "S \<in> open" then have "open S" unfolding mem_def .
+ from open_vimage_euclidean_component[OF this]
+ show "(\<lambda>x. x $$ i) -` S \<in> sets borel"
+ by (auto intro: borel_open)
+qed
+
+lemma (in sigma_algebra) borel_measureable_euclidean_space:
+ fixes f :: "'a \<Rightarrow> 'c::ordered_euclidean_space"
+ shows "f \<in> borel_measurable M \<longleftrightarrow> (\<forall>i<DIM('c). (\<lambda>x. f x $$ i) \<in> borel_measurable M)"
+proof safe
+ fix i assume "f \<in> borel_measurable M"
+ then show "(\<lambda>x. f x $$ i) \<in> borel_measurable M"
+ using measurable_comp[of f _ _ "\<lambda>x. x $$ i", unfolded comp_def]
+ by (auto intro: borel_measureable_euclidean_component)
+next
+ assume f: "\<forall>i<DIM('c). (\<lambda>x. f x $$ i) \<in> borel_measurable M"
+ then show "f \<in> borel_measurable M"
+ unfolding borel_measurable_iff_halfspace_le by auto
+qed
+
+subsection "Borel measurable operators"
+
+lemma (in sigma_algebra) affine_borel_measurable_vector:
+ fixes f :: "'a \<Rightarrow> 'x::real_normed_vector"
+ assumes "f \<in> borel_measurable M"
+ shows "(\<lambda>x. a + b *\<^sub>R f x) \<in> borel_measurable M"
+proof (rule borel_measurableI)
+ fix S :: "'x set" assume "open S"
+ show "(\<lambda>x. a + b *\<^sub>R f x) -` S \<inter> space M \<in> sets M"
+ proof cases
+ assume "b \<noteq> 0"
+ with `open S` have "((\<lambda>x. (- a + x) /\<^sub>R b) ` S) \<in> open" (is "?S \<in> open")
+ by (auto intro!: open_affinity simp: scaleR.add_right mem_def)
+ hence "?S \<in> sets borel"
+ unfolding borel_def by (auto simp: sigma_def intro!: sigma_sets.Basic)
+ moreover
+ from `b \<noteq> 0` have "(\<lambda>x. a + b *\<^sub>R f x) -` S = f -` ?S"
+ apply auto by (rule_tac x="a + b *\<^sub>R f x" in image_eqI, simp_all)
+ ultimately show ?thesis using assms unfolding in_borel_measurable_borel
+ by auto
+ qed simp
+qed
+
+lemma (in sigma_algebra) affine_borel_measurable:
+ fixes g :: "'a \<Rightarrow> real"
+ assumes g: "g \<in> borel_measurable M"
+ shows "(\<lambda>x. a + (g x) * b) \<in> borel_measurable M"
+ using affine_borel_measurable_vector[OF assms] by (simp add: mult_commute)
+
+lemma (in sigma_algebra) borel_measurable_add[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "(\<lambda>x. f x + g x) \<in> borel_measurable M"
+proof -
+ have 1: "\<And>a. {w\<in>space M. a \<le> f w + g w} = {w \<in> space M. a + g w * -1 \<le> f w}"
+ by auto
+ have "\<And>a. (\<lambda>w. a + (g w) * -1) \<in> borel_measurable M"
+ by (rule affine_borel_measurable [OF g])
+ then have "\<And>a. {w \<in> space M. (\<lambda>w. a + (g w) * -1)(w) \<le> f w} \<in> sets M" using f
+ by auto
+ then have "\<And>a. {w \<in> space M. a \<le> f w + g w} \<in> sets M"
+ by (simp add: 1)
+ then show ?thesis
+ by (simp add: borel_measurable_iff_ge)
+qed
+
+lemma (in sigma_algebra) borel_measurable_square:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ shows "(\<lambda>x. (f x)^2) \<in> borel_measurable M"
+proof -
+ {
+ fix a
+ have "{w \<in> space M. (f w)\<twosuperior> \<le> a} \<in> sets M"
+ proof (cases rule: linorder_cases [of a 0])
+ case less
+ hence "{w \<in> space M. (f w)\<twosuperior> \<le> a} = {}"
+ by auto (metis less order_le_less_trans power2_less_0)
+ also have "... \<in> sets M"
+ by (rule empty_sets)
+ finally show ?thesis .
+ next
+ case equal
+ hence "{w \<in> space M. (f w)\<twosuperior> \<le> a} =
+ {w \<in> space M. f w \<le> 0} \<inter> {w \<in> space M. 0 \<le> f w}"
+ by auto
+ also have "... \<in> sets M"
+ apply (insert f)
+ apply (rule Int)
+ apply (simp add: borel_measurable_iff_le)
+ apply (simp add: borel_measurable_iff_ge)
+ done
+ finally show ?thesis .
+ next
+ case greater
+ have "\<forall>x. (f x ^ 2 \<le> sqrt a ^ 2) = (- sqrt a \<le> f x & f x \<le> sqrt a)"
+ by (metis abs_le_interval_iff abs_of_pos greater real_sqrt_abs
+ real_sqrt_le_iff real_sqrt_power)
+ hence "{w \<in> space M. (f w)\<twosuperior> \<le> a} =
+ {w \<in> space M. -(sqrt a) \<le> f w} \<inter> {w \<in> space M. f w \<le> sqrt a}"
+ using greater by auto
+ also have "... \<in> sets M"
+ apply (insert f)
+ apply (rule Int)
+ apply (simp add: borel_measurable_iff_ge)
+ apply (simp add: borel_measurable_iff_le)
+ done
+ finally show ?thesis .
+ qed
+ }
+ thus ?thesis by (auto simp add: borel_measurable_iff_le)
+qed
+
+lemma times_eq_sum_squares:
+ fixes x::real
+ shows"x*y = ((x+y)^2)/4 - ((x-y)^ 2)/4"
+by (simp add: power2_eq_square ring_distribs diff_divide_distrib [symmetric])
+
+lemma (in sigma_algebra) borel_measurable_uminus[simp, intro]:
+ fixes g :: "'a \<Rightarrow> real"
+ assumes g: "g \<in> borel_measurable M"
+ shows "(\<lambda>x. - g x) \<in> borel_measurable M"
+proof -
+ have "(\<lambda>x. - g x) = (\<lambda>x. 0 + (g x) * -1)"
+ by simp
+ also have "... \<in> borel_measurable M"
+ by (fast intro: affine_borel_measurable g)
+ finally show ?thesis .
+qed
+
+lemma (in sigma_algebra) borel_measurable_times[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "(\<lambda>x. f x * g x) \<in> borel_measurable M"
+proof -
+ have 1: "(\<lambda>x. 0 + (f x + g x)\<twosuperior> * inverse 4) \<in> borel_measurable M"
+ using assms by (fast intro: affine_borel_measurable borel_measurable_square)
+ have "(\<lambda>x. -((f x + -g x) ^ 2 * inverse 4)) =
+ (\<lambda>x. 0 + ((f x + -g x) ^ 2 * inverse -4))"
+ by (simp add: minus_divide_right)
+ also have "... \<in> borel_measurable M"
+ using f g by (fast intro: affine_borel_measurable borel_measurable_square f g)
+ finally have 2: "(\<lambda>x. -((f x + -g x) ^ 2 * inverse 4)) \<in> borel_measurable M" .
+ show ?thesis
+ apply (simp add: times_eq_sum_squares diff_minus)
+ using 1 2 by simp
+qed
+
+lemma (in sigma_algebra) borel_measurable_diff[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "(\<lambda>x. f x - g x) \<in> borel_measurable M"
+ unfolding diff_minus using assms by fast
+
+lemma (in sigma_algebra) borel_measurable_setsum[simp, intro]:
+ fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> real"
+ assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
+ shows "(\<lambda>x. \<Sum>i\<in>S. f i x) \<in> borel_measurable M"
+proof cases
+ assume "finite S"
+ thus ?thesis using assms by induct auto
+qed simp
+
+lemma (in sigma_algebra) borel_measurable_inverse[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes "f \<in> borel_measurable M"
+ shows "(\<lambda>x. inverse (f x)) \<in> borel_measurable M"
+ unfolding borel_measurable_iff_ge unfolding inverse_eq_divide
+proof safe
+ fix a :: real
+ have *: "{w \<in> space M. a \<le> 1 / f w} =
+ ({w \<in> space M. 0 < f w} \<inter> {w \<in> space M. a * f w \<le> 1}) \<union>
+ ({w \<in> space M. f w < 0} \<inter> {w \<in> space M. 1 \<le> a * f w}) \<union>
+ ({w \<in> space M. f w = 0} \<inter> {w \<in> space M. a \<le> 0})" by (auto simp: le_divide_eq)
+ show "{w \<in> space M. a \<le> 1 / f w} \<in> sets M" using assms unfolding *
+ by (auto intro!: Int Un)
+qed
+
+lemma (in sigma_algebra) borel_measurable_divide[simp, intro]:
+ fixes f :: "'a \<Rightarrow> real"
+ assumes "f \<in> borel_measurable M"
+ and "g \<in> borel_measurable M"
+ shows "(\<lambda>x. f x / g x) \<in> borel_measurable M"
+ unfolding field_divide_inverse
+ by (rule borel_measurable_inverse borel_measurable_times assms)+
+
+lemma (in sigma_algebra) borel_measurable_max[intro, simp]:
+ fixes f g :: "'a \<Rightarrow> real"
+ assumes "f \<in> borel_measurable M"
+ assumes "g \<in> borel_measurable M"
+ shows "(\<lambda>x. max (g x) (f x)) \<in> borel_measurable M"
+ unfolding borel_measurable_iff_le
+proof safe
+ fix a
+ have "{x \<in> space M. max (g x) (f x) \<le> a} =
+ {x \<in> space M. g x \<le> a} \<inter> {x \<in> space M. f x \<le> a}" by auto
+ thus "{x \<in> space M. max (g x) (f x) \<le> a} \<in> sets M"
+ using assms unfolding borel_measurable_iff_le
+ by (auto intro!: Int)
+qed
+
+lemma (in sigma_algebra) borel_measurable_min[intro, simp]:
+ fixes f g :: "'a \<Rightarrow> real"
+ assumes "f \<in> borel_measurable M"
+ assumes "g \<in> borel_measurable M"
+ shows "(\<lambda>x. min (g x) (f x)) \<in> borel_measurable M"
+ unfolding borel_measurable_iff_ge
+proof safe
+ fix a
+ have "{x \<in> space M. a \<le> min (g x) (f x)} =
+ {x \<in> space M. a \<le> g x} \<inter> {x \<in> space M. a \<le> f x}" by auto
+ thus "{x \<in> space M. a \<le> min (g x) (f x)} \<in> sets M"
+ using assms unfolding borel_measurable_iff_ge
+ by (auto intro!: Int)
+qed
+
+lemma (in sigma_algebra) borel_measurable_abs[simp, intro]:
+ assumes "f \<in> borel_measurable M"
+ shows "(\<lambda>x. \<bar>f x :: real\<bar>) \<in> borel_measurable M"
+proof -
+ have *: "\<And>x. \<bar>f x\<bar> = max 0 (f x) + max 0 (- f x)" by (simp add: max_def)
+ show ?thesis unfolding * using assms by auto
+qed
+
+section "Borel space over the real line with infinity"
+
+lemma borel_Real_measurable:
+ "A \<in> sets borel \<Longrightarrow> Real -` A \<in> sets borel"
+proof (rule borel_measurable_translate)
+ fix B :: "pinfreal set" assume "open B"
+ then obtain T x where T: "open T" "Real ` (T \<inter> {0..}) = B - {\<omega>}" and
+ x: "\<omega> \<in> B \<Longrightarrow> 0 \<le> x" "\<omega> \<in> B \<Longrightarrow> {Real x <..} \<subseteq> B"
+ unfolding open_pinfreal_def by blast
+ have "Real -` B = Real -` (B - {\<omega>})" by auto
+ also have "\<dots> = Real -` (Real ` (T \<inter> {0..}))" using T by simp
+ also have "\<dots> = (if 0 \<in> T then T \<union> {.. 0} else T \<inter> {0..})"
+ apply (auto simp add: Real_eq_Real image_iff)
+ apply (rule_tac x="max 0 x" in bexI)
+ by (auto simp: max_def)
+ finally show "Real -` B \<in> sets borel"
+ using `open T` by auto
+qed simp
+
+lemma borel_real_measurable:
+ "A \<in> sets borel \<Longrightarrow> (real -` A :: pinfreal set) \<in> sets borel"
+proof (rule borel_measurable_translate)
+ fix B :: "real set" assume "open B"
+ { fix x have "0 < real x \<longleftrightarrow> (\<exists>r>0. x = Real r)" by (cases x) auto }
+ note Ex_less_real = this
+ have *: "real -` B = (if 0 \<in> B then real -` (B \<inter> {0 <..}) \<union> {0, \<omega>} else real -` (B \<inter> {0 <..}))"
+ by (force simp: Ex_less_real)
+
+ have "open (real -` (B \<inter> {0 <..}) :: pinfreal set)"
+ unfolding open_pinfreal_def using `open B`
+ by (auto intro!: open_Int exI[of _ "B \<inter> {0 <..}"] simp: image_iff Ex_less_real)
+ then show "(real -` B :: pinfreal set) \<in> sets borel" unfolding * by auto
+qed simp
+
+lemma (in sigma_algebra) borel_measurable_Real[intro, simp]:
+ assumes "f \<in> borel_measurable M"
+ shows "(\<lambda>x. Real (f x)) \<in> borel_measurable M"
+ unfolding in_borel_measurable_borel
+proof safe
+ fix S :: "pinfreal set" assume "S \<in> sets borel"
+ from borel_Real_measurable[OF this]
+ have "(Real \<circ> f) -` S \<inter> space M \<in> sets M"
+ using assms
+ unfolding vimage_compose in_borel_measurable_borel
+ by auto
+ thus "(\<lambda>x. Real (f x)) -` S \<inter> space M \<in> sets M" by (simp add: comp_def)
+qed
+
+lemma (in sigma_algebra) borel_measurable_real[intro, simp]:
+ fixes f :: "'a \<Rightarrow> pinfreal"
+ assumes "f \<in> borel_measurable M"
+ shows "(\<lambda>x. real (f x)) \<in> borel_measurable M"
+ unfolding in_borel_measurable_borel
+proof safe
+ fix S :: "real set" assume "S \<in> sets borel"
+ from borel_real_measurable[OF this]
+ have "(real \<circ> f) -` S \<inter> space M \<in> sets M"
+ using assms
+ unfolding vimage_compose in_borel_measurable_borel
+ by auto
+ thus "(\<lambda>x. real (f x)) -` S \<inter> space M \<in> sets M" by (simp add: comp_def)
+qed
+
+lemma (in sigma_algebra) borel_measurable_Real_eq:
+ assumes "\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> f x"
+ shows "(\<lambda>x. Real (f x)) \<in> borel_measurable M \<longleftrightarrow> f \<in> borel_measurable M"
+proof
+ have [simp]: "(\<lambda>x. Real (f x)) -` {\<omega>} \<inter> space M = {}"
+ by auto
+ assume "(\<lambda>x. Real (f x)) \<in> borel_measurable M"
+ hence "(\<lambda>x. real (Real (f x))) \<in> borel_measurable M"
+ by (rule borel_measurable_real)
+ moreover have "\<And>x. x \<in> space M \<Longrightarrow> real (Real (f x)) = f x"
+ using assms by auto
+ ultimately show "f \<in> borel_measurable M"
+ by (simp cong: measurable_cong)
+qed auto
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_eq_real:
+ "f \<in> borel_measurable M \<longleftrightarrow>
+ ((\<lambda>x. real (f x)) \<in> borel_measurable M \<and> f -` {\<omega>} \<inter> space M \<in> sets M)"
+proof safe
+ assume "f \<in> borel_measurable M"
+ then show "(\<lambda>x. real (f x)) \<in> borel_measurable M" "f -` {\<omega>} \<inter> space M \<in> sets M"
+ by (auto intro: borel_measurable_vimage borel_measurable_real)
+next
+ assume *: "(\<lambda>x. real (f x)) \<in> borel_measurable M" "f -` {\<omega>} \<inter> space M \<in> sets M"
+ have "f -` {\<omega>} \<inter> space M = {x\<in>space M. f x = \<omega>}" by auto
+ with * have **: "{x\<in>space M. f x = \<omega>} \<in> sets M" by simp
+ have f: "f = (\<lambda>x. if f x = \<omega> then \<omega> else Real (real (f x)))"
+ by (simp add: fun_eq_iff Real_real)
+ show "f \<in> borel_measurable M"
+ apply (subst f)
+ apply (rule measurable_If)
+ using * ** by auto
+qed
+
+lemma (in sigma_algebra) less_eq_ge_measurable:
+ fixes f :: "'a \<Rightarrow> 'c::linorder"
+ shows "{x\<in>space M. a < f x} \<in> sets M \<longleftrightarrow> {x\<in>space M. f x \<le> a} \<in> sets M"
+proof
+ assume "{x\<in>space M. f x \<le> a} \<in> sets M"
+ moreover have "{x\<in>space M. a < f x} = space M - {x\<in>space M. f x \<le> a}" by auto
+ ultimately show "{x\<in>space M. a < f x} \<in> sets M" by auto
+next
+ assume "{x\<in>space M. a < f x} \<in> sets M"
+ moreover have "{x\<in>space M. f x \<le> a} = space M - {x\<in>space M. a < f x}" by auto
+ ultimately show "{x\<in>space M. f x \<le> a} \<in> sets M" by auto
+qed
+
+lemma (in sigma_algebra) greater_eq_le_measurable:
+ fixes f :: "'a \<Rightarrow> 'c::linorder"
+ shows "{x\<in>space M. f x < a} \<in> sets M \<longleftrightarrow> {x\<in>space M. a \<le> f x} \<in> sets M"
+proof
+ assume "{x\<in>space M. a \<le> f x} \<in> sets M"
+ moreover have "{x\<in>space M. f x < a} = space M - {x\<in>space M. a \<le> f x}" by auto
+ ultimately show "{x\<in>space M. f x < a} \<in> sets M" by auto
+next
+ assume "{x\<in>space M. f x < a} \<in> sets M"
+ moreover have "{x\<in>space M. a \<le> f x} = space M - {x\<in>space M. f x < a}" by auto
+ ultimately show "{x\<in>space M. a \<le> f x} \<in> sets M" by auto
+qed
+
+lemma (in sigma_algebra) less_eq_le_pinfreal_measurable:
+ fixes f :: "'a \<Rightarrow> pinfreal"
+ shows "(\<forall>a. {x\<in>space M. a < f x} \<in> sets M) \<longleftrightarrow> (\<forall>a. {x\<in>space M. a \<le> f x} \<in> sets M)"
+proof
+ assume a: "\<forall>a. {x\<in>space M. a \<le> f x} \<in> sets M"
+ show "\<forall>a. {x \<in> space M. a < f x} \<in> sets M"
+ proof
+ fix a show "{x \<in> space M. a < f x} \<in> sets M"
+ proof (cases a)
+ case (preal r)
+ have "{x\<in>space M. a < f x} = (\<Union>i. {x\<in>space M. a + inverse (of_nat (Suc i)) \<le> f x})"
+ proof safe
+ fix x assume "a < f x" and [simp]: "x \<in> space M"
+ with ex_pinfreal_inverse_of_nat_Suc_less[of "f x - a"]
+ obtain n where "a + inverse (of_nat (Suc n)) < f x"
+ by (cases "f x", auto simp: pinfreal_minus_order)
+ then have "a + inverse (of_nat (Suc n)) \<le> f x" by simp
+ then show "x \<in> (\<Union>i. {x \<in> space M. a + inverse (of_nat (Suc i)) \<le> f x})"
+ by auto
+ next
+ fix i x assume [simp]: "x \<in> space M"
+ have "a < a + inverse (of_nat (Suc i))" using preal by auto
+ also assume "a + inverse (of_nat (Suc i)) \<le> f x"
+ finally show "a < f x" .
+ qed
+ with a show ?thesis by auto
+ qed simp
+ qed
+next
+ assume a': "\<forall>a. {x \<in> space M. a < f x} \<in> sets M"
+ then have a: "\<forall>a. {x \<in> space M. f x \<le> a} \<in> sets M" unfolding less_eq_ge_measurable .
+ show "\<forall>a. {x \<in> space M. a \<le> f x} \<in> sets M" unfolding greater_eq_le_measurable[symmetric]
+ proof
+ fix a show "{x \<in> space M. f x < a} \<in> sets M"
+ proof (cases a)
+ case (preal r)
+ show ?thesis
+ proof cases
+ assume "a = 0" then show ?thesis by simp
+ next
+ assume "a \<noteq> 0"
+ have "{x\<in>space M. f x < a} = (\<Union>i. {x\<in>space M. f x \<le> a - inverse (of_nat (Suc i))})"
+ proof safe
+ fix x assume "f x < a" and [simp]: "x \<in> space M"
+ with ex_pinfreal_inverse_of_nat_Suc_less[of "a - f x"]
+ obtain n where "inverse (of_nat (Suc n)) < a - f x"
+ using preal by (cases "f x") auto
+ then have "f x \<le> a - inverse (of_nat (Suc n)) "
+ using preal by (cases "f x") (auto split: split_if_asm)
+ then show "x \<in> (\<Union>i. {x \<in> space M. f x \<le> a - inverse (of_nat (Suc i))})"
+ by auto
+ next
+ fix i x assume [simp]: "x \<in> space M"
+ assume "f x \<le> a - inverse (of_nat (Suc i))"
+ also have "\<dots> < a" using `a \<noteq> 0` preal by auto
+ finally show "f x < a" .
+ qed
+ with a show ?thesis by auto
+ qed
+ next
+ case infinite
+ have "f -` {\<omega>} \<inter> space M = (\<Inter>n. {x\<in>space M. of_nat n < f x})"
+ proof (safe, simp_all, safe)
+ fix x assume *: "\<forall>n::nat. Real (real n) < f x"
+ show "f x = \<omega>" proof (rule ccontr)
+ assume "f x \<noteq> \<omega>"
+ with real_arch_lt[of "real (f x)"] obtain n where "f x < of_nat n"
+ by (auto simp: pinfreal_noteq_omega_Ex)
+ with *[THEN spec, of n] show False by auto
+ qed
+ qed
+ with a' have \<omega>: "f -` {\<omega>} \<inter> space M \<in> sets M" by auto
+ moreover have "{x \<in> space M. f x < a} = space M - f -` {\<omega>} \<inter> space M"
+ using infinite by auto
+ ultimately show ?thesis by auto
+ qed
+ qed
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_iff_greater:
+ "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. a < f x} \<in> sets M)"
+proof safe
+ fix a assume f: "f \<in> borel_measurable M"
+ have "{x\<in>space M. a < f x} = f -` {a <..} \<inter> space M" by auto
+ with f show "{x\<in>space M. a < f x} \<in> sets M"
+ by (auto intro!: measurable_sets)
+next
+ assume *: "\<forall>a. {x\<in>space M. a < f x} \<in> sets M"
+ hence **: "\<forall>a. {x\<in>space M. f x < a} \<in> sets M"
+ unfolding less_eq_le_pinfreal_measurable
+ unfolding greater_eq_le_measurable .
+ show "f \<in> borel_measurable M" unfolding borel_measurable_pinfreal_eq_real borel_measurable_iff_greater
+ proof safe
+ have "f -` {\<omega>} \<inter> space M = space M - {x\<in>space M. f x < \<omega>}" by auto
+ then show \<omega>: "f -` {\<omega>} \<inter> space M \<in> sets M" using ** by auto
+ fix a
+ have "{w \<in> space M. a < real (f w)} =
+ (if 0 \<le> a then {w\<in>space M. Real a < f w} - (f -` {\<omega>} \<inter> space M) else space M)"
+ proof (split split_if, safe del: notI)
+ fix x assume "0 \<le> a"
+ { assume "a < real (f x)" then show "Real a < f x" "x \<notin> f -` {\<omega>} \<inter> space M"
+ using `0 \<le> a` by (cases "f x", auto) }
+ { assume "Real a < f x" "x \<notin> f -` {\<omega>}" then show "a < real (f x)"
+ using `0 \<le> a` by (cases "f x", auto) }
+ next
+ fix x assume "\<not> 0 \<le> a" then show "a < real (f x)" by (cases "f x") auto
+ qed
+ then show "{w \<in> space M. a < real (f w)} \<in> sets M"
+ using \<omega> * by (auto intro!: Diff)
+ qed
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_iff_less:
+ "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. f x < a} \<in> sets M)"
+ using borel_measurable_pinfreal_iff_greater unfolding less_eq_le_pinfreal_measurable greater_eq_le_measurable .
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_iff_le:
+ "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. f x \<le> a} \<in> sets M)"
+ using borel_measurable_pinfreal_iff_greater unfolding less_eq_ge_measurable .
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_iff_ge:
+ "(f::'a \<Rightarrow> pinfreal) \<in> borel_measurable M \<longleftrightarrow> (\<forall>a. {x\<in>space M. a \<le> f x} \<in> sets M)"
+ using borel_measurable_pinfreal_iff_greater unfolding less_eq_le_pinfreal_measurable .
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_eq_const:
+ fixes f :: "'a \<Rightarrow> pinfreal" assumes "f \<in> borel_measurable M"
+ shows "{x\<in>space M. f x = c} \<in> sets M"
+proof -
+ have "{x\<in>space M. f x = c} = (f -` {c} \<inter> space M)" by auto
+ then show ?thesis using assms by (auto intro!: measurable_sets)
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_neq_const:
+ fixes f :: "'a \<Rightarrow> pinfreal"
+ assumes "f \<in> borel_measurable M"
+ shows "{x\<in>space M. f x \<noteq> c} \<in> sets M"
+proof -
+ have "{x\<in>space M. f x \<noteq> c} = space M - (f -` {c} \<inter> space M)" by auto
+ then show ?thesis using assms by (auto intro!: measurable_sets)
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_less[intro,simp]:
+ fixes f g :: "'a \<Rightarrow> pinfreal"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{x \<in> space M. f x < g x} \<in> sets M"
+proof -
+ have "(\<lambda>x. real (f x)) \<in> borel_measurable M"
+ "(\<lambda>x. real (g x)) \<in> borel_measurable M"
+ using assms by (auto intro!: borel_measurable_real)
+ from borel_measurable_less[OF this]
+ have "{x \<in> space M. real (f x) < real (g x)} \<in> sets M" .
+ moreover have "{x \<in> space M. f x \<noteq> \<omega>} \<in> sets M" using f by (rule borel_measurable_pinfreal_neq_const)
+ moreover have "{x \<in> space M. g x = \<omega>} \<in> sets M" using g by (rule borel_measurable_pinfreal_eq_const)
+ moreover have "{x \<in> space M. g x \<noteq> \<omega>} \<in> sets M" using g by (rule borel_measurable_pinfreal_neq_const)
+ moreover have "{x \<in> space M. f x < g x} = ({x \<in> space M. g x = \<omega>} \<inter> {x \<in> space M. f x \<noteq> \<omega>}) \<union>
+ ({x \<in> space M. g x \<noteq> \<omega>} \<inter> {x \<in> space M. f x \<noteq> \<omega>} \<inter> {x \<in> space M. real (f x) < real (g x)})"
+ by (auto simp: real_of_pinfreal_strict_mono_iff)
+ ultimately show ?thesis by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_le[intro,simp]:
+ fixes f :: "'a \<Rightarrow> pinfreal"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{x \<in> space M. f x \<le> g x} \<in> sets M"
+proof -
+ have "{x \<in> space M. f x \<le> g x} = space M - {x \<in> space M. g x < f x}" by auto
+ then show ?thesis using g f by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_eq[intro,simp]:
+ fixes f :: "'a \<Rightarrow> pinfreal"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{w \<in> space M. f w = g w} \<in> sets M"
+proof -
+ have "{x \<in> space M. f x = g x} = {x \<in> space M. g x \<le> f x} \<inter> {x \<in> space M. f x \<le> g x}" by auto
+ then show ?thesis using g f by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_neq[intro,simp]:
+ fixes f :: "'a \<Rightarrow> pinfreal"
+ assumes f: "f \<in> borel_measurable M"
+ assumes g: "g \<in> borel_measurable M"
+ shows "{w \<in> space M. f w \<noteq> g w} \<in> sets M"
+proof -
+ have "{w \<in> space M. f w \<noteq> g w} = space M - {w \<in> space M. f w = g w}" by auto
+ thus ?thesis using f g by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_add[intro, simp]:
+ fixes f :: "'a \<Rightarrow> pinfreal"
+ assumes measure: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
+ shows "(\<lambda>x. f x + g x) \<in> borel_measurable M"
+proof -
+ have *: "(\<lambda>x. f x + g x) =
+ (\<lambda>x. if f x = \<omega> then \<omega> else if g x = \<omega> then \<omega> else Real (real (f x) + real (g x)))"
+ by (auto simp: fun_eq_iff pinfreal_noteq_omega_Ex)
+ show ?thesis using assms unfolding *
+ by (auto intro!: measurable_If)
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_times[intro, simp]:
+ fixes f :: "'a \<Rightarrow> pinfreal" assumes "f \<in> borel_measurable M" "g \<in> borel_measurable M"
+ shows "(\<lambda>x. f x * g x) \<in> borel_measurable M"
+proof -
+ have *: "(\<lambda>x. f x * g x) =
+ (\<lambda>x. if f x = 0 then 0 else if g x = 0 then 0 else if f x = \<omega> then \<omega> else if g x = \<omega> then \<omega> else
+ Real (real (f x) * real (g x)))"
+ by (auto simp: fun_eq_iff pinfreal_noteq_omega_Ex)
+ show ?thesis using assms unfolding *
+ by (auto intro!: measurable_If)
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_setsum[simp, intro]:
+ fixes f :: "'c \<Rightarrow> 'a \<Rightarrow> pinfreal"
+ assumes "\<And>i. i \<in> S \<Longrightarrow> f i \<in> borel_measurable M"
+ shows "(\<lambda>x. \<Sum>i\<in>S. f i x) \<in> borel_measurable M"
+proof cases
+ assume "finite S"
+ thus ?thesis using assms
+ by induct auto
+qed (simp add: borel_measurable_const)
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_min[simp, intro]:
+ fixes f g :: "'a \<Rightarrow> pinfreal"
+ assumes "f \<in> borel_measurable M"
+ assumes "g \<in> borel_measurable M"
+ shows "(\<lambda>x. min (g x) (f x)) \<in> borel_measurable M"
+ using assms unfolding min_def by (auto intro!: measurable_If)
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_max[simp, intro]:
+ fixes f g :: "'a \<Rightarrow> pinfreal"
+ assumes "f \<in> borel_measurable M"
+ and "g \<in> borel_measurable M"
+ shows "(\<lambda>x. max (g x) (f x)) \<in> borel_measurable M"
+ using assms unfolding max_def by (auto intro!: measurable_If)
+
+lemma (in sigma_algebra) borel_measurable_SUP[simp, intro]:
+ fixes f :: "'d\<Colon>countable \<Rightarrow> 'a \<Rightarrow> pinfreal"
+ assumes "\<And>i. i \<in> A \<Longrightarrow> f i \<in> borel_measurable M"
+ shows "(SUP i : A. f i) \<in> borel_measurable M" (is "?sup \<in> borel_measurable M")
+ unfolding borel_measurable_pinfreal_iff_greater
+proof safe
+ fix a
+ have "{x\<in>space M. a < ?sup x} = (\<Union>i\<in>A. {x\<in>space M. a < f i x})"
+ by (auto simp: less_Sup_iff SUPR_def[where 'a=pinfreal] SUPR_fun_expand[where 'c=pinfreal])
+ then show "{x\<in>space M. a < ?sup x} \<in> sets M"
+ using assms by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_INF[simp, intro]:
+ fixes f :: "'d :: countable \<Rightarrow> 'a \<Rightarrow> pinfreal"
+ assumes "\<And>i. i \<in> A \<Longrightarrow> f i \<in> borel_measurable M"
+ shows "(INF i : A. f i) \<in> borel_measurable M" (is "?inf \<in> borel_measurable M")
+ unfolding borel_measurable_pinfreal_iff_less
+proof safe
+ fix a
+ have "{x\<in>space M. ?inf x < a} = (\<Union>i\<in>A. {x\<in>space M. f i x < a})"
+ by (auto simp: Inf_less_iff INFI_def[where 'a=pinfreal] INFI_fun_expand)
+ then show "{x\<in>space M. ?inf x < a} \<in> sets M"
+ using assms by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_pinfreal_diff[simp, intro]:
+ fixes f g :: "'a \<Rightarrow> pinfreal"
+ assumes "f \<in> borel_measurable M"
+ assumes "g \<in> borel_measurable M"
+ shows "(\<lambda>x. f x - g x) \<in> borel_measurable M"
+ unfolding borel_measurable_pinfreal_iff_greater
+proof safe
+ fix a
+ have "{x \<in> space M. a < f x - g x} = {x \<in> space M. g x + a < f x}"
+ by (simp add: pinfreal_less_minus_iff)
+ then show "{x \<in> space M. a < f x - g x} \<in> sets M"
+ using assms by auto
+qed
+
+lemma (in sigma_algebra) borel_measurable_psuminf[simp, intro]:
+ assumes "\<And>i. f i \<in> borel_measurable M"
+ shows "(\<lambda>x. (\<Sum>\<^isub>\<infinity> i. f i x)) \<in> borel_measurable M"
+ using assms unfolding psuminf_def
+ by (auto intro!: borel_measurable_SUP[unfolded SUPR_fun_expand])
+
+section "LIMSEQ is borel measurable"
+
+lemma (in sigma_algebra) borel_measurable_LIMSEQ:
+ fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> real"
+ assumes u': "\<And>x. x \<in> space M \<Longrightarrow> (\<lambda>i. u i x) ----> u' x"
+ and u: "\<And>i. u i \<in> borel_measurable M"
+ shows "u' \<in> borel_measurable M"
+proof -
+ let "?pu x i" = "max (u i x) 0"
+ let "?nu x i" = "max (- u i x) 0"
+ { fix x assume x: "x \<in> space M"
+ have "(?pu x) ----> max (u' x) 0"
+ "(?nu x) ----> max (- u' x) 0"
+ using u'[OF x] by (auto intro!: LIMSEQ_max LIMSEQ_minus)
+ from LIMSEQ_imp_lim_INF[OF _ this(1)] LIMSEQ_imp_lim_INF[OF _ this(2)]
+ have "(SUP n. INF m. Real (u (n + m) x)) = Real (u' x)"
+ "(SUP n. INF m. Real (- u (n + m) x)) = Real (- u' x)"
+ by (simp_all add: Real_max'[symmetric]) }
+ note eq = this
+ have *: "\<And>x. real (Real (u' x)) - real (Real (- u' x)) = u' x"
+ by auto
+ have "(SUP n. INF m. (\<lambda>x. Real (u (n + m) x))) \<in> borel_measurable M"
+ "(SUP n. INF m. (\<lambda>x. Real (- u (n + m) x))) \<in> borel_measurable M"
+ using u by (auto intro: borel_measurable_SUP borel_measurable_INF borel_measurable_Real)
+ with eq[THEN measurable_cong, of M "\<lambda>x. x" borel]
+ have "(\<lambda>x. Real (u' x)) \<in> borel_measurable M"
+ "(\<lambda>x. Real (- u' x)) \<in> borel_measurable M"
+ unfolding SUPR_fun_expand INFI_fun_expand by auto
+ note this[THEN borel_measurable_real]
+ from borel_measurable_diff[OF this]
+ show ?thesis unfolding * .
+qed
+
+end
--- a/src/HOL/Probability/Caratheodory.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Caratheodory.thy Thu Dec 02 11:18:44 2010 -0800
@@ -760,7 +760,7 @@
theorem (in algebra) caratheodory:
assumes posf: "positive f" and ca: "countably_additive M f"
- shows "\<exists>\<mu> :: 'a set \<Rightarrow> pinfreal. (\<forall>s \<in> sets M. \<mu> s = f s) \<and> measure_space (sigma (space M) (sets M)) \<mu>"
+ shows "\<exists>\<mu> :: 'a set \<Rightarrow> pinfreal. (\<forall>s \<in> sets M. \<mu> s = f s) \<and> measure_space (sigma M) \<mu>"
proof -
have inc: "increasing M f"
by (metis additive_increasing ca countably_additive_additive posf)
@@ -778,7 +778,7 @@
hence sgs_sb: "sigma_sets (space M) (sets M) \<subseteq> ls"
using sigma_algebra.sigma_sets_subset [OF sls, of "sets M"]
by simp
- have "measure_space (sigma (space M) (sets M)) ?infm"
+ have "measure_space (sigma M) ?infm"
unfolding sigma_def
by (rule measure_down [OF mls], rule sigma_algebra_sigma_sets)
(simp_all add: sgs_sb space_closed)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Probability/Complete_Measure.thy Thu Dec 02 11:18:44 2010 -0800
@@ -0,0 +1,274 @@
+(* Title: Complete_Measure.thy
+ Author: Robert Himmelmann, Johannes Hoelzl, TU Muenchen
+*)
+theory Complete_Measure
+imports Product_Measure
+begin
+
+locale completeable_measure_space = measure_space
+
+definition (in completeable_measure_space) completion :: "'a algebra" where
+ "completion = \<lparr> space = space M,
+ sets = { S \<union> N |S N N'. S \<in> sets M \<and> N' \<in> null_sets \<and> N \<subseteq> N' } \<rparr>"
+
+lemma (in completeable_measure_space) space_completion[simp]:
+ "space completion = space M" unfolding completion_def by simp
+
+lemma (in completeable_measure_space) sets_completionE:
+ assumes "A \<in> sets completion"
+ obtains S N N' where "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets" "S \<in> sets M"
+ using assms unfolding completion_def by auto
+
+lemma (in completeable_measure_space) sets_completionI:
+ assumes "A = S \<union> N" "N \<subseteq> N'" "N' \<in> null_sets" "S \<in> sets M"
+ shows "A \<in> sets completion"
+ using assms unfolding completion_def by auto
+
+lemma (in completeable_measure_space) sets_completionI_sets[intro]:
+ "A \<in> sets M \<Longrightarrow> A \<in> sets completion"
+ unfolding completion_def by force
+
+lemma (in completeable_measure_space) null_sets_completion:
+ assumes "N' \<in> null_sets" "N \<subseteq> N'" shows "N \<in> sets completion"
+ apply(rule sets_completionI[of N "{}" N N'])
+ using assms by auto
+
+sublocale completeable_measure_space \<subseteq> completion!: sigma_algebra completion
+proof (unfold sigma_algebra_iff2, safe)
+ fix A x assume "A \<in> sets completion" "x \<in> A"
+ with sets_into_space show "x \<in> space completion"
+ by (auto elim!: sets_completionE)
+next
+ fix A assume "A \<in> sets completion"
+ from this[THEN sets_completionE] guess S N N' . note A = this
+ let ?C = "space completion"
+ show "?C - A \<in> sets completion" using A
+ by (intro sets_completionI[of _ "(?C - S) \<inter> (?C - N')" "(?C - S) \<inter> N' \<inter> (?C - N)"])
+ auto
+next
+ fix A ::"nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> sets completion"
+ then have "\<forall>n. \<exists>S N N'. A n = S \<union> N \<and> S \<in> sets M \<and> N' \<in> null_sets \<and> N \<subseteq> N'"
+ unfolding completion_def by (auto simp: image_subset_iff)
+ from choice[OF this] guess S ..
+ from choice[OF this] guess N ..
+ from choice[OF this] guess N' ..
+ then show "UNION UNIV A \<in> sets completion"
+ using null_sets_UN[of N']
+ by (intro sets_completionI[of _ "UNION UNIV S" "UNION UNIV N" "UNION UNIV N'"])
+ auto
+qed auto
+
+definition (in completeable_measure_space)
+ "split_completion A p = (\<exists>N'. A = fst p \<union> snd p \<and> fst p \<inter> snd p = {} \<and>
+ fst p \<in> sets M \<and> snd p \<subseteq> N' \<and> N' \<in> null_sets)"
+
+definition (in completeable_measure_space)
+ "main_part A = fst (Eps (split_completion A))"
+
+definition (in completeable_measure_space)
+ "null_part A = snd (Eps (split_completion A))"
+
+lemma (in completeable_measure_space) split_completion:
+ assumes "A \<in> sets completion"
+ shows "split_completion A (main_part A, null_part A)"
+ unfolding main_part_def null_part_def
+proof (rule someI2_ex)
+ from assms[THEN sets_completionE] guess S N N' . note A = this
+ let ?P = "(S, N - S)"
+ show "\<exists>p. split_completion A p"
+ unfolding split_completion_def using A
+ proof (intro exI conjI)
+ show "A = fst ?P \<union> snd ?P" using A by auto
+ show "snd ?P \<subseteq> N'" using A by auto
+ qed auto
+qed auto
+
+lemma (in completeable_measure_space)
+ assumes "S \<in> sets completion"
+ shows main_part_sets[intro, simp]: "main_part S \<in> sets M"
+ and main_part_null_part_Un[simp]: "main_part S \<union> null_part S = S"
+ and main_part_null_part_Int[simp]: "main_part S \<inter> null_part S = {}"
+ using split_completion[OF assms] by (auto simp: split_completion_def)
+
+lemma (in completeable_measure_space) null_part:
+ assumes "S \<in> sets completion" shows "\<exists>N. N\<in>null_sets \<and> null_part S \<subseteq> N"
+ using split_completion[OF assms] by (auto simp: split_completion_def)
+
+lemma (in completeable_measure_space) null_part_sets[intro, simp]:
+ assumes "S \<in> sets M" shows "null_part S \<in> sets M" "\<mu> (null_part S) = 0"
+proof -
+ have S: "S \<in> sets completion" using assms by auto
+ have "S - main_part S \<in> sets M" using assms by auto
+ moreover
+ from main_part_null_part_Un[OF S] main_part_null_part_Int[OF S]
+ have "S - main_part S = null_part S" by auto
+ ultimately show sets: "null_part S \<in> sets M" by auto
+ from null_part[OF S] guess N ..
+ with measure_eq_0[of N "null_part S"] sets
+ show "\<mu> (null_part S) = 0" by auto
+qed
+
+definition (in completeable_measure_space) "\<mu>' A = \<mu> (main_part A)"
+
+lemma (in completeable_measure_space) \<mu>'_set[simp]:
+ assumes "S \<in> sets M" shows "\<mu>' S = \<mu> S"
+proof -
+ have S: "S \<in> sets completion" using assms by auto
+ then have "\<mu> S = \<mu> (main_part S \<union> null_part S)" by simp
+ also have "\<dots> = \<mu> (main_part S)"
+ using S assms measure_additive[of "main_part S" "null_part S"]
+ by (auto simp: measure_additive)
+ finally show ?thesis unfolding \<mu>'_def by simp
+qed
+
+lemma (in completeable_measure_space) sets_completionI_sub:
+ assumes N: "N' \<in> null_sets" "N \<subseteq> N'"
+ shows "N \<in> sets completion"
+ using assms by (intro sets_completionI[of _ "{}" N N']) auto
+
+lemma (in completeable_measure_space) \<mu>_main_part_UN:
+ fixes S :: "nat \<Rightarrow> 'a set"
+ assumes "range S \<subseteq> sets completion"
+ shows "\<mu>' (\<Union>i. (S i)) = \<mu> (\<Union>i. main_part (S i))"
+proof -
+ have S: "\<And>i. S i \<in> sets completion" using assms by auto
+ then have UN: "(\<Union>i. S i) \<in> sets completion" by auto
+ have "\<forall>i. \<exists>N. N \<in> null_sets \<and> null_part (S i) \<subseteq> N"
+ using null_part[OF S] by auto
+ from choice[OF this] guess N .. note N = this
+ then have UN_N: "(\<Union>i. N i) \<in> null_sets" by (intro null_sets_UN) auto
+ have "(\<Union>i. S i) \<in> sets completion" using S by auto
+ from null_part[OF this] guess N' .. note N' = this
+ let ?N = "(\<Union>i. N i) \<union> N'"
+ have null_set: "?N \<in> null_sets" using N' UN_N by (intro null_sets_Un) auto
+ have "main_part (\<Union>i. S i) \<union> ?N = (main_part (\<Union>i. S i) \<union> null_part (\<Union>i. S i)) \<union> ?N"
+ using N' by auto
+ also have "\<dots> = (\<Union>i. main_part (S i) \<union> null_part (S i)) \<union> ?N"
+ unfolding main_part_null_part_Un[OF S] main_part_null_part_Un[OF UN] by auto
+ also have "\<dots> = (\<Union>i. main_part (S i)) \<union> ?N"
+ using N by auto
+ finally have *: "main_part (\<Union>i. S i) \<union> ?N = (\<Union>i. main_part (S i)) \<union> ?N" .
+ have "\<mu> (main_part (\<Union>i. S i)) = \<mu> (main_part (\<Union>i. S i) \<union> ?N)"
+ using null_set UN by (intro measure_Un_null_set[symmetric]) auto
+ also have "\<dots> = \<mu> ((\<Union>i. main_part (S i)) \<union> ?N)"
+ unfolding * ..
+ also have "\<dots> = \<mu> (\<Union>i. main_part (S i))"
+ using null_set S by (intro measure_Un_null_set) auto
+ finally show ?thesis unfolding \<mu>'_def .
+qed
+
+lemma (in completeable_measure_space) \<mu>_main_part_Un:
+ assumes S: "S \<in> sets completion" and T: "T \<in> sets completion"
+ shows "\<mu>' (S \<union> T) = \<mu> (main_part S \<union> main_part T)"
+proof -
+ have UN: "(\<Union>i. binary (main_part S) (main_part T) i) = (\<Union>i. main_part (binary S T i))"
+ unfolding binary_def by (auto split: split_if_asm)
+ show ?thesis
+ using \<mu>_main_part_UN[of "binary S T"] assms
+ unfolding range_binary_eq Un_range_binary UN by auto
+qed
+
+sublocale completeable_measure_space \<subseteq> completion!: measure_space completion \<mu>'
+proof
+ show "\<mu>' {} = 0" by auto
+next
+ show "countably_additive completion \<mu>'"
+ proof (unfold countably_additive_def, intro allI conjI impI)
+ fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> sets completion" "disjoint_family A"
+ have "disjoint_family (\<lambda>i. main_part (A i))"
+ proof (intro disjoint_family_on_bisimulation[OF A(2)])
+ fix n m assume "A n \<inter> A m = {}"
+ then have "(main_part (A n) \<union> null_part (A n)) \<inter> (main_part (A m) \<union> null_part (A m)) = {}"
+ using A by (subst (1 2) main_part_null_part_Un) auto
+ then show "main_part (A n) \<inter> main_part (A m) = {}" by auto
+ qed
+ then have "(\<Sum>\<^isub>\<infinity>n. \<mu>' (A n)) = \<mu> (\<Union>i. main_part (A i))"
+ unfolding \<mu>'_def using A by (intro measure_countably_additive) auto
+ then show "(\<Sum>\<^isub>\<infinity>n. \<mu>' (A n)) = \<mu>' (UNION UNIV A)"
+ unfolding \<mu>_main_part_UN[OF A(1)] .
+ qed
+qed
+
+lemma (in completeable_measure_space) completion_ex_simple_function:
+ assumes f: "completion.simple_function f"
+ shows "\<exists>f'. simple_function f' \<and> (AE x. f x = f' x)"
+proof -
+ let "?F x" = "f -` {x} \<inter> space M"
+ have F: "\<And>x. ?F x \<in> sets completion" and fin: "finite (f`space M)"
+ using completion.simple_functionD[OF f]
+ completion.simple_functionD[OF f] by simp_all
+ have "\<forall>x. \<exists>N. N \<in> null_sets \<and> null_part (?F x) \<subseteq> N"
+ using F null_part by auto
+ from choice[OF this] obtain N where
+ N: "\<And>x. null_part (?F x) \<subseteq> N x" "\<And>x. N x \<in> null_sets" by auto
+ let ?N = "\<Union>x\<in>f`space M. N x" let "?f' x" = "if x \<in> ?N then undefined else f x"
+ have sets: "?N \<in> null_sets" using N fin by (intro null_sets_finite_UN) auto
+ show ?thesis unfolding simple_function_def
+ proof (safe intro!: exI[of _ ?f'])
+ have "?f' ` space M \<subseteq> f`space M \<union> {undefined}" by auto
+ from finite_subset[OF this] completion.simple_functionD(1)[OF f]
+ show "finite (?f' ` space M)" by auto
+ next
+ fix x assume "x \<in> space M"
+ have "?f' -` {?f' x} \<inter> space M =
+ (if x \<in> ?N then ?F undefined \<union> ?N
+ else if f x = undefined then ?F (f x) \<union> ?N
+ else ?F (f x) - ?N)"
+ using N(2) sets_into_space by (auto split: split_if_asm)
+ moreover { fix y have "?F y \<union> ?N \<in> sets M"
+ proof cases
+ assume y: "y \<in> f`space M"
+ have "?F y \<union> ?N = (main_part (?F y) \<union> null_part (?F y)) \<union> ?N"
+ using main_part_null_part_Un[OF F] by auto
+ also have "\<dots> = main_part (?F y) \<union> ?N"
+ using y N by auto
+ finally show ?thesis
+ using F sets by auto
+ next
+ assume "y \<notin> f`space M" then have "?F y = {}" by auto
+ then show ?thesis using sets by auto
+ qed }
+ moreover {
+ have "?F (f x) - ?N = main_part (?F (f x)) \<union> null_part (?F (f x)) - ?N"
+ using main_part_null_part_Un[OF F] by auto
+ also have "\<dots> = main_part (?F (f x)) - ?N"
+ using N `x \<in> space M` by auto
+ finally have "?F (f x) - ?N \<in> sets M"
+ using F sets by auto }
+ ultimately show "?f' -` {?f' x} \<inter> space M \<in> sets M" by auto
+ next
+ show "AE x. f x = ?f' x"
+ by (rule AE_I', rule sets) auto
+ qed
+qed
+
+lemma (in completeable_measure_space) completion_ex_borel_measurable:
+ fixes g :: "'a \<Rightarrow> pinfreal"
+ assumes g: "g \<in> borel_measurable completion"
+ shows "\<exists>g'\<in>borel_measurable M. (AE x. g x = g' x)"
+proof -
+ from g[THEN completion.borel_measurable_implies_simple_function_sequence]
+ obtain f where "\<And>i. completion.simple_function (f i)" "f \<up> g" by auto
+ then have "\<forall>i. \<exists>f'. simple_function f' \<and> (AE x. f i x = f' x)"
+ using completion_ex_simple_function by auto
+ from this[THEN choice] obtain f' where
+ sf: "\<And>i. simple_function (f' i)" and
+ AE: "\<forall>i. AE x. f i x = f' i x" by auto
+ show ?thesis
+ proof (intro bexI)
+ from AE[unfolded all_AE_countable]
+ show "AE x. g x = (SUP i. f' i) x" (is "AE x. g x = ?f x")
+ proof (rule AE_mp, safe intro!: AE_cong)
+ fix x assume eq: "\<forall>i. f i x = f' i x"
+ have "g x = (SUP i. f i x)"
+ using `f \<up> g` unfolding isoton_def SUPR_fun_expand by auto
+ then show "g x = ?f x"
+ using eq unfolding SUPR_fun_expand by auto
+ qed
+ show "?f \<in> borel_measurable M"
+ using sf by (auto intro!: borel_measurable_SUP
+ intro: borel_measurable_simple_function)
+ qed
+qed
+
+end
--- a/src/HOL/Probability/Euclidean_Lebesgue.thy Wed Dec 01 20:52:16 2010 -0800
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,212 +0,0 @@
-theory Euclidean_Lebesgue
- imports Lebesgue_Integration Lebesgue_Measure
-begin
-
-lemma simple_function_has_integral:
- fixes f::"'a::ordered_euclidean_space \<Rightarrow> pinfreal"
- assumes f:"lebesgue.simple_function f"
- and f':"\<forall>x. f x \<noteq> \<omega>"
- and om:"\<forall>x\<in>range f. lmeasure (f -` {x} \<inter> UNIV) = \<omega> \<longrightarrow> x = 0"
- shows "((\<lambda>x. real (f x)) has_integral (real (lebesgue.simple_integral f))) UNIV"
- unfolding lebesgue.simple_integral_def
- apply(subst lebesgue_simple_function_indicator[OF f])
-proof- case goal1
- have *:"\<And>x. \<forall>y\<in>range f. y * indicator (f -` {y}) x \<noteq> \<omega>"
- "\<forall>x\<in>range f. x * lmeasure (f -` {x} \<inter> UNIV) \<noteq> \<omega>"
- using f' om unfolding indicator_def by auto
- show ?case unfolding space_lebesgue_space real_of_pinfreal_setsum'[OF *(1),THEN sym]
- unfolding real_of_pinfreal_setsum'[OF *(2),THEN sym]
- unfolding real_of_pinfreal_setsum space_lebesgue_space
- apply(rule has_integral_setsum)
- proof safe show "finite (range f)" using f by (auto dest: lebesgue.simple_functionD)
- fix y::'a show "((\<lambda>x. real (f y * indicator (f -` {f y}) x)) has_integral
- real (f y * lmeasure (f -` {f y} \<inter> UNIV))) UNIV"
- proof(cases "f y = 0") case False
- have mea:"gmeasurable (f -` {f y})" apply(rule glmeasurable_finite)
- using assms unfolding lebesgue.simple_function_def using False by auto
- have *:"\<And>x. real (indicator (f -` {f y}) x::pinfreal) = (if x \<in> f -` {f y} then 1 else 0)" by auto
- show ?thesis unfolding real_of_pinfreal_mult[THEN sym]
- apply(rule has_integral_cmul[where 'b=real, unfolded real_scaleR_def])
- unfolding Int_UNIV_right lmeasure_gmeasure[OF mea,THEN sym]
- unfolding measure_integral_univ[OF mea] * apply(rule integrable_integral)
- unfolding gmeasurable_integrable[THEN sym] using mea .
- qed auto
- qed qed
-
-lemma (in measure_space) positive_integral_omega:
- assumes "f \<in> borel_measurable M"
- and "positive_integral f \<noteq> \<omega>"
- shows "\<mu> (f -` {\<omega>} \<inter> space M) = 0"
-proof -
- have "\<omega> * \<mu> (f -` {\<omega>} \<inter> space M) = positive_integral (\<lambda>x. \<omega> * indicator (f -` {\<omega>} \<inter> space M) x)"
- using positive_integral_cmult_indicator[OF borel_measurable_vimage, OF assms(1), of \<omega> \<omega>] by simp
- also have "\<dots> \<le> positive_integral f"
- by (auto intro!: positive_integral_mono simp: indicator_def)
- finally show ?thesis
- using assms(2) by (cases ?thesis) auto
-qed
-
-lemma (in measure_space) simple_integral_omega:
- assumes "simple_function f"
- and "simple_integral f \<noteq> \<omega>"
- shows "\<mu> (f -` {\<omega>} \<inter> space M) = 0"
-proof (rule positive_integral_omega)
- show "f \<in> borel_measurable M" using assms by (auto intro: borel_measurable_simple_function)
- show "positive_integral f \<noteq> \<omega>"
- using assms by (simp add: positive_integral_eq_simple_integral)
-qed
-
-lemma bounded_realI: assumes "\<forall>x\<in>s. abs (x::real) \<le> B" shows "bounded s"
- unfolding bounded_def dist_real_def apply(rule_tac x=0 in exI)
- using assms by auto
-
-lemma simple_function_has_integral':
- fixes f::"'a::ordered_euclidean_space \<Rightarrow> pinfreal"
- assumes f:"lebesgue.simple_function f"
- and i: "lebesgue.simple_integral f \<noteq> \<omega>"
- shows "((\<lambda>x. real (f x)) has_integral (real (lebesgue.simple_integral f))) UNIV"
-proof- let ?f = "\<lambda>x. if f x = \<omega> then 0 else f x"
- { fix x have "real (f x) = real (?f x)" by (cases "f x") auto } note * = this
- have **:"{x. f x \<noteq> ?f x} = f -` {\<omega>}" by auto
- have **:"lmeasure {x\<in>space lebesgue_space. f x \<noteq> ?f x} = 0"
- using lebesgue.simple_integral_omega[OF assms] by(auto simp add:**)
- show ?thesis apply(subst lebesgue.simple_integral_cong'[OF f _ **])
- apply(rule lebesgue.simple_function_compose1[OF f])
- unfolding * defer apply(rule simple_function_has_integral)
- proof-
- show "lebesgue.simple_function ?f"
- using lebesgue.simple_function_compose1[OF f] .
- show "\<forall>x. ?f x \<noteq> \<omega>" by auto
- show "\<forall>x\<in>range ?f. lmeasure (?f -` {x} \<inter> UNIV) = \<omega> \<longrightarrow> x = 0"
- proof (safe, simp, safe, rule ccontr)
- fix y assume "f y \<noteq> \<omega>" "f y \<noteq> 0"
- hence "(\<lambda>x. if f x = \<omega> then 0 else f x) -` {if f y = \<omega> then 0 else f y} = f -` {f y}"
- by (auto split: split_if_asm)
- moreover assume "lmeasure ((\<lambda>x. if f x = \<omega> then 0 else f x) -` {if f y = \<omega> then 0 else f y}) = \<omega>"
- ultimately have "lmeasure (f -` {f y}) = \<omega>" by simp
- moreover
- have "f y * lmeasure (f -` {f y}) \<noteq> \<omega>" using i f
- unfolding lebesgue.simple_integral_def setsum_\<omega> lebesgue.simple_function_def
- by auto
- ultimately have "f y = 0" by (auto split: split_if_asm)
- then show False using `f y \<noteq> 0` by simp
- qed
- qed
-qed
-
-lemma (in measure_space) positive_integral_monotone_convergence:
- fixes f::"nat \<Rightarrow> 'a \<Rightarrow> pinfreal"
- assumes i: "\<And>i. f i \<in> borel_measurable M" and mono: "\<And>x. mono (\<lambda>n. f n x)"
- and lim: "\<And>x. (\<lambda>i. f i x) ----> u x"
- shows "u \<in> borel_measurable M"
- and "(\<lambda>i. positive_integral (f i)) ----> positive_integral u" (is ?ilim)
-proof -
- from positive_integral_isoton[unfolded isoton_fun_expand isoton_iff_Lim_mono, of f u]
- show ?ilim using mono lim i by auto
- have "(SUP i. f i) = u" using mono lim SUP_Lim_pinfreal
- unfolding fun_eq_iff SUPR_fun_expand mono_def by auto
- moreover have "(SUP i. f i) \<in> borel_measurable M"
- using i by (rule borel_measurable_SUP)
- ultimately show "u \<in> borel_measurable M" by simp
-qed
-
-lemma positive_integral_has_integral:
- fixes f::"'a::ordered_euclidean_space => pinfreal"
- assumes f:"f \<in> borel_measurable lebesgue_space"
- and int_om:"lebesgue.positive_integral f \<noteq> \<omega>"
- and f_om:"\<forall>x. f x \<noteq> \<omega>" (* TODO: remove this *)
- shows "((\<lambda>x. real (f x)) has_integral (real (lebesgue.positive_integral f))) UNIV"
-proof- let ?i = "lebesgue.positive_integral f"
- from lebesgue.borel_measurable_implies_simple_function_sequence[OF f]
- guess u .. note conjunctD2[OF this,rule_format] note u = conjunctD2[OF this(1)] this(2)
- let ?u = "\<lambda>i x. real (u i x)" and ?f = "\<lambda>x. real (f x)"
- have u_simple:"\<And>k. lebesgue.simple_integral (u k) = lebesgue.positive_integral (u k)"
- apply(subst lebesgue.positive_integral_eq_simple_integral[THEN sym,OF u(1)]) ..
- have int_u_le:"\<And>k. lebesgue.simple_integral (u k) \<le> lebesgue.positive_integral f"
- unfolding u_simple apply(rule lebesgue.positive_integral_mono)
- using isoton_Sup[OF u(3)] unfolding le_fun_def by auto
- have u_int_om:"\<And>i. lebesgue.simple_integral (u i) \<noteq> \<omega>"
- proof- case goal1 thus ?case using int_u_le[of i] int_om by auto qed
-
- note u_int = simple_function_has_integral'[OF u(1) this]
- have "(\<lambda>x. real (f x)) integrable_on UNIV \<and>
- (\<lambda>k. gintegral UNIV (\<lambda>x. real (u k x))) ----> gintegral UNIV (\<lambda>x. real (f x))"
- apply(rule monotone_convergence_increasing) apply(rule,rule,rule u_int)
- proof safe case goal1 show ?case apply(rule real_of_pinfreal_mono) using u(2,3) by auto
- next case goal2 show ?case using u(3) apply(subst lim_Real[THEN sym])
- prefer 3 apply(subst Real_real') defer apply(subst Real_real')
- using isotone_Lim[OF u(3)[unfolded isoton_fun_expand, THEN spec]] using f_om u by auto
- next case goal3
- show ?case apply(rule bounded_realI[where B="real (lebesgue.positive_integral f)"])
- apply safe apply(subst abs_of_nonneg) apply(rule integral_nonneg,rule) apply(rule u_int)
- unfolding integral_unique[OF u_int] defer apply(rule real_of_pinfreal_mono[OF _ int_u_le])
- using u int_om by auto
- qed note int = conjunctD2[OF this]
-
- have "(\<lambda>i. lebesgue.simple_integral (u i)) ----> ?i" unfolding u_simple
- apply(rule lebesgue.positive_integral_monotone_convergence(2))
- apply(rule lebesgue.borel_measurable_simple_function[OF u(1)])
- using isotone_Lim[OF u(3)[unfolded isoton_fun_expand, THEN spec]] by auto
- hence "(\<lambda>i. real (lebesgue.simple_integral (u i))) ----> real ?i" apply-
- apply(subst lim_Real[THEN sym]) prefer 3
- apply(subst Real_real') defer apply(subst Real_real')
- using u f_om int_om u_int_om by auto
- note * = LIMSEQ_unique[OF this int(2)[unfolded integral_unique[OF u_int]]]
- show ?thesis unfolding * by(rule integrable_integral[OF int(1)])
-qed
-
-lemma lebesgue_integral_has_integral:
- fixes f::"'a::ordered_euclidean_space => real"
- assumes f:"lebesgue.integrable f"
- shows "(f has_integral (lebesgue.integral f)) UNIV"
-proof- let ?n = "\<lambda>x. - min (f x) 0" and ?p = "\<lambda>x. max (f x) 0"
- have *:"f = (\<lambda>x. ?p x - ?n x)" apply rule by auto
- note f = lebesgue.integrableD[OF f]
- show ?thesis unfolding lebesgue.integral_def apply(subst *)
- proof(rule has_integral_sub) case goal1
- have *:"\<forall>x. Real (f x) \<noteq> \<omega>" by auto
- note lebesgue.borel_measurable_Real[OF f(1)]
- from positive_integral_has_integral[OF this f(2) *]
- show ?case unfolding real_Real_max .
- next case goal2
- have *:"\<forall>x. Real (- f x) \<noteq> \<omega>" by auto
- note lebesgue.borel_measurable_uminus[OF f(1)]
- note lebesgue.borel_measurable_Real[OF this]
- from positive_integral_has_integral[OF this f(3) *]
- show ?case unfolding real_Real_max minus_min_eq_max by auto
- qed
-qed
-
-lemma lmeasurable_imp_borel[dest]: fixes s::"'a::ordered_euclidean_space set"
- assumes "s \<in> sets borel_space" shows "lmeasurable s"
-proof- let ?S = "range (\<lambda>(a, b). {a .. (b :: 'a\<Colon>ordered_euclidean_space)})"
- have *:"?S \<subseteq> sets lebesgue_space" by auto
- have "s \<in> sigma_sets UNIV ?S" using assms
- unfolding borel_space_eq_atLeastAtMost by (simp add: sigma_def)
- thus ?thesis using lebesgue.sigma_subset[of ?S,unfolded sets_sigma,OF *]
- by auto
-qed
-
-lemma lmeasurable_open[dest]:
- assumes "open s" shows "lmeasurable s"
-proof- have "s \<in> sets borel_space" using assms by auto
- thus ?thesis by auto qed
-
-lemma continuous_on_imp_borel_measurable:
- fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::ordered_euclidean_space"
- assumes "continuous_on UNIV f"
- shows "f \<in> borel_measurable lebesgue_space"
- apply(rule lebesgue.borel_measurableI)
- unfolding lebesgue_measurable apply(rule lmeasurable_open)
- using continuous_open_preimage[OF assms] unfolding vimage_def by auto
-
-
-lemma (in measure_space) integral_monotone_convergence_pos':
- assumes i: "\<And>i. integrable (f i)" and mono: "\<And>x. mono (\<lambda>n. f n x)"
- and pos: "\<And>x i. 0 \<le> f i x"
- and lim: "\<And>x. (\<lambda>i. f i x) ----> u x"
- and ilim: "(\<lambda>i. integral (f i)) ----> x"
- shows "integrable u \<and> integral u = x"
- using integral_monotone_convergence_pos[OF assms] by auto
-
-end
--- a/src/HOL/Probability/Information.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Information.thy Thu Dec 02 11:18:44 2010 -0800
@@ -1,5 +1,5 @@
theory Information
-imports Probability_Space Product_Measure Convex Radon_Nikodym
+imports Probability_Space Convex Lebesgue_Measure
begin
lemma log_le: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> x \<le> y \<Longrightarrow> log a x \<le> log a y"
@@ -12,43 +12,6 @@
"(\<Sum>x\<in>A \<times> B. f x) = (\<Sum>x\<in>A. setsum (\<lambda>y. f (x, y)) B)"
unfolding setsum_cartesian_product by simp
-lemma real_of_pinfreal_inverse[simp]:
- fixes X :: pinfreal
- shows "real (inverse X) = 1 / real X"
- by (cases X) (auto simp: inverse_eq_divide)
-
-lemma (in finite_prob_space) finite_product_prob_space_of_images:
- "finite_prob_space \<lparr> space = X ` space M \<times> Y ` space M, sets = Pow (X ` space M \<times> Y ` space M)\<rparr>
- (joint_distribution X Y)"
- (is "finite_prob_space ?S _")
-proof (simp add: finite_prob_space_eq finite_product_measure_space_of_images)
- have "X -` X ` space M \<inter> Y -` Y ` space M \<inter> space M = space M" by auto
- thus "joint_distribution X Y (X ` space M \<times> Y ` space M) = 1"
- by (simp add: distribution_def prob_space vimage_Times comp_def measure_space_1)
-qed
-
-lemma (in finite_prob_space) finite_measure_space_prod:
- assumes X: "finite_measure_space MX (distribution X)"
- assumes Y: "finite_measure_space MY (distribution Y)"
- shows "finite_measure_space (prod_measure_space MX MY) (joint_distribution X Y)"
- (is "finite_measure_space ?M ?D")
-proof (intro finite_measure_spaceI)
- interpret X: finite_measure_space MX "distribution X" by fact
- interpret Y: finite_measure_space MY "distribution Y" by fact
- note finite_measure_space.finite_prod_measure_space[OF X Y, simp]
- show "finite (space ?M)" using X.finite_space Y.finite_space by auto
- show "joint_distribution X Y {} = 0" by simp
- show "sets ?M = Pow (space ?M)" by simp
- { fix x show "?D (space ?M) \<noteq> \<omega>" by (rule distribution_finite) }
- { fix A B assume "A \<subseteq> space ?M" "B \<subseteq> space ?M" "A \<inter> B = {}"
- have *: "(\<lambda>t. (X t, Y t)) -` (A \<union> B) \<inter> space M =
- (\<lambda>t. (X t, Y t)) -` A \<inter> space M \<union> (\<lambda>t. (X t, Y t)) -` B \<inter> space M"
- by auto
- show "?D (A \<union> B) = ?D A + ?D B" unfolding distribution_def *
- apply (rule measure_additive[symmetric])
- using `A \<inter> B = {}` by (auto simp: sets_eq_Pow) }
-qed
-
section "Convex theory"
lemma log_setsum:
@@ -148,82 +111,48 @@
qed
lemma split_pairs:
- shows
- "((A, B) = X) \<longleftrightarrow> (fst X = A \<and> snd X = B)" and
- "(X = (A, B)) \<longleftrightarrow> (fst X = A \<and> snd X = B)" by auto
+ "((A, B) = X) \<longleftrightarrow> (fst X = A \<and> snd X = B)" and
+ "(X = (A, B)) \<longleftrightarrow> (fst X = A \<and> snd X = B)" by auto
section "Information theory"
-locale finite_information_space = finite_prob_space +
+locale information_space = prob_space +
fixes b :: real assumes b_gt_1: "1 < b"
-context finite_information_space
+context information_space
begin
-lemma
- assumes "0 \<le> A" and pos: "0 < A \<Longrightarrow> 0 < B" "0 < A \<Longrightarrow> 0 < C"
- shows mult_log_mult: "A * log b (B * C) = A * log b B + A * log b C" (is "?mult")
- and mult_log_divide: "A * log b (B / C) = A * log b B - A * log b C" (is "?div")
+text {* Introduce some simplification rules for logarithm of base @{term b}. *}
+
+lemma log_neg_const:
+ assumes "x \<le> 0"
+ shows "log b x = log b 0"
proof -
- have "?mult \<and> ?div"
- proof (cases "A = 0")
- case False
- hence "0 < A" using `0 \<le> A` by auto
- with pos[OF this] show "?mult \<and> ?div" using b_gt_1
- by (auto simp: log_divide log_mult field_simps)
- qed simp
- thus ?mult and ?div by auto
+ { fix u :: real
+ have "x \<le> 0" by fact
+ also have "0 < exp u"
+ using exp_gt_zero .
+ finally have "exp u \<noteq> x"
+ by auto }
+ then show "log b x = log b 0"
+ by (simp add: log_def ln_def)
qed
-ML {*
-
- (* tactic to solve equations of the form @{term "W * log b (X / (Y * Z)) = W * log b X - W * log b (Y * Z)"}
- where @{term W} is a joint distribution of @{term X}, @{term Y}, and @{term Z}. *)
-
- val mult_log_intros = [@{thm mult_log_divide}, @{thm mult_log_mult}]
- val intros = [@{thm divide_pos_pos}, @{thm mult_pos_pos}, @{thm real_pinfreal_nonneg},
- @{thm real_distribution_divide_pos_pos},
- @{thm real_distribution_mult_inverse_pos_pos},
- @{thm real_distribution_mult_pos_pos}]
-
- val distribution_gt_0_tac = (rtac @{thm distribution_mono_gt_0}
- THEN' assume_tac
- THEN' clarsimp_tac (clasimpset_of @{context} addsimps2 @{thms split_pairs}))
-
- val distr_mult_log_eq_tac = REPEAT_ALL_NEW (CHANGED o TRY o
- (resolve_tac (mult_log_intros @ intros)
- ORELSE' distribution_gt_0_tac
- ORELSE' clarsimp_tac (clasimpset_of @{context})))
-
- fun instanciate_term thy redex intro =
- let
- val intro_concl = Thm.concl_of intro
+lemma log_mult_eq:
+ "log b (A * B) = (if 0 < A * B then log b \<bar>A\<bar> + log b \<bar>B\<bar> else log b 0)"
+ using log_mult[of b "\<bar>A\<bar>" "\<bar>B\<bar>"] b_gt_1 log_neg_const[of "A * B"]
+ by (auto simp: zero_less_mult_iff mult_le_0_iff)
- val lhs = intro_concl |> HOLogic.dest_Trueprop |> HOLogic.dest_eq |> fst
-
- val m = SOME (Pattern.match thy (lhs, redex) (Vartab.empty, Vartab.empty))
- handle Pattern.MATCH => NONE
-
- in
- Option.map (fn m => Envir.subst_term m intro_concl) m
- end
+lemma log_inverse_eq:
+ "log b (inverse B) = (if 0 < B then - log b B else log b 0)"
+ using log_inverse[of b B] log_neg_const[of "inverse B"] b_gt_1 by simp
- fun mult_log_simproc simpset redex =
- let
- val ctxt = Simplifier.the_context simpset
- val thy = ProofContext.theory_of ctxt
- fun prove (SOME thm) = (SOME
- (Goal.prove ctxt [] [] thm (K (distr_mult_log_eq_tac 1))
- |> mk_meta_eq)
- handle THM _ => NONE)
- | prove NONE = NONE
- in
- get_first (instanciate_term thy (term_of redex) #> prove) mult_log_intros
- end
-*}
+lemma log_divide_eq:
+ "log b (A / B) = (if 0 < A * B then log b \<bar>A\<bar> - log b \<bar>B\<bar> else log b 0)"
+ unfolding divide_inverse log_mult_eq log_inverse_eq abs_inverse
+ by (auto simp: zero_less_mult_iff mult_le_0_iff)
-simproc_setup mult_log ("real (distribution X x) * log b (A * B)" |
- "real (distribution X x) * log b (A / B)") = {* K mult_log_simproc *}
+lemmas log_simps = log_mult_eq log_inverse_eq log_divide_eq
end
@@ -236,15 +165,49 @@
"KL_divergence b M \<mu> \<nu> =
measure_space.integral M \<mu> (\<lambda>x. log b (real (sigma_finite_measure.RN_deriv M \<nu> \<mu> x)))"
+lemma (in sigma_finite_measure) KL_divergence_cong:
+ assumes "measure_space M \<nu>"
+ and cong: "\<And>A. A \<in> sets M \<Longrightarrow> \<mu>' A = \<mu> A" "\<And>A. A \<in> sets M \<Longrightarrow> \<nu>' A = \<nu> A"
+ shows "KL_divergence b M \<nu>' \<mu>' = KL_divergence b M \<nu> \<mu>"
+proof -
+ interpret \<nu>: measure_space M \<nu> by fact
+ show ?thesis
+ unfolding KL_divergence_def
+ using RN_deriv_cong[OF cong, of "\<lambda>A. A"]
+ by (simp add: cong \<nu>.integral_cong_measure[OF cong(2)])
+qed
+
+lemma (in sigma_finite_measure) KL_divergence_vimage:
+ assumes f: "bij_betw f S (space M)"
+ assumes \<nu>: "measure_space M \<nu>" "absolutely_continuous \<nu>"
+ shows "KL_divergence b (vimage_algebra S f) (\<lambda>A. \<nu> (f ` A)) (\<lambda>A. \<mu> (f ` A)) = KL_divergence b M \<nu> \<mu>"
+ (is "KL_divergence b ?M ?\<nu> ?\<mu> = _")
+proof -
+ interpret \<nu>: measure_space M \<nu> by fact
+ interpret v: measure_space ?M ?\<nu>
+ using f by (rule \<nu>.measure_space_isomorphic)
+
+ let ?RN = "sigma_finite_measure.RN_deriv ?M ?\<mu> ?\<nu>"
+ from RN_deriv_vimage[OF f \<nu>]
+ have *: "\<nu>.almost_everywhere (\<lambda>x. ?RN (the_inv_into S f x) = RN_deriv \<nu> x)"
+ by (rule absolutely_continuous_AE[OF \<nu>])
+
+ show ?thesis
+ unfolding KL_divergence_def \<nu>.integral_vimage_inv[OF f]
+ apply (rule \<nu>.integral_cong_AE)
+ apply (rule \<nu>.AE_mp[OF *])
+ apply (rule \<nu>.AE_cong)
+ apply simp
+ done
+qed
+
lemma (in finite_measure_space) KL_divergence_eq_finite:
assumes v: "finite_measure_space M \<nu>"
- assumes ac: "\<forall>x\<in>space M. \<mu> {x} = 0 \<longrightarrow> \<nu> {x} = 0"
+ assumes ac: "absolutely_continuous \<nu>"
shows "KL_divergence b M \<nu> \<mu> = (\<Sum>x\<in>space M. real (\<nu> {x}) * log b (real (\<nu> {x}) / real (\<mu> {x})))" (is "_ = ?sum")
proof (simp add: KL_divergence_def finite_measure_space.integral_finite_singleton[OF v])
interpret v: finite_measure_space M \<nu> by fact
have ms: "measure_space M \<nu>" by fact
- have ac: "absolutely_continuous \<nu>"
- using ac by (auto intro!: absolutely_continuousI[OF v])
show "(\<Sum>x \<in> space M. log b (real (RN_deriv \<nu> x)) * real (\<nu> {x})) = ?sum"
using RN_deriv_finite_measure[OF ms ac]
by (auto intro!: setsum_cong simp: field_simps real_of_pinfreal_mult[symmetric])
@@ -252,32 +215,27 @@
lemma (in finite_prob_space) KL_divergence_positive_finite:
assumes v: "finite_prob_space M \<nu>"
- assumes ac: "\<And>x. \<lbrakk> x \<in> space M ; \<mu> {x} = 0 \<rbrakk> \<Longrightarrow> \<nu> {x} = 0"
+ assumes ac: "absolutely_continuous \<nu>"
and "1 < b"
shows "0 \<le> KL_divergence b M \<nu> \<mu>"
proof -
interpret v: finite_prob_space M \<nu> using v .
-
- have *: "space M \<noteq> {}" using not_empty by simp
+ have ms: "finite_measure_space M \<nu>" by default
- hence "- (KL_divergence b M \<nu> \<mu>) \<le> log b (\<Sum>x\<in>space M. real (\<mu> {x}))"
- proof (subst KL_divergence_eq_finite)
- show "finite_measure_space M \<nu>" by fact
+ have "- (KL_divergence b M \<nu> \<mu>) \<le> log b (\<Sum>x\<in>space M. real (\<mu> {x}))"
+ proof (subst KL_divergence_eq_finite[OF ms ac], safe intro!: log_setsum_divide not_empty)
+ show "finite (space M)" using finite_space by simp
+ show "1 < b" by fact
+ show "(\<Sum>x\<in>space M. real (\<nu> {x})) = 1" using v.finite_sum_over_space_eq_1 by simp
- show "\<forall>x\<in>space M. \<mu> {x} = 0 \<longrightarrow> \<nu> {x} = 0" using ac by auto
- show "- (\<Sum>x\<in>space M. real (\<nu> {x}) * log b (real (\<nu> {x}) / real (\<mu> {x}))) \<le> log b (\<Sum>x\<in>space M. real (\<mu> {x}))"
- proof (safe intro!: log_setsum_divide *)
- show "finite (space M)" using finite_space by simp
- show "1 < b" by fact
- show "(\<Sum>x\<in>space M. real (\<nu> {x})) = 1" using v.finite_sum_over_space_eq_1 by simp
-
- fix x assume x: "x \<in> space M"
- { assume "0 < real (\<nu> {x})"
- hence "\<mu> {x} \<noteq> 0" using ac[OF x] by auto
- thus "0 < prob {x}" using finite_measure[of "{x}"] sets_eq_Pow x
- by (cases "\<mu> {x}") simp_all }
- qed auto
- qed
+ fix x assume "x \<in> space M"
+ then have x: "{x} \<in> sets M" unfolding sets_eq_Pow by auto
+ { assume "0 < real (\<nu> {x})"
+ then have "\<nu> {x} \<noteq> 0" by auto
+ then have "\<mu> {x} \<noteq> 0"
+ using ac[unfolded absolutely_continuous_def, THEN bspec, of "{x}"] x by auto
+ thus "0 < prob {x}" using finite_measure[of "{x}"] x by auto }
+ qed auto
thus "0 \<le> KL_divergence b M \<nu> \<mu>" using finite_sum_over_space_eq_1 by simp
qed
@@ -285,174 +243,175 @@
definition (in prob_space)
"mutual_information b S T X Y =
- KL_divergence b (prod_measure_space S T)
+ KL_divergence b (sigma (pair_algebra S T))
(joint_distribution X Y)
- (prod_measure S (distribution X) T (distribution Y))"
+ (pair_sigma_finite.pair_measure S (distribution X) T (distribution Y))"
-abbreviation (in finite_information_space)
- finite_mutual_information ("\<I>'(_ ; _')") where
+definition (in prob_space)
+ "entropy b s X = mutual_information b s s X X"
+
+abbreviation (in information_space)
+ mutual_information_Pow ("\<I>'(_ ; _')") where
"\<I>(X ; Y) \<equiv> mutual_information b
\<lparr> space = X`space M, sets = Pow (X`space M) \<rparr>
\<lparr> space = Y`space M, sets = Pow (Y`space M) \<rparr> X Y"
-lemma (in finite_information_space) mutual_information_generic_eq:
- assumes MX: "finite_measure_space MX (distribution X)"
- assumes MY: "finite_measure_space MY (distribution Y)"
- shows "mutual_information b MX MY X Y = (\<Sum> (x,y) \<in> space MX \<times> space MY.
- real (joint_distribution X Y {(x,y)}) *
- log b (real (joint_distribution X Y {(x,y)}) /
- (real (distribution X {x}) * real (distribution Y {y}))))"
+lemma (in information_space) mutual_information_commute_generic:
+ assumes X: "random_variable S X" and Y: "random_variable T Y"
+ assumes ac: "measure_space.absolutely_continuous (sigma (pair_algebra S T))
+ (pair_sigma_finite.pair_measure S (distribution X) T (distribution Y)) (joint_distribution X Y)"
+ shows "mutual_information b S T X Y = mutual_information b T S Y X"
proof -
- let ?P = "prod_measure_space MX MY"
- let ?\<mu> = "prod_measure MX (distribution X) MY (distribution Y)"
- let ?\<nu> = "joint_distribution X Y"
- interpret X: finite_measure_space MX "distribution X" by fact
- moreover interpret Y: finite_measure_space MY "distribution Y" by fact
- have fms: "finite_measure_space MX (distribution X)"
- "finite_measure_space MY (distribution Y)" by fact+
- have fms_P: "finite_measure_space ?P ?\<mu>"
- by (rule X.finite_measure_space_finite_prod_measure) fact
- then interpret P: finite_measure_space ?P ?\<mu> .
- have fms_P': "finite_measure_space ?P ?\<nu>"
- using finite_product_measure_space[of "space MX" "space MY"]
- X.finite_space Y.finite_space sigma_prod_sets_finite[OF X.finite_space Y.finite_space]
- X.sets_eq_Pow Y.sets_eq_Pow
- by (simp add: prod_measure_space_def sigma_def)
- then interpret P': finite_measure_space ?P ?\<nu> .
- { fix x assume "x \<in> space ?P"
- hence in_MX: "{fst x} \<in> sets MX" "{snd x} \<in> sets MY" using X.sets_eq_Pow Y.sets_eq_Pow
- by (auto simp: prod_measure_space_def)
- assume "?\<mu> {x} = 0"
- with X.finite_prod_measure_times[OF fms(2), of "{fst x}" "{snd x}"] in_MX
- have "distribution X {fst x} = 0 \<or> distribution Y {snd x} = 0"
- by (simp add: prod_measure_space_def)
- hence "joint_distribution X Y {x} = 0"
- by (cases x) (auto simp: distribution_order) }
- note measure_0 = this
+ interpret P: prob_space "sigma (pair_algebra S T)" "joint_distribution X Y"
+ using random_variable_pairI[OF X Y] by (rule distribution_prob_space)
+ interpret Q: prob_space "sigma (pair_algebra T S)" "joint_distribution Y X"
+ using random_variable_pairI[OF Y X] by (rule distribution_prob_space)
+ interpret X: prob_space S "distribution X" using X by (rule distribution_prob_space)
+ interpret Y: prob_space T "distribution Y" using Y by (rule distribution_prob_space)
+ interpret ST: pair_sigma_finite S "distribution X" T "distribution Y" by default
+ interpret TS: pair_sigma_finite T "distribution Y" S "distribution X" by default
+
+ have ST: "measure_space (sigma (pair_algebra S T)) (joint_distribution X Y)" by default
+ have TS: "measure_space (sigma (pair_algebra T S)) (joint_distribution Y X)" by default
+
+ have bij_ST: "bij_betw (\<lambda>(x, y). (y, x)) (space (sigma (pair_algebra S T))) (space (sigma (pair_algebra T S)))"
+ by (auto intro!: inj_onI simp: space_pair_algebra bij_betw_def)
+ have bij_TS: "bij_betw (\<lambda>(x, y). (y, x)) (space (sigma (pair_algebra T S))) (space (sigma (pair_algebra S T)))"
+ by (auto intro!: inj_onI simp: space_pair_algebra bij_betw_def)
+
+ { fix A
+ have "joint_distribution X Y ((\<lambda>(x, y). (y, x)) ` A) = joint_distribution Y X A"
+ unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>]) }
+ note jd_commute = this
+
+ { fix A assume A: "A \<in> sets (sigma (pair_algebra T S))"
+ have *: "\<And>x y. indicator ((\<lambda>(x, y). (y, x)) ` A) (x, y) = (indicator A (y, x) :: pinfreal)"
+ unfolding indicator_def by auto
+ have "ST.pair_measure ((\<lambda>(x, y). (y, x)) ` A) = TS.pair_measure A"
+ unfolding ST.pair_measure_def TS.pair_measure_def
+ using A by (auto simp add: TS.Fubini[symmetric] *) }
+ note pair_measure_commute = this
+
show ?thesis
- unfolding Let_def mutual_information_def
- using measure_0 fms_P fms_P' MX MY P.absolutely_continuous_def
- by (subst P.KL_divergence_eq_finite)
- (auto simp add: prod_measure_space_def prod_measure_times_finite
- finite_prob_space_eq setsum_cartesian_product' real_of_pinfreal_mult[symmetric])
+ unfolding mutual_information_def
+ unfolding ST.KL_divergence_vimage[OF bij_TS ST ac, symmetric]
+ unfolding space_sigma space_pair_algebra jd_commute
+ unfolding ST.pair_sigma_algebra_swap[symmetric]
+ by (simp cong: TS.KL_divergence_cong[OF TS] add: pair_measure_commute)
qed
-lemma (in finite_information_space)
- assumes MX: "finite_prob_space MX (distribution X)"
- assumes MY: "finite_prob_space MY (distribution Y)"
- and X_space: "X ` space M \<subseteq> space MX" and Y_space: "Y ` space M \<subseteq> space MY"
- shows mutual_information_eq_generic:
+lemma (in prob_space) finite_variables_absolutely_continuous:
+ assumes X: "finite_random_variable S X" and Y: "finite_random_variable T Y"
+ shows "measure_space.absolutely_continuous (sigma (pair_algebra S T))
+ (pair_sigma_finite.pair_measure S (distribution X) T (distribution Y)) (joint_distribution X Y)"
+proof -
+ interpret X: finite_prob_space S "distribution X" using X by (rule distribution_finite_prob_space)
+ interpret Y: finite_prob_space T "distribution Y" using Y by (rule distribution_finite_prob_space)
+ interpret XY: pair_finite_prob_space S "distribution X" T "distribution Y" by default
+ interpret P: finite_prob_space XY.P "joint_distribution X Y"
+ using assms by (intro joint_distribution_finite_prob_space)
+ show "XY.absolutely_continuous (joint_distribution X Y)"
+ proof (rule XY.absolutely_continuousI)
+ show "finite_measure_space XY.P (joint_distribution X Y)" by default
+ fix x assume "x \<in> space XY.P" and "XY.pair_measure {x} = 0"
+ then obtain a b where "(a, b) = x" and "a \<in> space S" "b \<in> space T"
+ and distr: "distribution X {a} * distribution Y {b} = 0"
+ by (cases x) (auto simp: pair_algebra_def)
+ with assms[THEN finite_random_variableD]
+ joint_distribution_Times_le_fst[of S X T Y "{a}" "{b}"]
+ joint_distribution_Times_le_snd[of S X T Y "{a}" "{b}"]
+ have "joint_distribution X Y {x} \<le> distribution Y {b}"
+ "joint_distribution X Y {x} \<le> distribution X {a}"
+ by auto
+ with distr show "joint_distribution X Y {x} = 0" by auto
+ qed
+qed
+
+lemma (in information_space) mutual_information_commute:
+ assumes X: "finite_random_variable S X" and Y: "finite_random_variable T Y"
+ shows "mutual_information b S T X Y = mutual_information b T S Y X"
+ by (intro finite_random_variableD X Y mutual_information_commute_generic finite_variables_absolutely_continuous)
+
+lemma (in information_space) mutual_information_commute_simple:
+ assumes X: "simple_function X" and Y: "simple_function Y"
+ shows "\<I>(X;Y) = \<I>(Y;X)"
+ by (intro X Y simple_function_imp_finite_random_variable mutual_information_commute)
+
+lemma (in information_space)
+ assumes MX: "finite_random_variable MX X"
+ assumes MY: "finite_random_variable MY Y"
+ shows mutual_information_generic_eq:
"mutual_information b MX MY X Y = (\<Sum> (x,y) \<in> space MX \<times> space MY.
real (joint_distribution X Y {(x,y)}) *
log b (real (joint_distribution X Y {(x,y)}) /
(real (distribution X {x}) * real (distribution Y {y}))))"
- (is "?equality")
+ (is ?sum)
and mutual_information_positive_generic:
- "0 \<le> mutual_information b MX MY X Y" (is "?positive")
+ "0 \<le> mutual_information b MX MY X Y" (is ?positive)
proof -
- let ?P = "prod_measure_space MX MY"
- let ?\<mu> = "prod_measure MX (distribution X) MY (distribution Y)"
- let ?\<nu> = "joint_distribution X Y"
-
- interpret X: finite_prob_space MX "distribution X" by fact
- moreover interpret Y: finite_prob_space MY "distribution Y" by fact
- have ms_X: "measure_space MX (distribution X)"
- and ms_Y: "measure_space MY (distribution Y)"
- and fms: "finite_measure_space MX (distribution X)" "finite_measure_space MY (distribution Y)" by fact+
- have fms_P: "finite_measure_space ?P ?\<mu>"
- by (rule X.finite_measure_space_finite_prod_measure) fact
- then interpret P: finite_measure_space ?P ?\<mu> .
+ interpret X: finite_prob_space MX "distribution X" using MX by (rule distribution_finite_prob_space)
+ interpret Y: finite_prob_space MY "distribution Y" using MY by (rule distribution_finite_prob_space)
+ interpret XY: pair_finite_prob_space MX "distribution X" MY "distribution Y" by default
+ interpret P: finite_prob_space XY.P "joint_distribution X Y"
+ using assms by (intro joint_distribution_finite_prob_space)
- have fms_P': "finite_measure_space ?P ?\<nu>"
- using finite_product_measure_space[of "space MX" "space MY"]
- X.finite_space Y.finite_space sigma_prod_sets_finite[OF X.finite_space Y.finite_space]
- X.sets_eq_Pow Y.sets_eq_Pow
- by (simp add: prod_measure_space_def sigma_def)
- then interpret P': finite_measure_space ?P ?\<nu> .
-
- { fix x assume "x \<in> space ?P"
- hence in_MX: "{fst x} \<in> sets MX" "{snd x} \<in> sets MY" using X.sets_eq_Pow Y.sets_eq_Pow
- by (auto simp: prod_measure_space_def)
+ have P_ms: "finite_measure_space XY.P (joint_distribution X Y)" by default
+ have P_ps: "finite_prob_space XY.P (joint_distribution X Y)" by default
- assume "?\<mu> {x} = 0"
- with X.finite_prod_measure_times[OF fms(2), of "{fst x}" "{snd x}"] in_MX
- have "distribution X {fst x} = 0 \<or> distribution Y {snd x} = 0"
- by (simp add: prod_measure_space_def)
-
- hence "joint_distribution X Y {x} = 0"
- by (cases x) (auto simp: distribution_order) }
- note measure_0 = this
-
- show ?equality
+ show ?sum
unfolding Let_def mutual_information_def
- using measure_0 fms_P fms_P' MX MY P.absolutely_continuous_def
- by (subst P.KL_divergence_eq_finite)
- (auto simp add: prod_measure_space_def prod_measure_times_finite
- finite_prob_space_eq setsum_cartesian_product' real_of_pinfreal_mult[symmetric])
+ by (subst XY.KL_divergence_eq_finite[OF P_ms finite_variables_absolutely_continuous[OF MX MY]])
+ (auto simp add: pair_algebra_def setsum_cartesian_product' real_of_pinfreal_mult[symmetric])
show ?positive
- unfolding Let_def mutual_information_def using measure_0 b_gt_1
- proof (safe intro!: finite_prob_space.KL_divergence_positive_finite, simp_all)
- have "?\<mu> (space ?P) = 1"
- using X.top Y.top X.measure_space_1 Y.measure_space_1 fms
- by (simp add: prod_measure_space_def X.finite_prod_measure_times)
- with fms_P show "finite_prob_space ?P ?\<mu>"
- by (simp add: finite_prob_space_eq)
-
- from ms_X ms_Y X.top Y.top X.measure_space_1 Y.measure_space_1 Y.not_empty X_space Y_space
- have "?\<nu> (space ?P) = 1" unfolding measure_space_1[symmetric]
- by (auto intro!: arg_cong[where f="\<mu>"]
- simp add: prod_measure_space_def distribution_def vimage_Times comp_def)
- with fms_P' show "finite_prob_space ?P ?\<nu>"
- by (simp add: finite_prob_space_eq)
- qed
+ using XY.KL_divergence_positive_finite[OF P_ps finite_variables_absolutely_continuous[OF MX MY] b_gt_1]
+ unfolding mutual_information_def .
qed
-lemma (in finite_information_space) mutual_information_eq:
- "\<I>(X;Y) = (\<Sum> (x,y) \<in> X ` space M \<times> Y ` space M.
+lemma (in information_space) mutual_information_eq:
+ assumes "simple_function X" "simple_function Y"
+ shows "\<I>(X;Y) = (\<Sum> (x,y) \<in> X ` space M \<times> Y ` space M.
real (distribution (\<lambda>x. (X x, Y x)) {(x,y)}) * log b (real (distribution (\<lambda>x. (X x, Y x)) {(x,y)}) /
(real (distribution X {x}) * real (distribution Y {y}))))"
- by (subst mutual_information_eq_generic) (simp_all add: finite_prob_space_of_images)
+ using assms by (simp add: mutual_information_generic_eq)
-lemma (in finite_information_space) mutual_information_cong:
+lemma (in information_space) mutual_information_generic_cong:
assumes X: "\<And>x. x \<in> space M \<Longrightarrow> X x = X' x"
assumes Y: "\<And>x. x \<in> space M \<Longrightarrow> Y x = Y' x"
- shows "\<I>(X ; Y) = \<I>(X' ; Y')"
-proof -
- have "X ` space M = X' ` space M" using X by (auto intro!: image_eqI)
- moreover have "Y ` space M = Y' ` space M" using Y by (auto intro!: image_eqI)
- ultimately show ?thesis
- unfolding mutual_information_eq
- using
- assms[THEN distribution_cong]
- joint_distribution_cong[OF assms]
- by (auto intro!: setsum_cong)
-qed
+ shows "mutual_information b MX MY X Y = mutual_information b MX MY X' Y'"
+ unfolding mutual_information_def using X Y
+ by (simp cong: distribution_cong)
-lemma (in finite_information_space) mutual_information_positive: "0 \<le> \<I>(X;Y)"
- by (subst mutual_information_positive_generic) (simp_all add: finite_prob_space_of_images)
+lemma (in information_space) mutual_information_cong:
+ assumes X: "\<And>x. x \<in> space M \<Longrightarrow> X x = X' x"
+ assumes Y: "\<And>x. x \<in> space M \<Longrightarrow> Y x = Y' x"
+ shows "\<I>(X; Y) = \<I>(X'; Y')"
+ unfolding mutual_information_def using X Y
+ by (simp cong: distribution_cong image_cong)
+
+lemma (in information_space) mutual_information_positive:
+ assumes "simple_function X" "simple_function Y"
+ shows "0 \<le> \<I>(X;Y)"
+ using assms by (simp add: mutual_information_positive_generic)
subsection {* Entropy *}
-definition (in prob_space)
- "entropy b s X = mutual_information b s s X X"
-
-abbreviation (in finite_information_space)
- finite_entropy ("\<H>'(_')") where
+abbreviation (in information_space)
+ entropy_Pow ("\<H>'(_')") where
"\<H>(X) \<equiv> entropy b \<lparr> space = X`space M, sets = Pow (X`space M) \<rparr> X"
-lemma (in finite_information_space) entropy_generic_eq:
- assumes MX: "finite_measure_space MX (distribution X)"
+lemma (in information_space) entropy_generic_eq:
+ assumes MX: "finite_random_variable MX X"
shows "entropy b MX X = -(\<Sum> x \<in> space MX. real (distribution X {x}) * log b (real (distribution X {x})))"
proof -
+ interpret MX: finite_prob_space MX "distribution X" using MX by (rule distribution_finite_prob_space)
let "?X x" = "real (distribution X {x})"
let "?XX x y" = "real (joint_distribution X X {(x, y)})"
- interpret MX: finite_measure_space MX "distribution X" by fact
{ fix x y
have "(\<lambda>x. (X x, X x)) -` {(x, y)} = (if x = y then X -` {x} else {})" by auto
then have "?XX x y * log b (?XX x y / (?X x * ?X y)) =
(if x = y then - ?X y * log b (?X y) else 0)"
- unfolding distribution_def by (auto simp: mult_log_divide) }
+ unfolding distribution_def by (auto simp: log_simps zero_less_mult_iff) }
note remove_XX = this
show ?thesis
unfolding entropy_def mutual_information_generic_eq[OF MX MX]
@@ -460,201 +419,327 @@
by (auto simp: setsum_cases MX.finite_space)
qed
-lemma (in finite_information_space) entropy_eq:
- "\<H>(X) = -(\<Sum> x \<in> X ` space M. real (distribution X {x}) * log b (real (distribution X {x})))"
- by (simp add: finite_measure_space entropy_generic_eq)
+lemma (in information_space) entropy_eq:
+ assumes "simple_function X"
+ shows "\<H>(X) = -(\<Sum> x \<in> X ` space M. real (distribution X {x}) * log b (real (distribution X {x})))"
+ using assms by (simp add: entropy_generic_eq)
-lemma (in finite_information_space) entropy_positive: "0 \<le> \<H>(X)"
- unfolding entropy_def using mutual_information_positive .
+lemma (in information_space) entropy_positive:
+ "simple_function X \<Longrightarrow> 0 \<le> \<H>(X)"
+ unfolding entropy_def by (simp add: mutual_information_positive)
-lemma (in finite_information_space) entropy_certainty_eq_0:
- assumes "x \<in> X ` space M" and "distribution X {x} = 1"
+lemma (in information_space) entropy_certainty_eq_0:
+ assumes "simple_function X" and "x \<in> X ` space M" and "distribution X {x} = 1"
shows "\<H>(X) = 0"
proof -
interpret X: finite_prob_space "\<lparr> space = X ` space M, sets = Pow (X ` space M) \<rparr>" "distribution X"
- by (rule finite_prob_space_of_images)
-
+ using simple_function_imp_finite_random_variable[OF `simple_function X`]
+ by (rule distribution_finite_prob_space)
have "distribution X (X ` space M - {x}) = distribution X (X ` space M) - distribution X {x}"
using X.measure_compl[of "{x}"] assms by auto
also have "\<dots> = 0" using X.prob_space assms by auto
finally have X0: "distribution X (X ` space M - {x}) = 0" by auto
-
{ fix y assume asm: "y \<noteq> x" "y \<in> X ` space M"
hence "{y} \<subseteq> X ` space M - {x}" by auto
from X.measure_mono[OF this] X0 asm
have "distribution X {y} = 0" by auto }
-
hence fi: "\<And> y. y \<in> X ` space M \<Longrightarrow> real (distribution X {y}) = (if x = y then 1 else 0)"
using assms by auto
-
have y: "\<And>y. (if x = y then 1 else 0) * log b (if x = y then 1 else 0) = 0" by simp
-
- show ?thesis unfolding entropy_eq by (auto simp: y fi)
+ show ?thesis unfolding entropy_eq[OF `simple_function X`] by (auto simp: y fi)
qed
-lemma (in finite_information_space) entropy_le_card_not_0:
- "\<H>(X) \<le> log b (real (card (X ` space M \<inter> {x . distribution X {x} \<noteq> 0})))"
+lemma (in information_space) entropy_le_card_not_0:
+ assumes "simple_function X"
+ shows "\<H>(X) \<le> log b (real (card (X ` space M \<inter> {x . distribution X {x} \<noteq> 0})))"
proof -
let "?d x" = "distribution X {x}"
let "?p x" = "real (?d x)"
have "\<H>(X) = (\<Sum>x\<in>X`space M. ?p x * log b (1 / ?p x))"
- by (auto intro!: setsum_cong simp: entropy_eq setsum_negf[symmetric])
+ by (auto intro!: setsum_cong simp: entropy_eq[OF `simple_function X`] setsum_negf[symmetric] log_simps not_less)
also have "\<dots> \<le> log b (\<Sum>x\<in>X`space M. ?p x * (1 / ?p x))"
apply (rule log_setsum')
- using not_empty b_gt_1 finite_space sum_over_space_real_distribution
- by auto
+ using not_empty b_gt_1 `simple_function X` sum_over_space_real_distribution
+ by (auto simp: simple_function_def)
also have "\<dots> = log b (\<Sum>x\<in>X`space M. if ?d x \<noteq> 0 then 1 else 0)"
- apply (rule arg_cong[where f="\<lambda>f. log b (\<Sum>x\<in>X`space M. f x)"])
- using distribution_finite[of X] by (auto simp: fun_eq_iff real_of_pinfreal_eq_0)
+ using distribution_finite[OF `simple_function X`[THEN simple_function_imp_random_variable], simplified]
+ by (intro arg_cong[where f="\<lambda>X. log b X"] setsum_cong) (auto simp: real_of_pinfreal_eq_0)
finally show ?thesis
- using finite_space by (auto simp: setsum_cases real_eq_of_nat)
+ using `simple_function X` by (auto simp: setsum_cases real_eq_of_nat simple_function_def)
qed
-lemma (in finite_information_space) entropy_uniform_max:
+lemma (in information_space) entropy_uniform_max:
+ assumes "simple_function X"
assumes "\<And>x y. \<lbrakk> x \<in> X ` space M ; y \<in> X ` space M \<rbrakk> \<Longrightarrow> distribution X {x} = distribution X {y}"
shows "\<H>(X) = log b (real (card (X ` space M)))"
proof -
- note uniform =
- finite_prob_space_of_images[of X, THEN finite_prob_space.uniform_prob, simplified]
-
+ interpret X: finite_prob_space "\<lparr> space = X ` space M, sets = Pow (X ` space M) \<rparr>" "distribution X"
+ using simple_function_imp_finite_random_variable[OF `simple_function X`]
+ by (rule distribution_finite_prob_space)
have card_gt0: "0 < card (X ` space M)" unfolding card_gt_0_iff
- using finite_space not_empty by auto
-
+ using `simple_function X` not_empty by (auto simp: simple_function_def)
{ fix x assume "x \<in> X ` space M"
hence "real (distribution X {x}) = 1 / real (card (X ` space M))"
- proof (rule uniform)
+ proof (rule X.uniform_prob[simplified])
fix x y assume "x \<in> X`space M" "y \<in> X`space M"
- from assms[OF this] show "real (distribution X {x}) = real (distribution X {y})" by simp
+ from assms(2)[OF this] show "real (distribution X {x}) = real (distribution X {y})" by simp
qed }
thus ?thesis
- using not_empty finite_space b_gt_1 card_gt0
- by (simp add: entropy_eq real_eq_of_nat[symmetric] log_divide)
+ using not_empty X.finite_space b_gt_1 card_gt0
+ by (simp add: entropy_eq[OF `simple_function X`] real_eq_of_nat[symmetric] log_simps)
qed
-lemma (in finite_information_space) entropy_le_card:
- "\<H>(X) \<le> log b (real (card (X ` space M)))"
+lemma (in information_space) entropy_le_card:
+ assumes "simple_function X"
+ shows "\<H>(X) \<le> log b (real (card (X ` space M)))"
proof cases
assume "X ` space M \<inter> {x. distribution X {x} \<noteq> 0} = {}"
then have "\<And>x. x\<in>X`space M \<Longrightarrow> distribution X {x} = 0" by auto
moreover
have "0 < card (X`space M)"
- using finite_space not_empty unfolding card_gt_0_iff by auto
+ using `simple_function X` not_empty
+ by (auto simp: card_gt_0_iff simple_function_def)
then have "log b 1 \<le> log b (real (card (X`space M)))"
using b_gt_1 by (intro log_le) auto
- ultimately show ?thesis unfolding entropy_eq by simp
+ ultimately show ?thesis using assms by (simp add: entropy_eq)
next
assume False: "X ` space M \<inter> {x. distribution X {x} \<noteq> 0} \<noteq> {}"
have "card (X ` space M \<inter> {x. distribution X {x} \<noteq> 0}) \<le> card (X ` space M)"
- (is "?A \<le> ?B") using finite_space not_empty by (auto intro!: card_mono)
- note entropy_le_card_not_0
+ (is "?A \<le> ?B") using assms not_empty by (auto intro!: card_mono simp: simple_function_def)
+ note entropy_le_card_not_0[OF assms]
also have "log b (real ?A) \<le> log b (real ?B)"
- using b_gt_1 False finite_space not_empty `?A \<le> ?B`
- by (auto intro!: log_le simp: card_gt_0_iff)
+ using b_gt_1 False not_empty `?A \<le> ?B` assms
+ by (auto intro!: log_le simp: card_gt_0_iff simp: simple_function_def)
finally show ?thesis .
qed
-lemma (in finite_information_space) entropy_commute:
- "\<H>(\<lambda>x. (X x, Y x)) = \<H>(\<lambda>x. (Y x, X x))"
+lemma (in information_space) entropy_commute:
+ assumes "simple_function X" "simple_function Y"
+ shows "\<H>(\<lambda>x. (X x, Y x)) = \<H>(\<lambda>x. (Y x, X x))"
proof -
+ have sf: "simple_function (\<lambda>x. (X x, Y x))" "simple_function (\<lambda>x. (Y x, X x))"
+ using assms by (auto intro: simple_function_Pair)
have *: "(\<lambda>x. (Y x, X x))`space M = (\<lambda>(a,b). (b,a))`(\<lambda>x. (X x, Y x))`space M"
by auto
have inj: "\<And>X. inj_on (\<lambda>(a,b). (b,a)) X"
by (auto intro!: inj_onI)
show ?thesis
- unfolding entropy_eq unfolding * setsum_reindex[OF inj]
+ unfolding sf[THEN entropy_eq] unfolding * setsum_reindex[OF inj]
by (simp add: joint_distribution_commute[of Y X] split_beta)
qed
-lemma (in finite_information_space) entropy_eq_cartesian_sum:
- "\<H>(\<lambda>x. (X x, Y x)) = -(\<Sum>x\<in>X`space M. \<Sum>y\<in>Y`space M.
+lemma (in information_space) entropy_eq_cartesian_product:
+ assumes "simple_function X" "simple_function Y"
+ shows "\<H>(\<lambda>x. (X x, Y x)) = -(\<Sum>x\<in>X`space M. \<Sum>y\<in>Y`space M.
real (joint_distribution X Y {(x,y)}) *
log b (real (joint_distribution X Y {(x,y)})))"
proof -
+ have sf: "simple_function (\<lambda>x. (X x, Y x))"
+ using assms by (auto intro: simple_function_Pair)
{ fix x assume "x\<notin>(\<lambda>x. (X x, Y x))`space M"
then have "(\<lambda>x. (X x, Y x)) -` {x} \<inter> space M = {}" by auto
then have "joint_distribution X Y {x} = 0"
unfolding distribution_def by auto }
- then show ?thesis using finite_space
- unfolding entropy_eq neg_equal_iff_equal setsum_cartesian_product
- by (auto intro!: setsum_mono_zero_cong_left)
+ then show ?thesis using sf assms
+ unfolding entropy_eq[OF sf] neg_equal_iff_equal setsum_cartesian_product
+ by (auto intro!: setsum_mono_zero_cong_left simp: simple_function_def)
qed
subsection {* Conditional Mutual Information *}
definition (in prob_space)
"conditional_mutual_information b M1 M2 M3 X Y Z \<equiv>
- mutual_information b M1 (prod_measure_space M2 M3) X (\<lambda>x. (Y x, Z x)) -
+ mutual_information b M1 (sigma (pair_algebra M2 M3)) X (\<lambda>x. (Y x, Z x)) -
mutual_information b M1 M3 X Z"
-abbreviation (in finite_information_space)
- finite_conditional_mutual_information ("\<I>'( _ ; _ | _ ')") where
+abbreviation (in information_space)
+ conditional_mutual_information_Pow ("\<I>'( _ ; _ | _ ')") where
"\<I>(X ; Y | Z) \<equiv> conditional_mutual_information b
\<lparr> space = X`space M, sets = Pow (X`space M) \<rparr>
\<lparr> space = Y`space M, sets = Pow (Y`space M) \<rparr>
\<lparr> space = Z`space M, sets = Pow (Z`space M) \<rparr>
X Y Z"
-lemma (in finite_information_space) conditional_mutual_information_generic_eq:
- assumes MX: "finite_measure_space MX (distribution X)"
- assumes MY: "finite_measure_space MY (distribution Y)"
- assumes MZ: "finite_measure_space MZ (distribution Z)"
- shows "conditional_mutual_information b MX MY MZ X Y Z =
- (\<Sum>(x, y, z)\<in>space MX \<times> space MY \<times> space MZ.
- real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)}) *
- log b (real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)}) /
- (real (distribution X {x}) * real (joint_distribution Y Z {(y, z)})))) -
- (\<Sum>(x, y)\<in>space MX \<times> space MZ.
- real (joint_distribution X Z {(x, y)}) *
- log b (real (joint_distribution X Z {(x, y)}) / (real (distribution X {x}) * real (distribution Z {y}))))"
- using assms finite_measure_space_prod[OF MY MZ]
- unfolding conditional_mutual_information_def
- by (subst (1 2) mutual_information_generic_eq)
- (simp_all add: setsum_cartesian_product' finite_measure_space.finite_prod_measure_space)
-
-lemma (in finite_information_space) conditional_mutual_information_eq:
- "\<I>(X ; Y | Z) = (\<Sum>(x, y, z) \<in> X ` space M \<times> Y ` space M \<times> Z ` space M.
+lemma (in information_space) conditional_mutual_information_generic_eq:
+ assumes MX: "finite_random_variable MX X"
+ and MY: "finite_random_variable MY Y"
+ and MZ: "finite_random_variable MZ Z"
+ shows "conditional_mutual_information b MX MY MZ X Y Z = (\<Sum>(x, y, z) \<in> space MX \<times> space MY \<times> space MZ.
real (distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)}) *
log b (real (distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)}) /
(real (joint_distribution X Z {(x, z)}) * real (joint_distribution Y Z {(y,z)} / distribution Z {z}))))"
- by (subst conditional_mutual_information_generic_eq)
- (auto simp add: prod_measure_space_def sigma_prod_sets_finite finite_space
- finite_measure_space finite_product_prob_space_of_images sigma_def
- setsum_cartesian_product' setsum_product setsum_subtractf setsum_addf
- setsum_left_distrib[symmetric] setsum_real_distribution setsum_commute[where A="Y`space M"]
- real_of_pinfreal_mult[symmetric]
- cong: setsum_cong)
+ (is "_ = (\<Sum>(x, y, z)\<in>?S. ?XYZ x y z * log b (?XYZ x y z / (?XZ x z * ?YZdZ y z)))")
+proof -
+ let ?YZ = "\<lambda>y z. real (joint_distribution Y Z {(y, z)})"
+ let ?X = "\<lambda>x. real (distribution X {x})"
+ let ?Z = "\<lambda>z. real (distribution Z {z})"
+
+ txt {* This proof is actually quiet easy, however we need to show that the
+ distributions are finite and the joint distributions are zero when one of
+ the variables distribution is also zero. *}
+
+ note finite_var = MX MY MZ
+ note random_var = finite_var[THEN finite_random_variableD]
+
+ note space_simps = space_pair_algebra space_sigma algebra.simps
+
+ note YZ = finite_random_variable_pairI[OF finite_var(2,3)]
+ note XZ = finite_random_variable_pairI[OF finite_var(1,3)]
+ note ZX = finite_random_variable_pairI[OF finite_var(3,1)]
+ note YZX = finite_random_variable_pairI[OF finite_var(2) ZX]
+ note order1 =
+ finite_distribution_order(5,6)[OF finite_var(1) YZ, simplified space_simps]
+ finite_distribution_order(5,6)[OF finite_var(1,3), simplified space_simps]
+
+ note finite = finite_var(1) YZ finite_var(3) XZ YZX
+ note finite[THEN finite_distribution_finite, simplified space_simps, simp]
+
+ have order2: "\<And>x y z. \<lbrakk>x \<in> space MX; y \<in> space MY; z \<in> space MZ; joint_distribution X Z {(x, z)} = 0\<rbrakk>
+ \<Longrightarrow> joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)} = 0"
+ unfolding joint_distribution_commute_singleton[of X]
+ unfolding joint_distribution_assoc_singleton[symmetric]
+ using finite_distribution_order(6)[OF finite_var(2) ZX]
+ by (auto simp: space_simps)
-lemma (in finite_information_space) conditional_mutual_information_eq_mutual_information:
- "\<I>(X ; Y) = \<I>(X ; Y | (\<lambda>x. ()))"
+ have "(\<Sum>(x, y, z)\<in>?S. ?XYZ x y z * log b (?XYZ x y z / (?XZ x z * ?YZdZ y z))) =
+ (\<Sum>(x, y, z)\<in>?S. ?XYZ x y z * (log b (?XYZ x y z / (?X x * ?YZ y z)) - log b (?XZ x z / (?X x * ?Z z))))"
+ (is "(\<Sum>(x, y, z)\<in>?S. ?L x y z) = (\<Sum>(x, y, z)\<in>?S. ?R x y z)")
+ proof (safe intro!: setsum_cong)
+ fix x y z assume space: "x \<in> space MX" "y \<in> space MY" "z \<in> space MZ"
+ then have *: "?XYZ x y z / (?XZ x z * ?YZdZ y z) =
+ (?XYZ x y z / (?X x * ?YZ y z)) / (?XZ x z / (?X x * ?Z z))"
+ using order1(3)
+ by (auto simp: real_of_pinfreal_mult[symmetric] real_of_pinfreal_eq_0)
+ show "?L x y z = ?R x y z"
+ proof cases
+ assume "?XYZ x y z \<noteq> 0"
+ with space b_gt_1 order1 order2 show ?thesis unfolding *
+ by (subst log_divide)
+ (auto simp: zero_less_divide_iff zero_less_real_of_pinfreal
+ real_of_pinfreal_eq_0 zero_less_mult_iff)
+ qed simp
+ qed
+ also have "\<dots> = (\<Sum>(x, y, z)\<in>?S. ?XYZ x y z * log b (?XYZ x y z / (?X x * ?YZ y z))) -
+ (\<Sum>(x, y, z)\<in>?S. ?XYZ x y z * log b (?XZ x z / (?X x * ?Z z)))"
+ by (auto simp add: setsum_subtractf[symmetric] field_simps intro!: setsum_cong)
+ also have "(\<Sum>(x, y, z)\<in>?S. ?XYZ x y z * log b (?XZ x z / (?X x * ?Z z))) =
+ (\<Sum>(x, z)\<in>space MX \<times> space MZ. ?XZ x z * log b (?XZ x z / (?X x * ?Z z)))"
+ unfolding setsum_cartesian_product[symmetric] setsum_commute[of _ _ "space MY"]
+ setsum_left_distrib[symmetric]
+ unfolding joint_distribution_commute_singleton[of X]
+ unfolding joint_distribution_assoc_singleton[symmetric]
+ using setsum_real_joint_distribution_singleton[OF finite_var(2) ZX, unfolded space_simps]
+ by (intro setsum_cong refl) simp
+ also have "(\<Sum>(x, y, z)\<in>?S. ?XYZ x y z * log b (?XYZ x y z / (?X x * ?YZ y z))) -
+ (\<Sum>(x, z)\<in>space MX \<times> space MZ. ?XZ x z * log b (?XZ x z / (?X x * ?Z z))) =
+ conditional_mutual_information b MX MY MZ X Y Z"
+ unfolding conditional_mutual_information_def
+ unfolding mutual_information_generic_eq[OF finite_var(1,3)]
+ unfolding mutual_information_generic_eq[OF finite_var(1) YZ]
+ by (simp add: space_sigma space_pair_algebra setsum_cartesian_product')
+ finally show ?thesis by simp
+qed
+
+lemma (in information_space) conditional_mutual_information_eq:
+ assumes "simple_function X" "simple_function Y" "simple_function Z"
+ shows "\<I>(X;Y|Z) = (\<Sum>(x, y, z) \<in> X`space M \<times> Y`space M \<times> Z`space M.
+ real (distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)}) *
+ log b (real (distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)}) /
+ (real (joint_distribution X Z {(x, z)}) * real (joint_distribution Y Z {(y,z)} / distribution Z {z}))))"
+ using conditional_mutual_information_generic_eq[OF assms[THEN simple_function_imp_finite_random_variable]]
+ by simp
+
+lemma (in information_space) conditional_mutual_information_eq_mutual_information:
+ assumes X: "simple_function X" and Y: "simple_function Y"
+ shows "\<I>(X ; Y) = \<I>(X ; Y | (\<lambda>x. ()))"
proof -
have [simp]: "(\<lambda>x. ()) ` space M = {()}" using not_empty by auto
-
+ have C: "simple_function (\<lambda>x. ())" by auto
show ?thesis
- unfolding conditional_mutual_information_eq mutual_information_eq
+ unfolding conditional_mutual_information_eq[OF X Y C]
+ unfolding mutual_information_eq[OF X Y]
by (simp add: setsum_cartesian_product' distribution_remove_const)
qed
-lemma (in finite_information_space) conditional_mutual_information_positive:
- "0 \<le> \<I>(X ; Y | Z)"
-proof -
+lemma (in prob_space) distribution_unit[simp]: "distribution (\<lambda>x. ()) {()} = 1"
+ unfolding distribution_def using measure_space_1 by auto
+
+lemma (in prob_space) joint_distribution_unit[simp]: "distribution (\<lambda>x. (X x, ())) {(a, ())} = distribution X {a}"
+ unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>])
+
+lemma (in prob_space) setsum_distribution:
+ assumes X: "finite_random_variable MX X" shows "(\<Sum>a\<in>space MX. distribution X {a}) = 1"
+ using setsum_joint_distribution[OF assms, of "\<lparr> space = UNIV, sets = Pow UNIV \<rparr>" "\<lambda>x. ()" "{()}"]
+ using sigma_algebra_Pow[of "UNIV::unit set"] by simp
+
+lemma (in prob_space) setsum_real_distribution:
+ assumes X: "finite_random_variable MX X" shows "(\<Sum>a\<in>space MX. real (distribution X {a})) = 1"
+ using setsum_real_joint_distribution[OF assms, of "\<lparr> space = UNIV, sets = Pow UNIV \<rparr>" "\<lambda>x. ()" "{()}"]
+ using sigma_algebra_Pow[of "UNIV::unit set"] by simp
+
+lemma (in information_space) conditional_mutual_information_generic_positive:
+ assumes "finite_random_variable MX X" and "finite_random_variable MY Y" and "finite_random_variable MZ Z"
+ shows "0 \<le> conditional_mutual_information b MX MY MZ X Y Z"
+proof (cases "space MX \<times> space MY \<times> space MZ = {}")
+ case True show ?thesis
+ unfolding conditional_mutual_information_generic_eq[OF assms] True
+ by simp
+next
+ case False
let "?dXYZ A" = "real (distribution (\<lambda>x. (X x, Y x, Z x)) A)"
let "?dXZ A" = "real (joint_distribution X Z A)"
let "?dYZ A" = "real (joint_distribution Y Z A)"
let "?dX A" = "real (distribution X A)"
let "?dZ A" = "real (distribution Z A)"
- let ?M = "X ` space M \<times> Y ` space M \<times> Z ` space M"
+ let ?M = "space MX \<times> space MY \<times> space MZ"
have split_beta: "\<And>f. split f = (\<lambda>x. f (fst x) (snd x))" by (simp add: fun_eq_iff)
- have "- (\<Sum>(x, y, z) \<in> ?M. ?dXYZ {(x, y, z)} *
- log b (?dXYZ {(x, y, z)} / (?dXZ {(x, z)} * ?dYZ {(y,z)} / ?dZ {z})))
- \<le> log b (\<Sum>(x, y, z) \<in> ?M. ?dXZ {(x, z)} * ?dYZ {(y,z)} / ?dZ {z})"
+ note space_simps = space_pair_algebra space_sigma algebra.simps
+
+ note finite_var = assms
+ note YZ = finite_random_variable_pairI[OF finite_var(2,3)]
+ note XZ = finite_random_variable_pairI[OF finite_var(1,3)]
+ note ZX = finite_random_variable_pairI[OF finite_var(3,1)]
+ note YZ = finite_random_variable_pairI[OF finite_var(2,3)]
+ note XYZ = finite_random_variable_pairI[OF finite_var(1) YZ]
+ note finite = finite_var(3) YZ XZ XYZ
+ note finite = finite[THEN finite_distribution_finite, simplified space_simps]
+
+ have order: "\<And>x y z. \<lbrakk>x \<in> space MX; y \<in> space MY; z \<in> space MZ; joint_distribution X Z {(x, z)} = 0\<rbrakk>
+ \<Longrightarrow> joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)} = 0"
+ unfolding joint_distribution_commute_singleton[of X]
+ unfolding joint_distribution_assoc_singleton[symmetric]
+ using finite_distribution_order(6)[OF finite_var(2) ZX]
+ by (auto simp: space_simps)
+
+ note order = order
+ finite_distribution_order(5,6)[OF finite_var(1) YZ, simplified space_simps]
+ finite_distribution_order(5,6)[OF finite_var(2,3), simplified space_simps]
+
+ have "- conditional_mutual_information b MX MY MZ X Y Z = - (\<Sum>(x, y, z) \<in> ?M. ?dXYZ {(x, y, z)} *
+ log b (?dXYZ {(x, y, z)} / (?dXZ {(x, z)} * ?dYZ {(y,z)} / ?dZ {z})))"
+ unfolding conditional_mutual_information_generic_eq[OF assms] neg_equal_iff_equal
+ by (intro setsum_cong) (auto intro!: arg_cong[where f="log b"] simp: real_of_pinfreal_mult[symmetric])
+ also have "\<dots> \<le> log b (\<Sum>(x, y, z) \<in> ?M. ?dXZ {(x, z)} * ?dYZ {(y,z)} / ?dZ {z})"
unfolding split_beta
proof (rule log_setsum_divide)
- show "?M \<noteq> {}" using not_empty by simp
+ show "?M \<noteq> {}" using False by simp
show "1 < b" using b_gt_1 .
+ show "finite ?M" using assms
+ unfolding finite_sigma_algebra_def finite_sigma_algebra_axioms_def by auto
+
+ show "(\<Sum>x\<in>?M. ?dXYZ {(fst x, fst (snd x), snd (snd x))}) = 1"
+ unfolding setsum_cartesian_product'
+ unfolding setsum_commute[of _ "space MY"]
+ unfolding setsum_commute[of _ "space MZ"]
+ by (simp_all add: space_pair_algebra
+ setsum_real_joint_distribution_singleton[OF `finite_random_variable MX X` YZ]
+ setsum_real_joint_distribution_singleton[OF `finite_random_variable MY Y` finite_var(3)]
+ setsum_real_distribution[OF `finite_random_variable MZ Z`])
+
fix x assume "x \<in> ?M"
let ?x = "(fst x, fst (snd x), snd (snd x))"
@@ -663,120 +748,180 @@
by (simp add: real_pinfreal_nonneg mult_nonneg_nonneg divide_nonneg_nonneg)
assume *: "0 < ?dXYZ {?x}"
- thus "0 < ?dXZ {(fst x, snd (snd x))} * ?dYZ {(fst (snd x), snd (snd x))} / ?dZ {snd (snd x)}"
- apply (rule_tac divide_pos_pos mult_pos_pos)+
- by (auto simp add: real_distribution_gt_0 intro: distribution_order(6) distribution_mono_gt_0)
- qed (simp_all add: setsum_cartesian_product' sum_over_space_real_distribution setsum_real_distribution finite_space)
- also have "(\<Sum>(x, y, z) \<in> ?M. ?dXZ {(x, z)} * ?dYZ {(y,z)} / ?dZ {z}) = (\<Sum>z\<in>Z`space M. ?dZ {z})"
+ with `x \<in> ?M` show "0 < ?dXZ {(fst x, snd (snd x))} * ?dYZ {(fst (snd x), snd (snd x))} / ?dZ {snd (snd x)}"
+ using finite order
+ by (cases x)
+ (auto simp add: zero_less_real_of_pinfreal zero_less_mult_iff zero_less_divide_iff)
+ qed
+ also have "(\<Sum>(x, y, z) \<in> ?M. ?dXZ {(x, z)} * ?dYZ {(y,z)} / ?dZ {z}) = (\<Sum>z\<in>space MZ. ?dZ {z})"
apply (simp add: setsum_cartesian_product')
apply (subst setsum_commute)
apply (subst (2) setsum_commute)
- by (auto simp: setsum_divide_distrib[symmetric] setsum_product[symmetric] setsum_real_distribution
+ by (auto simp: setsum_divide_distrib[symmetric] setsum_product[symmetric]
+ setsum_real_joint_distribution_singleton[OF finite_var(1,3)]
+ setsum_real_joint_distribution_singleton[OF finite_var(2,3)]
intro!: setsum_cong)
- finally show ?thesis
- unfolding conditional_mutual_information_eq sum_over_space_real_distribution
- by (simp add: real_of_pinfreal_mult[symmetric])
+ also have "log b (\<Sum>z\<in>space MZ. ?dZ {z}) = 0"
+ unfolding setsum_real_distribution[OF finite_var(3)] by simp
+ finally show ?thesis by simp
qed
+lemma (in information_space) conditional_mutual_information_positive:
+ assumes "simple_function X" and "simple_function Y" and "simple_function Z"
+ shows "0 \<le> \<I>(X;Y|Z)"
+ using conditional_mutual_information_generic_positive[OF assms[THEN simple_function_imp_finite_random_variable]]
+ by simp
+
subsection {* Conditional Entropy *}
definition (in prob_space)
"conditional_entropy b S T X Y = conditional_mutual_information b S S T X X Y"
-abbreviation (in finite_information_space)
- finite_conditional_entropy ("\<H>'(_ | _')") where
+abbreviation (in information_space)
+ conditional_entropy_Pow ("\<H>'(_ | _')") where
"\<H>(X | Y) \<equiv> conditional_entropy b
\<lparr> space = X`space M, sets = Pow (X`space M) \<rparr>
\<lparr> space = Y`space M, sets = Pow (Y`space M) \<rparr> X Y"
-lemma (in finite_information_space) conditional_entropy_positive:
- "0 \<le> \<H>(X | Y)" unfolding conditional_entropy_def using conditional_mutual_information_positive .
+lemma (in information_space) conditional_entropy_positive:
+ "simple_function X \<Longrightarrow> simple_function Y \<Longrightarrow> 0 \<le> \<H>(X | Y)"
+ unfolding conditional_entropy_def by (auto intro!: conditional_mutual_information_positive)
-lemma (in finite_information_space) conditional_entropy_generic_eq:
- assumes MX: "finite_measure_space MX (distribution X)"
- assumes MY: "finite_measure_space MZ (distribution Z)"
+lemma (in measure_space) empty_measureI: "A = {} \<Longrightarrow> \<mu> A = 0" by simp
+
+lemma (in information_space) conditional_entropy_generic_eq:
+ assumes MX: "finite_random_variable MX X"
+ assumes MZ: "finite_random_variable MZ Z"
shows "conditional_entropy b MX MZ X Z =
- (\<Sum>(x, z)\<in>space MX \<times> space MZ.
real (joint_distribution X Z {(x, z)}) *
log b (real (joint_distribution X Z {(x, z)}) / real (distribution Z {z})))"
- unfolding conditional_entropy_def using assms
- apply (simp add: conditional_mutual_information_generic_eq
- setsum_cartesian_product' setsum_commute[of _ "space MZ"]
- setsum_negf[symmetric] setsum_subtractf[symmetric])
-proof (safe intro!: setsum_cong, simp)
- fix z x assume "z \<in> space MZ" "x \<in> space MX"
- let "?XXZ x'" = "real (joint_distribution X (\<lambda>x. (X x, Z x)) {(x, x', z)})"
- let "?XZ x'" = "real (joint_distribution X Z {(x', z)})"
- let "?X" = "real (distribution X {x})"
- interpret MX: finite_measure_space MX "distribution X" by fact
- have *: "\<And>A. A = {} \<Longrightarrow> prob A = 0" by simp
- have XXZ: "\<And>x'. ?XXZ x' = (if x' = x then ?XZ x else 0)"
- by (auto simp: distribution_def intro!: arg_cong[where f=prob] *)
- have "(\<Sum>x'\<in>space MX. ?XXZ x' * log b (?XXZ x') - (?XXZ x' * log b ?X + ?XXZ x' * log b (?XZ x'))) =
- (\<Sum>x'\<in>{x}. ?XZ x' * log b (?XZ x') - (?XZ x' * log b ?X + ?XZ x' * log b (?XZ x')))"
- using `x \<in> space MX` MX.finite_space
- by (safe intro!: setsum_mono_zero_cong_right)
- (auto split: split_if_asm simp: XXZ)
- then show "(\<Sum>x'\<in>space MX. ?XXZ x' * log b (?XXZ x') - (?XXZ x' * log b ?X + ?XXZ x' * log b (?XZ x'))) +
- ?XZ x * log b ?X = 0" by simp
+proof -
+ interpret MX: finite_sigma_algebra MX using MX by simp
+ interpret MZ: finite_sigma_algebra MZ using MZ by simp
+ let "?XXZ x y z" = "joint_distribution X (\<lambda>x. (X x, Z x)) {(x, y, z)}"
+ let "?XZ x z" = "joint_distribution X Z {(x, z)}"
+ let "?Z z" = "distribution Z {z}"
+ let "?f x y z" = "log b (real (?XXZ x y z) / (real (?XZ x z) * real (?XZ y z / ?Z z)))"
+ { fix x z have "?XXZ x x z = ?XZ x z"
+ unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>]) }
+ note this[simp]
+ { fix x x' :: 'b and z assume "x' \<noteq> x"
+ then have "?XXZ x x' z = 0"
+ by (auto simp: distribution_def intro!: arg_cong[where f=\<mu>] empty_measureI) }
+ note this[simp]
+ { fix x x' z assume *: "x \<in> space MX" "z \<in> space MZ"
+ then have "(\<Sum>x'\<in>space MX. real (?XXZ x x' z) * ?f x x' z)
+ = (\<Sum>x'\<in>space MX. if x = x' then real (?XZ x z) * ?f x x z else 0)"
+ by (auto intro!: setsum_cong)
+ also have "\<dots> = real (?XZ x z) * ?f x x z"
+ using `x \<in> space MX` by (simp add: setsum_cases[OF MX.finite_space])
+ also have "\<dots> = real (?XZ x z) * log b (real (?Z z) / real (?XZ x z))"
+ by (auto simp: real_of_pinfreal_mult[symmetric])
+ also have "\<dots> = - real (?XZ x z) * log b (real (?XZ x z) / real (?Z z))"
+ using assms[THEN finite_distribution_finite]
+ using finite_distribution_order(6)[OF MX MZ]
+ by (auto simp: log_simps field_simps zero_less_mult_iff zero_less_real_of_pinfreal real_of_pinfreal_eq_0)
+ finally have "(\<Sum>x'\<in>space MX. real (?XXZ x x' z) * ?f x x' z) =
+ - real (?XZ x z) * log b (real (?XZ x z) / real (?Z z))" . }
+ note * = this
+
+ show ?thesis
+ unfolding conditional_entropy_def
+ unfolding conditional_mutual_information_generic_eq[OF MX MX MZ]
+ by (auto simp: setsum_cartesian_product' setsum_negf[symmetric]
+ setsum_commute[of _ "space MZ"] * simp del: divide_pinfreal_def
+ intro!: setsum_cong)
qed
-lemma (in finite_information_space) conditional_entropy_eq:
- "\<H>(X | Z) =
+lemma (in information_space) conditional_entropy_eq:
+ assumes "simple_function X" "simple_function Z"
+ shows "\<H>(X | Z) =
- (\<Sum>(x, z)\<in>X ` space M \<times> Z ` space M.
real (joint_distribution X Z {(x, z)}) *
log b (real (joint_distribution X Z {(x, z)}) / real (distribution Z {z})))"
- by (simp add: finite_measure_space conditional_entropy_generic_eq)
+ using conditional_entropy_generic_eq[OF assms[THEN simple_function_imp_finite_random_variable]]
+ by simp
-lemma (in finite_information_space) conditional_entropy_eq_ce_with_hypothesis:
- "\<H>(X | Y) =
+lemma (in information_space) conditional_entropy_eq_ce_with_hypothesis:
+ assumes X: "simple_function X" and Y: "simple_function Y"
+ shows "\<H>(X | Y) =
-(\<Sum>y\<in>Y`space M. real (distribution Y {y}) *
(\<Sum>x\<in>X`space M. real (joint_distribution X Y {(x,y)}) / real (distribution Y {(y)}) *
log b (real (joint_distribution X Y {(x,y)}) / real (distribution Y {(y)}))))"
- unfolding conditional_entropy_eq neg_equal_iff_equal
- apply (simp add: setsum_commute[of _ "Y`space M"] setsum_cartesian_product' setsum_divide_distrib[symmetric])
- apply (safe intro!: setsum_cong)
- using real_distribution_order'[of Y _ X _]
- by (auto simp add: setsum_subtractf[of _ _ "X`space M"])
+ unfolding conditional_entropy_eq[OF assms]
+ using finite_distribution_finite[OF finite_random_variable_pairI[OF assms[THEN simple_function_imp_finite_random_variable]]]
+ using finite_distribution_order(5,6)[OF assms[THEN simple_function_imp_finite_random_variable]]
+ using finite_distribution_finite[OF Y[THEN simple_function_imp_finite_random_variable]]
+ by (auto simp: setsum_cartesian_product' setsum_commute[of _ "Y`space M"] setsum_right_distrib real_of_pinfreal_eq_0
+ intro!: setsum_cong)
-lemma (in finite_information_space) conditional_entropy_eq_cartesian_sum:
- "\<H>(X | Y) = -(\<Sum>x\<in>X`space M. \<Sum>y\<in>Y`space M.
+lemma (in information_space) conditional_entropy_eq_cartesian_product:
+ assumes "simple_function X" "simple_function Y"
+ shows "\<H>(X | Y) = -(\<Sum>x\<in>X`space M. \<Sum>y\<in>Y`space M.
real (joint_distribution X Y {(x,y)}) *
log b (real (joint_distribution X Y {(x,y)}) / real (distribution Y {y})))"
-proof -
- { fix x assume "x\<notin>(\<lambda>x. (X x, Y x))`space M"
- then have "(\<lambda>x. (X x, Y x)) -` {x} \<inter> space M = {}" by auto
- then have "joint_distribution X Y {x} = 0"
- unfolding distribution_def by auto }
- then show ?thesis using finite_space
- unfolding conditional_entropy_eq neg_equal_iff_equal setsum_cartesian_product
- by (auto intro!: setsum_mono_zero_cong_left)
-qed
+ unfolding conditional_entropy_eq[OF assms]
+ by (auto intro!: setsum_cong simp: setsum_cartesian_product')
subsection {* Equalities *}
-lemma (in finite_information_space) mutual_information_eq_entropy_conditional_entropy:
- "\<I>(X ; Z) = \<H>(X) - \<H>(X | Z)"
- unfolding mutual_information_eq entropy_eq conditional_entropy_eq
- using finite_space
- by (auto simp add: setsum_addf setsum_subtractf setsum_cartesian_product'
- setsum_left_distrib[symmetric] setsum_addf setsum_real_distribution)
+lemma (in information_space) mutual_information_eq_entropy_conditional_entropy:
+ assumes X: "simple_function X" and Z: "simple_function Z"
+ shows "\<I>(X ; Z) = \<H>(X) - \<H>(X | Z)"
+proof -
+ let "?XZ x z" = "real (joint_distribution X Z {(x, z)})"
+ let "?Z z" = "real (distribution Z {z})"
+ let "?X x" = "real (distribution X {x})"
+ note fX = X[THEN simple_function_imp_finite_random_variable]
+ note fZ = Z[THEN simple_function_imp_finite_random_variable]
+ note fX[THEN finite_distribution_finite, simp] and fZ[THEN finite_distribution_finite, simp]
+ note finite_distribution_order[OF fX fZ, simp]
+ { fix x z assume "x \<in> X`space M" "z \<in> Z`space M"
+ have "?XZ x z * log b (?XZ x z / (?X x * ?Z z)) =
+ ?XZ x z * log b (?XZ x z / ?Z z) - ?XZ x z * log b (?X x)"
+ by (auto simp: log_simps real_of_pinfreal_mult[symmetric] zero_less_mult_iff
+ zero_less_real_of_pinfreal field_simps real_of_pinfreal_eq_0 abs_mult) }
+ note * = this
+ show ?thesis
+ unfolding entropy_eq[OF X] conditional_entropy_eq[OF X Z] mutual_information_eq[OF X Z]
+ using setsum_real_joint_distribution_singleton[OF fZ fX, unfolded joint_distribution_commute_singleton[of Z X]]
+ by (simp add: * setsum_cartesian_product' setsum_subtractf setsum_left_distrib[symmetric]
+ setsum_real_distribution)
+qed
-lemma (in finite_information_space) conditional_entropy_less_eq_entropy:
- "\<H>(X | Z) \<le> \<H>(X)"
+lemma (in information_space) conditional_entropy_less_eq_entropy:
+ assumes X: "simple_function X" and Z: "simple_function Z"
+ shows "\<H>(X | Z) \<le> \<H>(X)"
proof -
- have "\<I>(X ; Z) = \<H>(X) - \<H>(X | Z)" using mutual_information_eq_entropy_conditional_entropy .
- with mutual_information_positive[of X Z] entropy_positive[of X]
+ have "\<I>(X ; Z) = \<H>(X) - \<H>(X | Z)" using mutual_information_eq_entropy_conditional_entropy[OF assms] .
+ with mutual_information_positive[OF X Z] entropy_positive[OF X]
show ?thesis by auto
qed
-lemma (in finite_information_space) entropy_chain_rule:
- "\<H>(\<lambda>x. (X x, Y x)) = \<H>(X) + \<H>(Y|X)"
- unfolding entropy_eq[of X] entropy_eq_cartesian_sum conditional_entropy_eq_cartesian_sum
- unfolding setsum_commute[of _ "X`space M"] setsum_negf[symmetric] setsum_addf[symmetric]
- by (rule setsum_cong)
- (simp_all add: setsum_negf setsum_addf setsum_subtractf setsum_real_distribution
- setsum_left_distrib[symmetric] joint_distribution_commute[of X Y])
+lemma (in information_space) entropy_chain_rule:
+ assumes X: "simple_function X" and Y: "simple_function Y"
+ shows "\<H>(\<lambda>x. (X x, Y x)) = \<H>(X) + \<H>(Y|X)"
+proof -
+ let "?XY x y" = "real (joint_distribution X Y {(x, y)})"
+ let "?Y y" = "real (distribution Y {y})"
+ let "?X x" = "real (distribution X {x})"
+ note fX = X[THEN simple_function_imp_finite_random_variable]
+ note fY = Y[THEN simple_function_imp_finite_random_variable]
+ note fX[THEN finite_distribution_finite, simp] and fY[THEN finite_distribution_finite, simp]
+ note finite_distribution_order[OF fX fY, simp]
+ { fix x y assume "x \<in> X`space M" "y \<in> Y`space M"
+ have "?XY x y * log b (?XY x y / ?X x) =
+ ?XY x y * log b (?XY x y) - ?XY x y * log b (?X x)"
+ by (auto simp: log_simps real_of_pinfreal_mult[symmetric] zero_less_mult_iff
+ zero_less_real_of_pinfreal field_simps real_of_pinfreal_eq_0 abs_mult) }
+ note * = this
+ show ?thesis
+ using setsum_real_joint_distribution_singleton[OF fY fX]
+ unfolding entropy_eq[OF X] conditional_entropy_eq_cartesian_product[OF Y X] entropy_eq_cartesian_product[OF X Y]
+ unfolding joint_distribution_commute_singleton[of Y X] setsum_commute[of _ "X`space M"]
+ by (simp add: * setsum_subtractf setsum_left_distrib[symmetric])
+qed
section {* Partitioning *}
@@ -893,15 +1038,26 @@
finally show ?thesis .
qed
-lemma (in finite_information_space) entropy_partition:
+lemma (in information_space) entropy_partition:
+ assumes sf: "simple_function X" "simple_function P"
assumes svi: "subvimage (space M) X P"
shows "\<H>(X) = \<H>(P) + \<H>(X|P)"
proof -
+ let "?XP x p" = "real (joint_distribution X P {(x, p)})"
+ let "?X x" = "real (distribution X {x})"
+ let "?P p" = "real (distribution P {p})"
+ note fX = sf(1)[THEN simple_function_imp_finite_random_variable]
+ note fP = sf(2)[THEN simple_function_imp_finite_random_variable]
+ note fX[THEN finite_distribution_finite, simp] and fP[THEN finite_distribution_finite, simp]
+ note finite_distribution_order[OF fX fP, simp]
have "(\<Sum>x\<in>X ` space M. real (distribution X {x}) * log b (real (distribution X {x}))) =
(\<Sum>y\<in>P `space M. \<Sum>x\<in>X ` space M.
real (joint_distribution X P {(x, y)}) * log b (real (joint_distribution X P {(x, y)})))"
proof (subst setsum_image_split[OF svi],
- safe intro!: finite_imageI finite_space setsum_mono_zero_cong_left imageI)
+ safe intro!: setsum_mono_zero_cong_left imageI)
+ show "finite (X ` space M)" "finite (X ` space M)" "finite (P ` space M)"
+ using sf unfolding simple_function_def by auto
+ next
fix p x assume in_space: "p \<in> space M" "x \<in> space M"
assume "real (joint_distribution X P {(X x, P p)}) * log b (real (joint_distribution X P {(X x, P p)})) \<noteq> 0"
hence "(\<lambda>x. (X x, P x)) -` {(X x, P p)} \<inter> space M \<noteq> {}" by (auto simp: distribution_def)
@@ -920,26 +1076,41 @@
log b (real (joint_distribution X P {(X x, P p)}))"
by (auto simp: distribution_def)
qed
- thus ?thesis
- unfolding entropy_eq conditional_entropy_eq
+ moreover have "\<And>x y. real (joint_distribution X P {(x, y)}) *
+ log b (real (joint_distribution X P {(x, y)}) / real (distribution P {y})) =
+ real (joint_distribution X P {(x, y)}) * log b (real (joint_distribution X P {(x, y)})) -
+ real (joint_distribution X P {(x, y)}) * log b (real (distribution P {y}))"
+ by (auto simp add: log_simps zero_less_mult_iff field_simps)
+ ultimately show ?thesis
+ unfolding sf[THEN entropy_eq] conditional_entropy_eq[OF sf]
+ using setsum_real_joint_distribution_singleton[OF fX fP]
by (simp add: setsum_cartesian_product' setsum_subtractf setsum_real_distribution
setsum_left_distrib[symmetric] setsum_commute[where B="P`space M"])
qed
-corollary (in finite_information_space) entropy_data_processing:
- "\<H>(f \<circ> X) \<le> \<H>(X)"
- by (subst (2) entropy_partition[of _ "f \<circ> X"]) (auto intro: conditional_entropy_positive)
+corollary (in information_space) entropy_data_processing:
+ assumes X: "simple_function X" shows "\<H>(f \<circ> X) \<le> \<H>(X)"
+proof -
+ note X
+ moreover have fX: "simple_function (f \<circ> X)" using X by auto
+ moreover have "subvimage (space M) X (f \<circ> X)" by auto
+ ultimately have "\<H>(X) = \<H>(f\<circ>X) + \<H>(X|f\<circ>X)" by (rule entropy_partition)
+ then show "\<H>(f \<circ> X) \<le> \<H>(X)"
+ by (auto intro: conditional_entropy_positive[OF X fX])
+qed
-corollary (in finite_information_space) entropy_of_inj:
- assumes "inj_on f (X`space M)"
+corollary (in information_space) entropy_of_inj:
+ assumes X: "simple_function X" and inj: "inj_on f (X`space M)"
shows "\<H>(f \<circ> X) = \<H>(X)"
proof (rule antisym)
- show "\<H>(f \<circ> X) \<le> \<H>(X)" using entropy_data_processing .
+ show "\<H>(f \<circ> X) \<le> \<H>(X)" using entropy_data_processing[OF X] .
next
+ have sf: "simple_function (f \<circ> X)"
+ using X by auto
have "\<H>(X) = \<H>(the_inv_into (X`space M) f \<circ> (f \<circ> X))"
- by (auto intro!: mutual_information_cong simp: entropy_def the_inv_into_f_f[OF assms])
+ by (auto intro!: mutual_information_cong simp: entropy_def the_inv_into_f_f[OF inj])
also have "... \<le> \<H>(f \<circ> X)"
- using entropy_data_processing .
+ using entropy_data_processing[OF sf] .
finally show "\<H>(X) \<le> \<H>(f \<circ> X)" .
qed
--- a/src/HOL/Probability/Lebesgue_Integration.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Lebesgue_Integration.thy Thu Dec 02 11:18:44 2010 -0800
@@ -3,13 +3,9 @@
header {*Lebesgue Integration*}
theory Lebesgue_Integration
-imports Measure Borel
+imports Measure Borel_Space
begin
-section "@{text \<mu>}-null sets"
-
-abbreviation (in measure_space) "null_sets \<equiv> {N\<in>sets M. \<mu> N = 0}"
-
lemma sums_If_finite:
assumes finite: "finite {r. P r}"
shows "(\<lambda>r. if P r then f r else 0) sums (\<Sum>r\<in>{r. P r}. f r)" (is "?F sums _")
@@ -47,9 +43,15 @@
lemma (in sigma_algebra) simple_functionD:
assumes "simple_function g"
- shows "finite (g ` space M)"
- "x \<in> g ` space M \<Longrightarrow> g -` {x} \<inter> space M \<in> sets M"
- using assms unfolding simple_function_def by auto
+ shows "finite (g ` space M)" and "g -` X \<inter> space M \<in> sets M"
+proof -
+ show "finite (g ` space M)"
+ using assms unfolding simple_function_def by auto
+ have "g -` X \<inter> space M = g -` (X \<inter> g`space M) \<inter> space M" by auto
+ also have "\<dots> = (\<Union>x\<in>X \<inter> g`space M. g-`{x} \<inter> space M)" by auto
+ finally show "g -` X \<inter> space M \<in> sets M" using assms
+ by (auto intro!: finite_UN simp del: UN_simps simp: simple_function_def)
+qed
lemma (in sigma_algebra) simple_function_indicator_representation:
fixes f ::"'a \<Rightarrow> pinfreal"
@@ -469,6 +471,22 @@
unfolding sigma_algebra.simple_function_def[OF N_subalgebra(2)]
by auto
+lemma (in sigma_algebra) simple_function_vimage:
+ fixes g :: "'a \<Rightarrow> pinfreal" and f :: "'d \<Rightarrow> 'a"
+ assumes g: "simple_function g" and f: "f \<in> S \<rightarrow> space M"
+ shows "sigma_algebra.simple_function (vimage_algebra S f) (\<lambda>x. g (f x))"
+proof -
+ have subset: "(\<lambda>x. g (f x)) ` S \<subseteq> g ` space M"
+ using f by auto
+ interpret V: sigma_algebra "vimage_algebra S f"
+ using f by (rule sigma_algebra_vimage)
+ show ?thesis using g
+ unfolding simple_function_eq_borel_measurable
+ unfolding V.simple_function_eq_borel_measurable
+ using measurable_vimage[OF _ f, of g borel]
+ using finite_subset[OF subset] by auto
+qed
+
section "Simple integral"
definition (in measure_space)
@@ -484,6 +502,17 @@
thus ?thesis unfolding simple_integral_def by simp
qed
+lemma (in measure_space) simple_integral_cong_measure:
+ assumes "\<And>A. A \<in> sets M \<Longrightarrow> \<nu> A = \<mu> A" and "simple_function f"
+ shows "measure_space.simple_integral M \<nu> f = simple_integral f"
+proof -
+ interpret v: measure_space M \<nu>
+ by (rule measure_space_cong) fact
+ from simple_functionD[OF `simple_function f`] assms show ?thesis
+ unfolding simple_integral_def v.simple_integral_def
+ by (auto intro!: setsum_cong)
+qed
+
lemma (in measure_space) simple_integral_const[simp]:
"simple_integral (\<lambda>x. c) = c * \<mu> (space M)"
proof (cases "space M = {}")
@@ -590,22 +619,84 @@
by (auto simp: setsum_right_distrib field_simps intro!: setsum_cong)
qed
+lemma (in sigma_algebra) simple_function_If:
+ assumes sf: "simple_function f" "simple_function g" and A: "A \<in> sets M"
+ shows "simple_function (\<lambda>x. if x \<in> A then f x else g x)" (is "simple_function ?IF")
+proof -
+ def F \<equiv> "\<lambda>x. f -` {x} \<inter> space M" and G \<equiv> "\<lambda>x. g -` {x} \<inter> space M"
+ show ?thesis unfolding simple_function_def
+ proof safe
+ have "?IF ` space M \<subseteq> f ` space M \<union> g ` space M" by auto
+ from finite_subset[OF this] assms
+ show "finite (?IF ` space M)" unfolding simple_function_def by auto
+ next
+ fix x assume "x \<in> space M"
+ then have *: "?IF -` {?IF x} \<inter> space M = (if x \<in> A
+ then ((F (f x) \<inter> A) \<union> (G (f x) - (G (f x) \<inter> A)))
+ else ((F (g x) \<inter> A) \<union> (G (g x) - (G (g x) \<inter> A))))"
+ using sets_into_space[OF A] by (auto split: split_if_asm simp: G_def F_def)
+ have [intro]: "\<And>x. F x \<in> sets M" "\<And>x. G x \<in> sets M"
+ unfolding F_def G_def using sf[THEN simple_functionD(2)] by auto
+ show "?IF -` {?IF x} \<inter> space M \<in> sets M" unfolding * using A by auto
+ qed
+qed
+
+lemma (in measure_space) simple_integral_mono_AE:
+ assumes "simple_function f" and "simple_function g"
+ and mono: "AE x. f x \<le> g x"
+ shows "simple_integral f \<le> simple_integral g"
+proof -
+ let "?S x" = "(g -` {g x} \<inter> space M) \<inter> (f -` {f x} \<inter> space M)"
+ have *: "\<And>x. g -` {g x} \<inter> f -` {f x} \<inter> space M = ?S x"
+ "\<And>x. f -` {f x} \<inter> g -` {g x} \<inter> space M = ?S x" by auto
+ show ?thesis
+ unfolding *
+ simple_function_partition[OF `simple_function f` `simple_function g`]
+ simple_function_partition[OF `simple_function g` `simple_function f`]
+ proof (safe intro!: setsum_mono)
+ fix x assume "x \<in> space M"
+ then have *: "f ` ?S x = {f x}" "g ` ?S x = {g x}" by auto
+ show "the_elem (f`?S x) * \<mu> (?S x) \<le> the_elem (g`?S x) * \<mu> (?S x)"
+ proof (cases "f x \<le> g x")
+ case True then show ?thesis using * by (auto intro!: mult_right_mono)
+ next
+ case False
+ obtain N where N: "{x\<in>space M. \<not> f x \<le> g x} \<subseteq> N" "N \<in> sets M" "\<mu> N = 0"
+ using mono by (auto elim!: AE_E)
+ have "?S x \<subseteq> N" using N `x \<in> space M` False by auto
+ moreover have "?S x \<in> sets M" using assms
+ by (rule_tac Int) (auto intro!: simple_functionD)
+ ultimately have "\<mu> (?S x) \<le> \<mu> N"
+ using `N \<in> sets M` by (auto intro!: measure_mono)
+ then show ?thesis using `\<mu> N = 0` by auto
+ qed
+ qed
+qed
+
lemma (in measure_space) simple_integral_mono:
assumes "simple_function f" and "simple_function g"
and mono: "\<And> x. x \<in> space M \<Longrightarrow> f x \<le> g x"
shows "simple_integral f \<le> simple_integral g"
- unfolding
- simple_function_partition[OF `simple_function f` `simple_function g`]
- simple_function_partition[OF `simple_function g` `simple_function f`]
- apply (subst Int_commute)
-proof (safe intro!: setsum_mono)
- fix x let ?S = "g -` {g x} \<inter> f -` {f x} \<inter> space M"
- assume "x \<in> space M"
- hence "f ` ?S = {f x}" "g ` ?S = {g x}" by auto
- thus "the_elem (f`?S) * \<mu> ?S \<le> the_elem (g`?S) * \<mu> ?S"
- using mono[OF `x \<in> space M`] by (auto intro!: mult_right_mono)
+proof (rule simple_integral_mono_AE[OF assms(1, 2)])
+ show "AE x. f x \<le> g x"
+ using mono by (rule AE_cong) auto
qed
+lemma (in measure_space) simple_integral_cong_AE:
+ assumes "simple_function f" "simple_function g" and "AE x. f x = g x"
+ shows "simple_integral f = simple_integral g"
+ using assms by (auto simp: eq_iff intro!: simple_integral_mono_AE)
+
+lemma (in measure_space) simple_integral_cong':
+ assumes sf: "simple_function f" "simple_function g"
+ and mea: "\<mu> {x\<in>space M. f x \<noteq> g x} = 0"
+ shows "simple_integral f = simple_integral g"
+proof (intro simple_integral_cong_AE sf AE_I)
+ show "\<mu> {x\<in>space M. f x \<noteq> g x} = 0" by fact
+ show "{x \<in> space M. f x \<noteq> g x} \<in> sets M"
+ using sf[THEN borel_measurable_simple_function] by auto
+qed simp
+
lemma (in measure_space) simple_integral_indicator:
assumes "A \<in> sets M"
assumes "simple_function f"
@@ -637,7 +728,8 @@
using assms(2) unfolding simple_function_def by auto
show "f ` A \<union> {0} \<subseteq> f`space M \<union> {0}"
using sets_into_space[OF assms(1)] by auto
- have "\<And>x. f x \<notin> f ` A \<Longrightarrow> f -` {f x} \<inter> space M \<inter> A = {}" by (auto simp: image_iff)
+ have "\<And>x. f x \<notin> f ` A \<Longrightarrow> f -` {f x} \<inter> space M \<inter> A = {}"
+ by (auto simp: image_iff)
thus "\<forall>i\<in>f ` space M \<union> {0} - (f ` A \<union> {0}).
i * \<mu> (f -` {i} \<inter> space M \<inter> A) = 0" by auto
next
@@ -670,45 +762,22 @@
assumes "simple_function u" "N \<in> null_sets"
shows "simple_integral (\<lambda>x. u x * indicator N x) = 0"
proof -
- have "simple_integral (\<lambda>x. u x * indicator N x) \<le>
- simple_integral (\<lambda>x. \<omega> * indicator N x)"
- using assms
- by (safe intro!: simple_integral_mono simple_function_mult simple_function_indicator simple_function_const) simp
- also have "... = 0" apply(subst simple_integral_mult)
- using assms(2) by auto
- finally show ?thesis by auto
+ have "AE x. indicator N x = (0 :: pinfreal)"
+ using `N \<in> null_sets` by (auto simp: indicator_def intro!: AE_I[of _ N])
+ then have "simple_integral (\<lambda>x. u x * indicator N x) = simple_integral (\<lambda>x. 0)"
+ using assms by (intro simple_integral_cong_AE) (auto intro!: AE_disjI2)
+ then show ?thesis by simp
qed
-lemma (in measure_space) simple_integral_cong':
- assumes f: "simple_function f" and g: "simple_function g"
- and mea: "\<mu> {x\<in>space M. f x \<noteq> g x} = 0"
- shows "simple_integral f = simple_integral g"
-proof -
- let ?h = "\<lambda>h. \<lambda>x. (h x * indicator {x\<in>space M. f x = g x} x
- + h x * indicator {x\<in>space M. f x \<noteq> g x} x
- + h x * indicator (-space M) x::pinfreal)"
- have *:"\<And>h. h = ?h h" unfolding indicator_def apply rule by auto
- have mea_neq:"{x \<in> space M. f x \<noteq> g x} \<in> sets M" using f g by (auto simp: borel_measurable_simple_function)
- then have mea_nullset: "{x \<in> space M. f x \<noteq> g x} \<in> null_sets" using mea by auto
- have h1:"\<And>h::_=>pinfreal. simple_function h \<Longrightarrow>
- simple_function (\<lambda>x. h x * indicator {x\<in>space M. f x = g x} x)"
- apply(safe intro!: simple_function_add simple_function_mult simple_function_indicator)
- using f g by (auto simp: borel_measurable_simple_function)
- have h2:"\<And>h::_\<Rightarrow>pinfreal. simple_function h \<Longrightarrow>
- simple_function (\<lambda>x. h x * indicator {x\<in>space M. f x \<noteq> g x} x)"
- apply(safe intro!: simple_function_add simple_function_mult simple_function_indicator)
- by(rule mea_neq)
- have **:"\<And>a b c d e f. a = b \<Longrightarrow> c = d \<Longrightarrow> e = f \<Longrightarrow> a+c+e = b+d+f" by auto
- note *** = simple_integral_add[OF simple_function_add[OF h1 h2] simple_function_notspace]
- simple_integral_add[OF h1 h2]
- show ?thesis apply(subst *[of g]) apply(subst *[of f])
- unfolding ***[OF f f] ***[OF g g]
- proof(rule **) case goal1 show ?case apply(rule arg_cong[where f=simple_integral]) apply rule
- unfolding indicator_def by auto
- next note * = simple_integral_null_set[OF _ mea_nullset]
- case goal2 show ?case unfolding *[OF f] *[OF g] ..
- next case goal3 show ?case apply(rule simple_integral_cong) by auto
- qed
+lemma (in measure_space) simple_integral_cong_AE_mult_indicator:
+ assumes sf: "simple_function f" and eq: "AE x. x \<in> S" and "S \<in> sets M"
+ shows "simple_integral f = simple_integral (\<lambda>x. f x * indicator S x)"
+proof (rule simple_integral_cong_AE)
+ show "simple_function f" by fact
+ show "simple_function (\<lambda>x. f x * indicator S x)"
+ using sf `S \<in> sets M` by auto
+ from eq show "AE x. f x = f x * indicator S x"
+ by (rule AE_mp) simp
qed
lemma (in measure_space) simple_integral_restricted:
@@ -746,16 +815,112 @@
unfolding simple_integral_def_raw
unfolding measure_space.simple_integral_def_raw[OF assms] by simp
+lemma (in measure_space) simple_integral_vimage:
+ fixes g :: "'a \<Rightarrow> pinfreal" and f :: "'d \<Rightarrow> 'a"
+ assumes f: "bij_betw f S (space M)"
+ shows "simple_integral g =
+ measure_space.simple_integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>x. g (f x))"
+ (is "_ = measure_space.simple_integral ?T ?\<mu> _")
+proof -
+ from f interpret T: measure_space ?T ?\<mu> by (rule measure_space_isomorphic)
+ have surj: "f`S = space M"
+ using f unfolding bij_betw_def by simp
+ have *: "(\<lambda>x. g (f x)) ` S = g ` f ` S" by auto
+ have **: "f`S = space M" using f unfolding bij_betw_def by auto
+ { fix x assume "x \<in> space M"
+ have "(f ` ((\<lambda>x. g (f x)) -` {g x} \<inter> S)) =
+ (f ` (f -` (g -` {g x}) \<inter> S))" by auto
+ also have "f -` (g -` {g x}) \<inter> S = f -` (g -` {g x} \<inter> space M) \<inter> S"
+ using f unfolding bij_betw_def by auto
+ also have "(f ` (f -` (g -` {g x} \<inter> space M) \<inter> S)) = g -` {g x} \<inter> space M"
+ using ** by (intro image_vimage_inter_eq) auto
+ finally have "(f ` ((\<lambda>x. g (f x)) -` {g x} \<inter> S)) = g -` {g x} \<inter> space M" by auto }
+ then show ?thesis using assms
+ unfolding simple_integral_def T.simple_integral_def bij_betw_def
+ by (auto simp add: * intro!: setsum_cong)
+qed
+
section "Continuous posititve integration"
definition (in measure_space)
+ "positive_integral f = SUPR {g. simple_function g \<and> g \<le> f} simple_integral"
+
+lemma (in measure_space) positive_integral_alt:
"positive_integral f =
- (SUP g : {g. simple_function g \<and> g \<le> f \<and> \<omega> \<notin> g`space M}. simple_integral g)"
+ (SUPR {g. simple_function g \<and> g \<le> f \<and> \<omega> \<notin> g`space M} simple_integral)" (is "_ = ?alt")
+proof (rule antisym SUP_leI)
+ show "positive_integral f \<le> ?alt" unfolding positive_integral_def
+ proof (safe intro!: SUP_leI)
+ fix g assume g: "simple_function g" "g \<le> f"
+ let ?G = "g -` {\<omega>} \<inter> space M"
+ show "simple_integral g \<le>
+ SUPR {g. simple_function g \<and> g \<le> f \<and> \<omega> \<notin> g ` space M} simple_integral"
+ (is "simple_integral g \<le> SUPR ?A simple_integral")
+ proof cases
+ let ?g = "\<lambda>x. indicator (space M - ?G) x * g x"
+ have g': "simple_function ?g"
+ using g by (auto intro: simple_functionD)
+ moreover
+ assume "\<mu> ?G = 0"
+ then have "AE x. g x = ?g x" using g
+ by (intro AE_I[where N="?G"])
+ (auto intro: simple_functionD simp: indicator_def)
+ with g(1) g' have "simple_integral g = simple_integral ?g"
+ by (rule simple_integral_cong_AE)
+ moreover have "?g \<le> g" by (auto simp: le_fun_def indicator_def)
+ from this `g \<le> f` have "?g \<le> f" by (rule order_trans)
+ moreover have "\<omega> \<notin> ?g ` space M"
+ by (auto simp: indicator_def split: split_if_asm)
+ ultimately show ?thesis by (auto intro!: le_SUPI)
+ next
+ assume "\<mu> ?G \<noteq> 0"
+ then have "?G \<noteq> {}" by auto
+ then have "\<omega> \<in> g`space M" by force
+ then have "space M \<noteq> {}" by auto
+ have "SUPR ?A simple_integral = \<omega>"
+ proof (intro SUP_\<omega>[THEN iffD2] allI impI)
+ fix x assume "x < \<omega>"
+ then guess n unfolding less_\<omega>_Ex_of_nat .. note n = this
+ then have "0 < n" by (intro neq0_conv[THEN iffD1] notI) simp
+ let ?g = "\<lambda>x. (of_nat n / (if \<mu> ?G = \<omega> then 1 else \<mu> ?G)) * indicator ?G x"
+ show "\<exists>i\<in>?A. x < simple_integral i"
+ proof (intro bexI impI CollectI conjI)
+ show "simple_function ?g" using g
+ by (auto intro!: simple_functionD simple_function_add)
+ have "?g \<le> g" by (auto simp: le_fun_def indicator_def)
+ from this g(2) show "?g \<le> f" by (rule order_trans)
+ show "\<omega> \<notin> ?g ` space M"
+ using `\<mu> ?G \<noteq> 0` by (auto simp: indicator_def split: split_if_asm)
+ have "x < (of_nat n / (if \<mu> ?G = \<omega> then 1 else \<mu> ?G)) * \<mu> ?G"
+ using n `\<mu> ?G \<noteq> 0` `0 < n`
+ by (auto simp: pinfreal_noteq_omega_Ex field_simps)
+ also have "\<dots> = simple_integral ?g" using g `space M \<noteq> {}`
+ by (subst simple_integral_indicator)
+ (auto simp: image_constant ac_simps dest: simple_functionD)
+ finally show "x < simple_integral ?g" .
+ qed
+ qed
+ then show ?thesis by simp
+ qed
+ qed
+qed (auto intro!: SUP_subset simp: positive_integral_def)
+
+lemma (in measure_space) positive_integral_cong_measure:
+ assumes "\<And>A. A \<in> sets M \<Longrightarrow> \<nu> A = \<mu> A"
+ shows "measure_space.positive_integral M \<nu> f = positive_integral f"
+proof -
+ interpret v: measure_space M \<nu>
+ by (rule measure_space_cong) fact
+ with assms show ?thesis
+ unfolding positive_integral_def v.positive_integral_def SUPR_def
+ by (auto intro!: arg_cong[where f=Sup] image_cong
+ simp: simple_integral_cong_measure[of \<nu>])
+qed
lemma (in measure_space) positive_integral_alt1:
"positive_integral f =
(SUP g : {g. simple_function g \<and> (\<forall>x\<in>space M. g x \<le> f x \<and> g x \<noteq> \<omega>)}. simple_integral g)"
- unfolding positive_integral_def SUPR_def
+ unfolding positive_integral_alt SUPR_def
proof (safe intro!: arg_cong[where f=Sup])
fix g let ?g = "\<lambda>x. if x \<in> space M then g x else f x"
assume "simple_function g" "\<forall>x\<in>space M. g x \<le> f x \<and> g x \<noteq> \<omega>"
@@ -772,75 +937,6 @@
by auto
qed
-lemma (in measure_space) positive_integral_alt:
- "positive_integral f =
- (SUP g : {g. simple_function g \<and> g \<le> f}. simple_integral g)"
- apply(rule order_class.antisym) unfolding positive_integral_def
- apply(rule SUPR_subset) apply blast apply(rule SUPR_mono_lim)
-proof safe fix u assume u:"simple_function u" and uf:"u \<le> f"
- let ?u = "\<lambda>n x. if u x = \<omega> then Real (real (n::nat)) else u x"
- have su:"\<And>n. simple_function (?u n)" using simple_function_compose1[OF u] .
- show "\<exists>b. \<forall>n. b n \<in> {g. simple_function g \<and> g \<le> f \<and> \<omega> \<notin> g ` space M} \<and>
- (\<lambda>n. simple_integral (b n)) ----> simple_integral u"
- apply(rule_tac x="?u" in exI, safe) apply(rule su)
- proof- fix n::nat have "?u n \<le> u" unfolding le_fun_def by auto
- also note uf finally show "?u n \<le> f" .
- let ?s = "{x \<in> space M. u x = \<omega>}"
- show "(\<lambda>n. simple_integral (?u n)) ----> simple_integral u"
- proof(cases "\<mu> ?s = 0")
- case True have *:"\<And>n. {x\<in>space M. ?u n x \<noteq> u x} = {x\<in>space M. u x = \<omega>}" by auto
- have *:"\<And>n. simple_integral (?u n) = simple_integral u"
- apply(rule simple_integral_cong'[OF su u]) unfolding * True ..
- show ?thesis unfolding * by auto
- next case False note m0=this
- have s:"{x \<in> space M. u x = \<omega>} \<in> sets M" using u by (auto simp: borel_measurable_simple_function)
- have "\<omega> = simple_integral (\<lambda>x. \<omega> * indicator {x\<in>space M. u x = \<omega>} x)"
- apply(subst simple_integral_mult) using s
- unfolding simple_integral_indicator_only[OF s] using False by auto
- also have "... \<le> simple_integral u"
- apply (rule simple_integral_mono)
- apply (rule simple_function_mult)
- apply (rule simple_function_const)
- apply(rule ) prefer 3 apply(subst indicator_def)
- using s u by auto
- finally have *:"simple_integral u = \<omega>" by auto
- show ?thesis unfolding * Lim_omega_pos
- proof safe case goal1
- from real_arch_simple[of "B / real (\<mu> ?s)"] guess N0 .. note N=this
- def N \<equiv> "Suc N0" have N:"real N \<ge> B / real (\<mu> ?s)" "N > 0"
- unfolding N_def using N by auto
- show ?case apply-apply(rule_tac x=N in exI,safe)
- proof- case goal1
- have "Real B \<le> Real (real N) * \<mu> ?s"
- proof(cases "\<mu> ?s = \<omega>")
- case True thus ?thesis using `B>0` N by auto
- next case False
- have *:"B \<le> real N * real (\<mu> ?s)"
- using N(1) apply-apply(subst (asm) pos_divide_le_eq)
- apply rule using m0 False by auto
- show ?thesis apply(subst Real_real'[THEN sym,OF False])
- apply(subst pinfreal_times,subst if_P) defer
- apply(subst pinfreal_less_eq,subst if_P) defer
- using * N `B>0` by(auto intro: mult_nonneg_nonneg)
- qed
- also have "... \<le> Real (real n) * \<mu> ?s"
- apply(rule mult_right_mono) using goal1 by auto
- also have "... = simple_integral (\<lambda>x. Real (real n) * indicator ?s x)"
- apply(subst simple_integral_mult) apply(rule simple_function_indicator[OF s])
- unfolding simple_integral_indicator_only[OF s] ..
- also have "... \<le> simple_integral (\<lambda>x. if u x = \<omega> then Real (real n) else u x)"
- apply(rule simple_integral_mono) apply(rule simple_function_mult)
- apply(rule simple_function_const)
- apply(rule simple_function_indicator) apply(rule s su)+ by auto
- finally show ?case .
- qed qed qed
- fix x assume x:"\<omega> = (if u x = \<omega> then Real (real n) else u x)" "x \<in> space M"
- hence "u x = \<omega>" apply-apply(rule ccontr) by auto
- hence "\<omega> = Real (real n)" using x by auto
- thus False by auto
- qed
-qed
-
lemma (in measure_space) positive_integral_cong:
assumes "\<And>x. x \<in> space M \<Longrightarrow> f x = g x"
shows "positive_integral f = positive_integral g"
@@ -853,7 +949,7 @@
lemma (in measure_space) positive_integral_eq_simple_integral:
assumes "simple_function f"
shows "positive_integral f = simple_integral f"
- unfolding positive_integral_alt
+ unfolding positive_integral_def
proof (safe intro!: pinfreal_SUPI)
fix g assume "simple_function g" "g \<le> f"
with assms show "simple_integral g \<le> simple_integral f"
@@ -863,15 +959,126 @@
with assms show "simple_integral f \<le> y" by auto
qed
-lemma (in measure_space) positive_integral_mono:
- assumes mono: "\<And>x. x \<in> space M \<Longrightarrow> u x \<le> v x"
+lemma (in measure_space) positive_integral_mono_AE:
+ assumes ae: "AE x. u x \<le> v x"
shows "positive_integral u \<le> positive_integral v"
unfolding positive_integral_alt1
proof (safe intro!: SUPR_mono)
- fix a assume a: "simple_function a" and "\<forall>x\<in>space M. a x \<le> u x \<and> a x \<noteq> \<omega>"
- with mono have "\<forall>x\<in>space M. a x \<le> v x \<and> a x \<noteq> \<omega>" by fastsimp
- with a show "\<exists>b\<in>{g. simple_function g \<and> (\<forall>x\<in>space M. g x \<le> v x \<and> g x \<noteq> \<omega>)}. simple_integral a \<le> simple_integral b"
- by (auto intro!: bexI[of _ a])
+ fix a assume a: "simple_function a" and mono: "\<forall>x\<in>space M. a x \<le> u x \<and> a x \<noteq> \<omega>"
+ from ae obtain N where N: "{x\<in>space M. \<not> u x \<le> v x} \<subseteq> N" "N \<in> sets M" "\<mu> N = 0"
+ by (auto elim!: AE_E)
+ have "simple_function (\<lambda>x. a x * indicator (space M - N) x)"
+ using `N \<in> sets M` a by auto
+ with a show "\<exists>b\<in>{g. simple_function g \<and> (\<forall>x\<in>space M. g x \<le> v x \<and> g x \<noteq> \<omega>)}.
+ simple_integral a \<le> simple_integral b"
+ proof (safe intro!: bexI[of _ "\<lambda>x. a x * indicator (space M - N) x"]
+ simple_integral_mono_AE)
+ show "AE x. a x \<le> a x * indicator (space M - N) x"
+ proof (rule AE_I, rule subset_refl)
+ have *: "{x \<in> space M. \<not> a x \<le> a x * indicator (space M - N) x} =
+ N \<inter> {x \<in> space M. a x \<noteq> 0}" (is "?N = _")
+ using `N \<in> sets M`[THEN sets_into_space] by (auto simp: indicator_def)
+ then show "?N \<in> sets M"
+ using `N \<in> sets M` `simple_function a`[THEN borel_measurable_simple_function]
+ by (auto intro!: measure_mono Int)
+ then have "\<mu> ?N \<le> \<mu> N"
+ unfolding * using `N \<in> sets M` by (auto intro!: measure_mono)
+ then show "\<mu> ?N = 0" using `\<mu> N = 0` by auto
+ qed
+ next
+ fix x assume "x \<in> space M"
+ show "a x * indicator (space M - N) x \<le> v x"
+ proof (cases "x \<in> N")
+ case True then show ?thesis by simp
+ next
+ case False
+ with N mono have "a x \<le> u x" "u x \<le> v x" using `x \<in> space M` by auto
+ with False `x \<in> space M` show "a x * indicator (space M - N) x \<le> v x" by auto
+ qed
+ assume "a x * indicator (space M - N) x = \<omega>"
+ with mono `x \<in> space M` show False
+ by (simp split: split_if_asm add: indicator_def)
+ qed
+qed
+
+lemma (in measure_space) positive_integral_cong_AE:
+ "AE x. u x = v x \<Longrightarrow> positive_integral u = positive_integral v"
+ by (auto simp: eq_iff intro!: positive_integral_mono_AE)
+
+lemma (in measure_space) positive_integral_mono:
+ assumes mono: "\<And>x. x \<in> space M \<Longrightarrow> u x \<le> v x"
+ shows "positive_integral u \<le> positive_integral v"
+ using mono by (auto intro!: AE_cong positive_integral_mono_AE)
+
+lemma image_set_cong:
+ assumes A: "\<And>x. x \<in> A \<Longrightarrow> \<exists>y\<in>B. f x = g y"
+ assumes B: "\<And>y. y \<in> B \<Longrightarrow> \<exists>x\<in>A. g y = f x"
+ shows "f ` A = g ` B"
+ using assms by blast
+
+lemma (in measure_space) positive_integral_vimage:
+ fixes g :: "'a \<Rightarrow> pinfreal" and f :: "'d \<Rightarrow> 'a"
+ assumes f: "bij_betw f S (space M)"
+ shows "positive_integral g =
+ measure_space.positive_integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>x. g (f x))"
+ (is "_ = measure_space.positive_integral ?T ?\<mu> _")
+proof -
+ from f interpret T: measure_space ?T ?\<mu> by (rule measure_space_isomorphic)
+ have f_fun: "f \<in> S \<rightarrow> space M" using assms unfolding bij_betw_def by auto
+ from assms have inv: "bij_betw (the_inv_into S f) (space M) S"
+ by (rule bij_betw_the_inv_into)
+ then have inv_fun: "the_inv_into S f \<in> space M \<rightarrow> S" unfolding bij_betw_def by auto
+ have surj: "f`S = space M"
+ using f unfolding bij_betw_def by simp
+ have inj: "inj_on f S"
+ using f unfolding bij_betw_def by simp
+ have inv_f: "\<And>x. x \<in> space M \<Longrightarrow> f (the_inv_into S f x) = x"
+ using f_the_inv_into_f[of f S] f unfolding bij_betw_def by auto
+ from simple_integral_vimage[OF assms, symmetric]
+ have *: "simple_integral = T.simple_integral \<circ> (\<lambda>g. g \<circ> f)" by (simp add: comp_def)
+ show ?thesis
+ unfolding positive_integral_alt1 T.positive_integral_alt1 SUPR_def * image_compose
+ proof (safe intro!: arg_cong[where f=Sup] image_set_cong, simp_all add: comp_def)
+ fix g' :: "'a \<Rightarrow> pinfreal" assume "simple_function g'" "\<forall>x\<in>space M. g' x \<le> g x \<and> g' x \<noteq> \<omega>"
+ then show "\<exists>h. T.simple_function h \<and> (\<forall>x\<in>S. h x \<le> g (f x) \<and> h x \<noteq> \<omega>) \<and>
+ T.simple_integral (\<lambda>x. g' (f x)) = T.simple_integral h"
+ using f unfolding bij_betw_def
+ by (auto intro!: exI[of _ "\<lambda>x. g' (f x)"]
+ simp add: le_fun_def simple_function_vimage[OF _ f_fun])
+ next
+ fix g' :: "'d \<Rightarrow> pinfreal" assume g': "T.simple_function g'" "\<forall>x\<in>S. g' x \<le> g (f x) \<and> g' x \<noteq> \<omega>"
+ let ?g = "\<lambda>x. g' (the_inv_into S f x)"
+ show "\<exists>h. simple_function h \<and> (\<forall>x\<in>space M. h x \<le> g x \<and> h x \<noteq> \<omega>) \<and>
+ T.simple_integral g' = T.simple_integral (\<lambda>x. h (f x))"
+ proof (intro exI[of _ ?g] conjI ballI)
+ { fix x assume x: "x \<in> space M"
+ then have "the_inv_into S f x \<in> S" using inv_fun by auto
+ with g' have "g' (the_inv_into S f x) \<le> g (f (the_inv_into S f x)) \<and> g' (the_inv_into S f x) \<noteq> \<omega>"
+ by auto
+ then show "g' (the_inv_into S f x) \<le> g x" "g' (the_inv_into S f x) \<noteq> \<omega>"
+ using f_the_inv_into_f[of f S x] x f unfolding bij_betw_def by auto }
+ note vimage_vimage_inv[OF f inv_f inv_fun, simp]
+ from T.simple_function_vimage[OF g'(1), unfolded space_vimage_algebra, OF inv_fun]
+ show "simple_function (\<lambda>x. g' (the_inv_into S f x))"
+ unfolding simple_function_def by (simp add: simple_function_def)
+ show "T.simple_integral g' = T.simple_integral (\<lambda>x. ?g (f x))"
+ using the_inv_into_f_f[OF inj] by (auto intro!: T.simple_integral_cong)
+ qed
+ qed
+qed
+
+lemma (in measure_space) positive_integral_vimage_inv:
+ fixes g :: "'d \<Rightarrow> pinfreal" and f :: "'d \<Rightarrow> 'a"
+ assumes f: "bij_betw f S (space M)"
+ shows "measure_space.positive_integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) g =
+ positive_integral (\<lambda>x. g (the_inv_into S f x))"
+proof -
+ interpret v: measure_space "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
+ using f by (rule measure_space_isomorphic)
+ show ?thesis
+ unfolding positive_integral_vimage[OF f, of "\<lambda>x. g (the_inv_into S f x)"]
+ using f[unfolded bij_betw_def]
+ by (auto intro!: v.positive_integral_cong simp: the_inv_into_f_f)
qed
lemma (in measure_space) positive_integral_SUP_approx:
@@ -901,26 +1108,25 @@
have u: "\<And>x. x \<in> space M \<Longrightarrow> u -` {u x} \<inter> space M \<in> sets M"
using `simple_function u` by (auto simp add: simple_function_def)
- { fix i
- have "(\<lambda>n. (u -` {i} \<inter> space M) \<inter> ?B n) \<up> (u -` {i} \<inter> space M)" using B_mono unfolding isoton_def
- proof safe
- fix x assume "x \<in> space M"
- show "x \<in> (\<Union>i. (u -` {u x} \<inter> space M) \<inter> ?B i)"
- proof cases
- assume "u x = 0" thus ?thesis using `x \<in> space M` by simp
- next
- assume "u x \<noteq> 0"
- with `a < 1` real `x \<in> space M`
- have "a * u x < 1 * u x" by (rule_tac pinfreal_mult_strict_right_mono) (auto simp: image_iff)
- also have "\<dots> \<le> (SUP i. f i x)" using le `f \<up> s`
- unfolding isoton_fun_expand by (auto simp: isoton_def le_fun_def)
- finally obtain i where "a * u x < f i x" unfolding SUPR_def
- by (auto simp add: less_Sup_iff)
- hence "a * u x \<le> f i x" by auto
- thus ?thesis using `x \<in> space M` by auto
- qed
- qed auto }
- note measure_conv = measure_up[OF u Int[OF u B] this]
+ have "\<And>i. (\<lambda>n. (u -` {i} \<inter> space M) \<inter> ?B n) \<up> (u -` {i} \<inter> space M)" using B_mono unfolding isoton_def
+ proof safe
+ fix x i assume "x \<in> space M"
+ show "x \<in> (\<Union>i. (u -` {u x} \<inter> space M) \<inter> ?B i)"
+ proof cases
+ assume "u x = 0" thus ?thesis using `x \<in> space M` by simp
+ next
+ assume "u x \<noteq> 0"
+ with `a < 1` real `x \<in> space M`
+ have "a * u x < 1 * u x" by (rule_tac pinfreal_mult_strict_right_mono) (auto simp: image_iff)
+ also have "\<dots> \<le> (SUP i. f i x)" using le `f \<up> s`
+ unfolding isoton_fun_expand by (auto simp: isoton_def le_fun_def)
+ finally obtain i where "a * u x < f i x" unfolding SUPR_def
+ by (auto simp add: less_Sup_iff)
+ hence "a * u x \<le> f i x" by auto
+ thus ?thesis using `x \<in> space M` by auto
+ qed
+ qed auto
+ note measure_conv = measure_up[OF Int[OF u B] this]
have "simple_integral u = (SUP i. simple_integral (?uB i))"
unfolding simple_integral_indicator[OF B `simple_function u`]
@@ -981,11 +1187,39 @@
by (auto intro!: SUP_leI positive_integral_mono)
next
show "positive_integral u \<le> (SUP i. positive_integral (f i))"
- unfolding positive_integral_def[of u]
+ unfolding positive_integral_alt[of u]
by (auto intro!: SUP_leI positive_integral_SUP_approx[OF assms])
qed
qed
+lemma (in measure_space) positive_integral_monotone_convergence_SUP:
+ assumes "\<And>i x. x \<in> space M \<Longrightarrow> f i x \<le> f (Suc i) x"
+ assumes "\<And>i. f i \<in> borel_measurable M"
+ shows "(SUP i. positive_integral (f i)) = positive_integral (\<lambda>x. SUP i. f i x)"
+ (is "_ = positive_integral ?u")
+proof -
+ have "?u \<in> borel_measurable M"
+ using borel_measurable_SUP[of _ f] assms by (simp add: SUPR_fun_expand)
+ show ?thesis
+ proof (rule antisym)
+ show "(SUP j. positive_integral (f j)) \<le> positive_integral ?u"
+ by (auto intro!: SUP_leI positive_integral_mono le_SUPI)
+ next
+ def rf \<equiv> "\<lambda>i. \<lambda>x\<in>space M. f i x" and ru \<equiv> "\<lambda>x\<in>space M. ?u x"
+ have "\<And>i. rf i \<in> borel_measurable M" unfolding rf_def
+ using assms by (simp cong: measurable_cong)
+ moreover have iso: "rf \<up> ru" using assms unfolding rf_def ru_def
+ unfolding isoton_def SUPR_fun_expand le_fun_def fun_eq_iff
+ using SUP_const[OF UNIV_not_empty]
+ by (auto simp: restrict_def le_fun_def SUPR_fun_expand fun_eq_iff)
+ ultimately have "positive_integral ru \<le> (SUP i. positive_integral (rf i))"
+ unfolding positive_integral_alt[of ru]
+ by (auto simp: le_fun_def intro!: SUP_leI positive_integral_SUP_approx)
+ then show "positive_integral ?u \<le> (SUP i. positive_integral (f i))"
+ unfolding ru_def rf_def by (simp cong: positive_integral_cong)
+ qed
+qed
+
lemma (in measure_space) SUP_simple_integral_sequences:
assumes f: "f \<up> u" "\<And>i. simple_function (f i)"
and g: "g \<up> u" "\<And>i. simple_function (g i)"
@@ -1193,47 +1427,16 @@
qed
lemma (in measure_space) positive_integral_null_set:
- assumes borel: "u \<in> borel_measurable M" and "N \<in> null_sets"
- shows "positive_integral (\<lambda>x. u x * indicator N x) = 0" (is "?I = 0")
+ assumes "N \<in> null_sets" shows "positive_integral (\<lambda>x. u x * indicator N x) = 0"
proof -
- have "N \<in> sets M" using `N \<in> null_sets` by auto
- have "(\<lambda>i x. min (of_nat i) (u x) * indicator N x) \<up> (\<lambda>x. u x * indicator N x)"
- unfolding isoton_fun_expand
- proof (safe intro!: isoton_cmult_left, unfold isoton_def, safe)
- fix j i show "min (of_nat j) (u i) \<le> min (of_nat (Suc j)) (u i)"
- by (rule min_max.inf_mono) auto
- next
- fix i show "(SUP j. min (of_nat j) (u i)) = u i"
- proof (cases "u i")
- case infinite
- moreover hence "\<And>j. min (of_nat j) (u i) = of_nat j"
- by (auto simp: min_def)
- ultimately show ?thesis by (simp add: Sup_\<omega>)
- next
- case (preal r)
- obtain j where "r \<le> of_nat j" using ex_le_of_nat ..
- hence "u i \<le> of_nat j" using preal by (auto simp: real_of_nat_def)
- show ?thesis
- proof (rule pinfreal_SUPI)
- fix y assume "\<And>j. j \<in> UNIV \<Longrightarrow> min (of_nat j) (u i) \<le> y"
- note this[of j]
- moreover have "min (of_nat j) (u i) = u i"
- using `u i \<le> of_nat j` by (auto simp: min_def)
- ultimately show "u i \<le> y" by simp
- qed simp
- qed
+ have "positive_integral (\<lambda>x. u x * indicator N x) = positive_integral (\<lambda>x. 0)"
+ proof (intro positive_integral_cong_AE AE_I)
+ show "{x \<in> space M. u x * indicator N x \<noteq> 0} \<subseteq> N"
+ by (auto simp: indicator_def)
+ show "\<mu> N = 0" "N \<in> sets M"
+ using assms by auto
qed
- from positive_integral_isoton[OF this]
- have "?I = (SUP i. positive_integral (\<lambda>x. min (of_nat i) (u x) * indicator N x))"
- unfolding isoton_def using borel `N \<in> sets M` by (simp add: borel_measurable_indicator)
- also have "\<dots> \<le> (SUP i. positive_integral (\<lambda>x. of_nat i * indicator N x))"
- proof (rule SUP_mono, rule bexI, rule positive_integral_mono)
- fix x i show "min (of_nat i) (u x) * indicator N x \<le> of_nat i * indicator N x"
- by (cases "x \<in> N") auto
- qed simp
- also have "\<dots> = 0"
- using `N \<in> null_sets` by (simp add: positive_integral_cmult_indicator)
- finally show ?thesis by simp
+ then show ?thesis by simp
qed
lemma (in measure_space) positive_integral_Markov_inequality:
@@ -1270,7 +1473,7 @@
proof
assume "\<mu> ?A = 0"
hence "?A \<in> null_sets" using `?A \<in> sets M` by auto
- from positive_integral_null_set[OF borel this]
+ from positive_integral_null_set[OF this]
have "0 = positive_integral (\<lambda>x. u x * indicator ?A x)" by simp
thus "positive_integral u = 0" unfolding u by simp
next
@@ -1309,34 +1512,6 @@
qed
qed
-lemma (in measure_space) positive_integral_cong_on_null_sets:
- assumes f: "f \<in> borel_measurable M" and g: "g \<in> borel_measurable M"
- and measure: "\<mu> {x\<in>space M. f x \<noteq> g x} = 0"
- shows "positive_integral f = positive_integral g"
-proof -
- let ?N = "{x\<in>space M. f x \<noteq> g x}" and ?E = "{x\<in>space M. f x = g x}"
- let "?A h x" = "h x * indicator ?E x :: pinfreal"
- let "?B h x" = "h x * indicator ?N x :: pinfreal"
-
- have A: "positive_integral (?A f) = positive_integral (?A g)"
- by (auto intro!: positive_integral_cong simp: indicator_def)
-
- have [intro]: "?N \<in> sets M" "?E \<in> sets M" using f g by auto
- hence "?N \<in> null_sets" using measure by auto
- hence B: "positive_integral (?B f) = positive_integral (?B g)"
- using f g by (simp add: positive_integral_null_set)
-
- have "positive_integral f = positive_integral (\<lambda>x. ?A f x + ?B f x)"
- by (auto intro!: positive_integral_cong simp: indicator_def)
- also have "\<dots> = positive_integral (?A f) + positive_integral (?B f)"
- using f g by (auto intro!: positive_integral_add borel_measurable_indicator)
- also have "\<dots> = positive_integral (\<lambda>x. ?A g x + ?B g x)"
- unfolding A B using f g by (auto intro!: positive_integral_add[symmetric] borel_measurable_indicator)
- also have "\<dots> = positive_integral g"
- by (auto intro!: positive_integral_cong simp: indicator_def)
- finally show ?thesis by simp
-qed
-
lemma (in measure_space) positive_integral_restricted:
assumes "A \<in> sets M"
shows "measure_space.positive_integral (restricted_space A) \<mu> f = positive_integral (\<lambda>x. f x * indicator A x)"
@@ -1346,27 +1521,26 @@
then interpret R: measure_space ?R \<mu> .
have saR: "sigma_algebra ?R" by fact
have *: "R.positive_integral f = R.positive_integral ?f"
- by (auto intro!: R.positive_integral_cong)
+ by (intro R.positive_integral_cong) auto
show ?thesis
unfolding * R.positive_integral_def positive_integral_def
unfolding simple_function_restricted[OF `A \<in> sets M`]
apply (simp add: SUPR_def)
apply (rule arg_cong[where f=Sup])
- proof (auto simp: image_iff simple_integral_restricted[OF `A \<in> sets M`])
+ proof (auto simp add: image_iff simple_integral_restricted[OF `A \<in> sets M`])
fix g assume "simple_function (\<lambda>x. g x * indicator A x)"
- "g \<le> f" "\<forall>x\<in>A. \<omega> \<noteq> g x"
- then show "\<exists>x. simple_function x \<and> x \<le> (\<lambda>x. f x * indicator A x) \<and> (\<forall>y\<in>space M. \<omega> \<noteq> x y) \<and>
+ "g \<le> f"
+ then show "\<exists>x. simple_function x \<and> x \<le> (\<lambda>x. f x * indicator A x) \<and>
simple_integral (\<lambda>x. g x * indicator A x) = simple_integral x"
apply (rule_tac exI[of _ "\<lambda>x. g x * indicator A x"])
by (auto simp: indicator_def le_fun_def)
next
fix g assume g: "simple_function g" "g \<le> (\<lambda>x. f x * indicator A x)"
- "\<forall>x\<in>space M. \<omega> \<noteq> g x"
then have *: "(\<lambda>x. g x * indicator A x) = g"
"\<And>x. g x * indicator A x = g x"
"\<And>x. g x \<le> f x"
by (auto simp: le_fun_def fun_eq_iff indicator_def split: split_if_asm)
- from g show "\<exists>x. simple_function (\<lambda>xa. x xa * indicator A xa) \<and> x \<le> f \<and> (\<forall>xa\<in>A. \<omega> \<noteq> x xa) \<and>
+ from g show "\<exists>x. simple_function (\<lambda>xa. x xa * indicator A xa) \<and> x \<le> f \<and>
simple_integral g = simple_integral (\<lambda>xa. x xa * indicator A xa)"
using `A \<in> sets M`[THEN sets_into_space]
apply (rule_tac exI[of _ "\<lambda>x. g x * indicator A x"])
@@ -1413,6 +1587,29 @@
shows "integral f = integral g"
using assms by (simp cong: positive_integral_cong add: integral_def)
+lemma (in measure_space) integral_cong_measure:
+ assumes "\<And>A. A \<in> sets M \<Longrightarrow> \<nu> A = \<mu> A"
+ shows "measure_space.integral M \<nu> f = integral f"
+proof -
+ interpret v: measure_space M \<nu>
+ by (rule measure_space_cong) fact
+ show ?thesis
+ unfolding integral_def v.integral_def
+ by (simp add: positive_integral_cong_measure[OF assms])
+qed
+
+lemma (in measure_space) integral_cong_AE:
+ assumes cong: "AE x. f x = g x"
+ shows "integral f = integral g"
+proof -
+ have "AE x. Real (f x) = Real (g x)"
+ using cong by (rule AE_mp) simp
+ moreover have "AE x. Real (- f x) = Real (- g x)"
+ using cong by (rule AE_mp) simp
+ ultimately show ?thesis
+ by (simp cong: positive_integral_cong_AE add: integral_def)
+qed
+
lemma (in measure_space) integrable_cong:
"(\<And>x. x \<in> space M \<Longrightarrow> f x = g x) \<Longrightarrow> integrable f \<longleftrightarrow> integrable g"
by (simp cong: positive_integral_cong measurable_cong add: integrable_def)
@@ -1425,6 +1622,23 @@
thus ?thesis by (simp del: Real_eq_0 add: integral_def)
qed
+lemma (in measure_space) integral_vimage_inv:
+ assumes f: "bij_betw f S (space M)"
+ shows "measure_space.integral (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>x. g x) = integral (\<lambda>x. g (the_inv_into S f x))"
+proof -
+ interpret v: measure_space "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
+ using f by (rule measure_space_isomorphic)
+ have "\<And>x. x \<in> space (vimage_algebra S f) \<Longrightarrow> the_inv_into S f (f x) = x"
+ using f[unfolded bij_betw_def] by (simp add: the_inv_into_f_f)
+ then have *: "v.positive_integral (\<lambda>x. Real (g (the_inv_into S f (f x)))) = v.positive_integral (\<lambda>x. Real (g x))"
+ "v.positive_integral (\<lambda>x. Real (- g (the_inv_into S f (f x)))) = v.positive_integral (\<lambda>x. Real (- g x))"
+ by (auto intro!: v.positive_integral_cong)
+ show ?thesis
+ unfolding integral_def v.integral_def
+ unfolding positive_integral_vimage[OF f]
+ by (simp add: *)
+qed
+
lemma (in measure_space) integral_minus[intro, simp]:
assumes "integrable f"
shows "integrable (\<lambda>x. - f x)" "integral (\<lambda>x. - f x) = - integral f"
@@ -1549,15 +1763,26 @@
thus ?P ?I by auto
qed
+lemma (in measure_space) integral_mono_AE:
+ assumes fg: "integrable f" "integrable g"
+ and mono: "AE t. f t \<le> g t"
+ shows "integral f \<le> integral g"
+proof -
+ have "AE x. Real (f x) \<le> Real (g x)"
+ using mono by (rule AE_mp) (auto intro!: AE_cong)
+ moreover have "AE x. Real (- g x) \<le> Real (- f x)"
+ using mono by (rule AE_mp) (auto intro!: AE_cong)
+ ultimately show ?thesis using fg
+ by (auto simp: integral_def integrable_def diff_minus
+ intro!: add_mono real_of_pinfreal_mono positive_integral_mono_AE)
+qed
+
lemma (in measure_space) integral_mono:
assumes fg: "integrable f" "integrable g"
and mono: "\<And>t. t \<in> space M \<Longrightarrow> f t \<le> g t"
shows "integral f \<le> integral g"
- using fg unfolding integral_def integrable_def diff_minus
-proof (safe intro!: add_mono real_of_pinfreal_mono le_imp_neg_le positive_integral_mono)
- fix x assume "x \<in> space M" from mono[OF this]
- show "Real (f x) \<le> Real (g x)" "Real (- g x) \<le> Real (- f x)" by auto
-qed
+ apply (rule integral_mono_AE[OF fg])
+ using mono by (rule AE_cong) auto
lemma (in measure_space) integral_diff[simp, intro]:
assumes f: "integrable f" and g: "integrable g"
@@ -1796,6 +2021,29 @@
by (simp add: real_of_pinfreal_eq_0)
qed
+lemma (in measure_space) positive_integral_omega:
+ assumes "f \<in> borel_measurable M"
+ and "positive_integral f \<noteq> \<omega>"
+ shows "\<mu> (f -` {\<omega>} \<inter> space M) = 0"
+proof -
+ have "\<omega> * \<mu> (f -` {\<omega>} \<inter> space M) = positive_integral (\<lambda>x. \<omega> * indicator (f -` {\<omega>} \<inter> space M) x)"
+ using positive_integral_cmult_indicator[OF borel_measurable_vimage, OF assms(1), of \<omega> \<omega>] by simp
+ also have "\<dots> \<le> positive_integral f"
+ by (auto intro!: positive_integral_mono simp: indicator_def)
+ finally show ?thesis
+ using assms(2) by (cases ?thesis) auto
+qed
+
+lemma (in measure_space) simple_integral_omega:
+ assumes "simple_function f"
+ and "simple_integral f \<noteq> \<omega>"
+ shows "\<mu> (f -` {\<omega>} \<inter> space M) = 0"
+proof (rule positive_integral_omega)
+ show "f \<in> borel_measurable M" using assms by (auto intro: borel_measurable_simple_function)
+ show "positive_integral f \<noteq> \<omega>"
+ using assms by (simp add: positive_integral_eq_simple_integral)
+qed
+
lemma (in measure_space) integral_dominated_convergence:
assumes u: "\<And>i. integrable (u i)" and bound: "\<And>x j. x\<in>space M \<Longrightarrow> \<bar>u j x\<bar> \<le> w x"
and w: "integrable w" "\<And>x. x \<in> space M \<Longrightarrow> 0 \<le> w x"
@@ -2056,7 +2304,7 @@
qed
lemma (in finite_measure_space) simple_function_finite[simp, intro]: "simple_function f"
- unfolding simple_function_def sets_eq_Pow using finite_space by auto
+ unfolding simple_function_def using finite_space by auto
lemma (in finite_measure_space) borel_measurable_finite[intro, simp]: "f \<in> borel_measurable M"
by (auto intro: borel_measurable_simple_function)
@@ -2067,7 +2315,7 @@
have *: "positive_integral f = positive_integral (\<lambda>x. \<Sum>y\<in>space M. f y * indicator {y} x)"
by (auto intro!: positive_integral_cong simp add: indicator_def if_distrib setsum_cases[OF finite_space])
show ?thesis unfolding * using borel_measurable_finite[of f]
- by (simp add: positive_integral_setsum positive_integral_cmult_indicator sets_eq_Pow)
+ by (simp add: positive_integral_setsum positive_integral_cmult_indicator)
qed
lemma (in finite_measure_space) integral_finite_singleton:
@@ -2079,9 +2327,9 @@
"positive_integral (\<lambda>x. Real (- f x)) = (\<Sum>x \<in> space M. Real (- f x) * \<mu> {x})"
unfolding positive_integral_finite_eq_setsum by auto
show "integrable f" using finite_space finite_measure
- by (simp add: setsum_\<omega> integrable_def sets_eq_Pow)
+ by (simp add: setsum_\<omega> integrable_def)
show ?I using finite_measure
- apply (simp add: integral_def sets_eq_Pow real_of_pinfreal_setsum[symmetric]
+ apply (simp add: integral_def real_of_pinfreal_setsum[symmetric]
real_of_pinfreal_mult[symmetric] setsum_subtractf[symmetric])
by (rule setsum_cong) (simp_all split: split_if)
qed
--- a/src/HOL/Probability/Lebesgue_Measure.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Lebesgue_Measure.thy Thu Dec 02 11:18:44 2010 -0800
@@ -1,38 +1,32 @@
-
+(* Author: Robert Himmelmann, TU Muenchen *)
header {* Lebsegue measure *}
-(* Author: Robert Himmelmann, TU Muenchen *)
-
theory Lebesgue_Measure
- imports Gauge_Measure Measure Lebesgue_Integration
+ imports Product_Measure Gauge_Measure Complete_Measure
begin
-subsection {* Various *}
-
-lemma seq_offset_iff:"f ----> l \<longleftrightarrow> (\<lambda>i. f (i + k)) ----> l"
- using seq_offset_rev seq_offset[of f l k] by auto
-
-lemma has_integral_disjoint_union: fixes f::"'n::ordered_euclidean_space \<Rightarrow> 'a::banach"
- assumes "(f has_integral i) s" "(f has_integral j) t" "s \<inter> t = {}"
- shows "(f has_integral (i + j)) (s \<union> t)"
- apply(rule has_integral_union[OF assms(1-2)]) unfolding assms by auto
-
-lemma lim_eq: assumes "\<forall>n>N. f n = g n" shows "(f ----> l) \<longleftrightarrow> (g ----> l)" using assms
-proof(induct N arbitrary: f g) case 0
- hence *:"\<And>n. f (Suc n) = g (Suc n)" by auto
- show ?case apply(subst LIMSEQ_Suc_iff[THEN sym]) apply(subst(2) LIMSEQ_Suc_iff[THEN sym])
- unfolding * ..
-next case (Suc n)
- show ?case apply(subst LIMSEQ_Suc_iff[THEN sym]) apply(subst(2) LIMSEQ_Suc_iff[THEN sym])
- apply(rule Suc(1)) using Suc(2) by auto
-qed
-
subsection {* Standard Cubes *}
-definition cube where
- "cube (n::nat) \<equiv> {\<chi>\<chi> i. - real n .. (\<chi>\<chi> i. real n)::_::ordered_euclidean_space}"
+definition cube :: "nat \<Rightarrow> 'a::ordered_euclidean_space set" where
+ "cube n \<equiv> {\<chi>\<chi> i. - real n .. \<chi>\<chi> i. real n}"
+
+lemma cube_closed[intro]: "closed (cube n)"
+ unfolding cube_def by auto
+
+lemma cube_subset[intro]: "n \<le> N \<Longrightarrow> cube n \<subseteq> cube N"
+ by (fastsimp simp: eucl_le[where 'a='a] cube_def)
-lemma cube_subset[intro]:"n\<le>N \<Longrightarrow> cube n \<subseteq> (cube N::'a::ordered_euclidean_space set)"
- apply(auto simp: eucl_le[where 'a='a] cube_def) apply(erule_tac[!] x=i in allE)+ by auto
+lemma cube_subset_iff:
+ "cube n \<subseteq> cube N \<longleftrightarrow> n \<le> N"
+proof
+ assume subset: "cube n \<subseteq> (cube N::'a set)"
+ then have "((\<chi>\<chi> i. real n)::'a) \<in> cube N"
+ using DIM_positive[where 'a='a]
+ by (fastsimp simp: cube_def eucl_le[where 'a='a])
+ then show "n \<le> N"
+ by (fastsimp simp: cube_def eucl_le[where 'a='a])
+next
+ assume "n \<le> N" then show "cube n \<subseteq> (cube N::'a set)" by (rule cube_subset)
+qed
lemma ball_subset_cube:"ball (0::'a::ordered_euclidean_space) (real n) \<subseteq> cube n"
unfolding cube_def subset_eq mem_interval apply safe unfolding euclidean_lambda_beta'
@@ -63,202 +57,277 @@
apply(rule has_gmeasure_subset[of "s\<inter>cube n" _ "cube n"])
unfolding has_gmeasure_measure[THEN sym] using assms by auto
+lemma has_gmeasure_cube[intro]: "(cube n::('a::ordered_euclidean_space) set)
+ has_gmeasure ((2 * real n) ^ (DIM('a)))"
+proof-
+ have "content {\<chi>\<chi> i. - real n..(\<chi>\<chi> i. real n)::'a} = (2 * real n) ^ (DIM('a))"
+ apply(subst content_closed_interval) defer
+ by (auto simp add:setprod_constant)
+ thus ?thesis unfolding cube_def
+ using has_gmeasure_interval(1)[of "(\<chi>\<chi> i. - real n)::'a" "(\<chi>\<chi> i. real n)::'a"]
+ by auto
+qed
+
+lemma gmeasure_cube_eq[simp]:
+ "gmeasure (cube n::('a::ordered_euclidean_space) set) = (2 * real n) ^ DIM('a)"
+ by (intro measure_unique) auto
+
+lemma gmeasure_cube_ge_n: "gmeasure (cube n::('a::ordered_euclidean_space) set) \<ge> real n"
+proof cases
+ assume "n = 0" then show ?thesis by simp
+next
+ assume "n \<noteq> 0"
+ have "real n \<le> (2 * real n)^1" by simp
+ also have "\<dots> \<le> (2 * real n)^DIM('a)"
+ using DIM_positive[where 'a='a] `n \<noteq> 0`
+ by (intro power_increasing) auto
+ also have "\<dots> = gmeasure (cube n::'a set)" by simp
+ finally show ?thesis .
+qed
+
+lemma gmeasure_setsum:
+ assumes "finite A" and "\<And>s t. s \<in> A \<Longrightarrow> t \<in> A \<Longrightarrow> s \<noteq> t \<Longrightarrow> f s \<inter> f t = {}"
+ and "\<And>i. i \<in> A \<Longrightarrow> gmeasurable (f i)"
+ shows "gmeasure (\<Union>i\<in>A. f i) = (\<Sum>i\<in>A. gmeasure (f i))"
+proof -
+ have "gmeasure (\<Union>i\<in>A. f i) = gmeasure (\<Union>f ` A)" by auto
+ also have "\<dots> = setsum gmeasure (f ` A)" using assms
+ proof (intro measure_negligible_unions)
+ fix X Y assume "X \<in> f`A" "Y \<in> f`A" "X \<noteq> Y"
+ then have "X \<inter> Y = {}" using assms by auto
+ then show "negligible (X \<inter> Y)" by auto
+ qed auto
+ also have "\<dots> = setsum gmeasure (f ` A - {{}})"
+ using assms by (intro setsum_mono_zero_cong_right) auto
+ also have "\<dots> = (\<Sum>i\<in>A - {i. f i = {}}. gmeasure (f i))"
+ proof (intro setsum_reindex_cong inj_onI)
+ fix s t assume *: "s \<in> A - {i. f i = {}}" "t \<in> A - {i. f i = {}}" "f s = f t"
+ show "s = t"
+ proof (rule ccontr)
+ assume "s \<noteq> t" with assms(2)[of s t] * show False by auto
+ qed
+ qed auto
+ also have "\<dots> = (\<Sum>i\<in>A. gmeasure (f i))"
+ using assms by (intro setsum_mono_zero_cong_left) auto
+ finally show ?thesis .
+qed
+
+lemma gmeasurable_finite_UNION[intro]:
+ assumes "\<And>i. i \<in> S \<Longrightarrow> gmeasurable (A i)" "finite S"
+ shows "gmeasurable (\<Union>i\<in>S. A i)"
+ unfolding UNION_eq_Union_image using assms
+ by (intro gmeasurable_finite_unions) auto
+
+lemma gmeasurable_countable_UNION[intro]:
+ fixes A :: "nat \<Rightarrow> ('a::ordered_euclidean_space) set"
+ assumes measurable: "\<And>i. gmeasurable (A i)"
+ and finite: "\<And>n. gmeasure (UNION {.. n} A) \<le> B"
+ shows "gmeasurable (\<Union>i. A i)"
+proof -
+ have *: "\<And>n. \<Union>{A k |k. k \<le> n} = (\<Union>i\<le>n. A i)"
+ "(\<Union>{A n |n. n \<in> UNIV}) = (\<Union>i. A i)" by auto
+ show ?thesis
+ by (rule gmeasurable_countable_unions_strong[of A B, unfolded *, OF assms])
+qed
subsection {* Measurability *}
-definition lmeasurable :: "('a::ordered_euclidean_space) set => bool" where
- "lmeasurable s \<equiv> (\<forall>n::nat. gmeasurable (s \<inter> cube n))"
+definition lebesgue :: "'a::ordered_euclidean_space algebra" where
+ "lebesgue = \<lparr> space = UNIV, sets = {A. \<forall>n. gmeasurable (A \<inter> cube n)} \<rparr>"
+
+lemma space_lebesgue[simp]:"space lebesgue = UNIV"
+ unfolding lebesgue_def by auto
-lemma lmeasurableD[dest]:assumes "lmeasurable s"
- shows "\<And>n. gmeasurable (s \<inter> cube n)"
- using assms unfolding lmeasurable_def by auto
+lemma lebesgueD[dest]: assumes "S \<in> sets lebesgue"
+ shows "\<And>n. gmeasurable (S \<inter> cube n)"
+ using assms unfolding lebesgue_def by auto
-lemma measurable_imp_lmeasurable: assumes"gmeasurable s"
- shows "lmeasurable s" unfolding lmeasurable_def cube_def
+lemma lebesgueI[intro]: assumes "gmeasurable S"
+ shows "S \<in> sets lebesgue" unfolding lebesgue_def cube_def
using assms gmeasurable_interval by auto
-lemma lmeasurable_empty[intro]: "lmeasurable {}"
- using gmeasurable_empty apply- apply(drule_tac measurable_imp_lmeasurable) .
-
-lemma lmeasurable_union[intro]: assumes "lmeasurable s" "lmeasurable t"
- shows "lmeasurable (s \<union> t)"
- using assms unfolding lmeasurable_def Int_Un_distrib2
- by(auto intro:gmeasurable_union)
+lemma lebesgueI2: "(\<And>n. gmeasurable (S \<inter> cube n)) \<Longrightarrow> S \<in> sets lebesgue"
+ using assms unfolding lebesgue_def by auto
-lemma lmeasurable_countable_unions_strong:
- fixes s::"nat => 'a::ordered_euclidean_space set"
- assumes "\<And>n::nat. lmeasurable(s n)"
- shows "lmeasurable(\<Union>{ s(n) |n. n \<in> UNIV })"
- unfolding lmeasurable_def
-proof fix n::nat
- have *:"\<Union>{s n |n. n \<in> UNIV} \<inter> cube n = \<Union>{s k \<inter> cube n |k. k \<in> UNIV}" by auto
- show "gmeasurable (\<Union>{s n |n. n \<in> UNIV} \<inter> cube n)" unfolding *
- apply(rule gmeasurable_countable_unions_strong)
- apply(rule assms[unfolded lmeasurable_def,rule_format])
- proof- fix k::nat
- show "gmeasure (\<Union>{s ka \<inter> cube n |ka. ka \<le> k}) \<le> gmeasure (cube n::'a set)"
- apply(rule measure_subset) apply(rule gmeasurable_finite_unions)
- using assms(1)[unfolded lmeasurable_def] by auto
- qed
+interpretation lebesgue: sigma_algebra lebesgue
+proof
+ show "sets lebesgue \<subseteq> Pow (space lebesgue)"
+ unfolding lebesgue_def by auto
+ show "{} \<in> sets lebesgue"
+ using gmeasurable_empty by auto
+ { fix A B :: "'a set" assume "A \<in> sets lebesgue" "B \<in> sets lebesgue"
+ then show "A \<union> B \<in> sets lebesgue"
+ by (auto intro: gmeasurable_union simp: lebesgue_def Int_Un_distrib2) }
+ { fix A :: "nat \<Rightarrow> 'a set" assume A: "range A \<subseteq> sets lebesgue"
+ show "(\<Union>i. A i) \<in> sets lebesgue"
+ proof (rule lebesgueI2)
+ fix n show "gmeasurable ((\<Union>i. A i) \<inter> cube n)" unfolding UN_extend_simps
+ using A
+ by (intro gmeasurable_countable_UNION[where B="gmeasure (cube n::'a set)"])
+ (auto intro!: measure_subset gmeasure_setsum simp: UN_extend_simps simp del: gmeasure_cube_eq UN_simps)
+ qed }
+ { fix A assume A: "A \<in> sets lebesgue" show "space lebesgue - A \<in> sets lebesgue"
+ proof (rule lebesgueI2)
+ fix n
+ have *: "(space lebesgue - A) \<inter> cube n = cube n - (A \<inter> cube n)"
+ unfolding lebesgue_def by auto
+ show "gmeasurable ((space lebesgue - A) \<inter> cube n)" unfolding *
+ using A by (auto intro!: gmeasurable_diff)
+ qed }
qed
-lemma lmeasurable_inter[intro]: fixes s::"'a :: ordered_euclidean_space set"
- assumes "lmeasurable s" "lmeasurable t" shows "lmeasurable (s \<inter> t)"
- unfolding lmeasurable_def
-proof fix n::nat
- have *:"s \<inter> t \<inter> cube n = (s \<inter> cube n) \<inter> (t \<inter> cube n)" by auto
- show "gmeasurable (s \<inter> t \<inter> cube n)"
- using assms unfolding lmeasurable_def *
- using gmeasurable_inter[of "s \<inter> cube n" "t \<inter> cube n"] by auto
+lemma lebesgueI_borel[intro, simp]: fixes s::"'a::ordered_euclidean_space set"
+ assumes "s \<in> sets borel" shows "s \<in> sets lebesgue"
+proof- let ?S = "range (\<lambda>(a, b). {a .. (b :: 'a\<Colon>ordered_euclidean_space)})"
+ have *:"?S \<subseteq> sets lebesgue" by auto
+ have "s \<in> sigma_sets UNIV ?S" using assms
+ unfolding borel_eq_atLeastAtMost by (simp add: sigma_def)
+ thus ?thesis
+ using lebesgue.sigma_subset[of "\<lparr> space = UNIV, sets = ?S\<rparr>", simplified, OF *]
+ by (auto simp: sigma_def)
qed
-lemma lmeasurable_complement[intro]: assumes "lmeasurable s"
- shows "lmeasurable (UNIV - s)"
- unfolding lmeasurable_def
-proof fix n::nat
- have *:"(UNIV - s) \<inter> cube n = cube n - (s \<inter> cube n)" by auto
- show "gmeasurable ((UNIV - s) \<inter> cube n)" unfolding *
- apply(rule gmeasurable_diff) using assms unfolding lmeasurable_def by auto
-qed
-
-lemma lmeasurable_finite_unions:
- assumes "finite f" "\<And>s. s \<in> f \<Longrightarrow> lmeasurable s"
- shows "lmeasurable (\<Union> f)" unfolding lmeasurable_def
-proof fix n::nat have *:"(\<Union>f \<inter> cube n) = \<Union>{x \<inter> cube n | x . x\<in>f}" by auto
- show "gmeasurable (\<Union>f \<inter> cube n)" unfolding *
- apply(rule gmeasurable_finite_unions) unfolding simple_image
- using assms unfolding lmeasurable_def by auto
-qed
-
-lemma negligible_imp_lmeasurable[dest]: fixes s::"'a::ordered_euclidean_space set"
- assumes "negligible s" shows "lmeasurable s"
- unfolding lmeasurable_def
-proof case goal1
+lemma lebesgueI_negligible[dest]: fixes s::"'a::ordered_euclidean_space set"
+ assumes "negligible s" shows "s \<in> sets lebesgue"
+proof (rule lebesgueI2)
+ fix n
have *:"\<And>x. (if x \<in> cube n then indicator s x else 0) = (if x \<in> s \<inter> cube n then 1 else 0)"
unfolding indicator_def_raw by auto
note assms[unfolded negligible_def,rule_format,of "(\<chi>\<chi> i. - real n)::'a" "\<chi>\<chi> i. real n"]
- thus ?case apply-apply(rule gmeasurableI[of _ 0]) unfolding has_gmeasure_def
+ thus "gmeasurable (s \<inter> cube n)" apply-apply(rule gmeasurableI[of _ 0]) unfolding has_gmeasure_def
apply(subst(asm) has_integral_restrict_univ[THEN sym]) unfolding cube_def[symmetric]
apply(subst has_integral_restrict_univ[THEN sym]) unfolding * .
qed
-
section {* The Lebesgue Measure *}
-definition has_lmeasure (infixr "has'_lmeasure" 80) where
- "s has_lmeasure m \<equiv> lmeasurable s \<and> ((\<lambda>n. Real (gmeasure (s \<inter> cube n))) ---> m) sequentially"
+definition "lmeasure A = (SUP n. Real (gmeasure (A \<inter> cube n)))"
-lemma has_lmeasureD: assumes "s has_lmeasure m"
- shows "lmeasurable s" "gmeasurable (s \<inter> cube n)"
- "((\<lambda>n. Real (gmeasure (s \<inter> cube n))) ---> m) sequentially"
- using assms unfolding has_lmeasure_def lmeasurable_def by auto
+lemma lmeasure_eq_0: assumes "negligible S" shows "lmeasure S = 0"
+proof -
+ from lebesgueI_negligible[OF assms]
+ have "\<And>n. gmeasurable (S \<inter> cube n)" by auto
+ from gmeasurable_measure_eq_0[OF this]
+ have "\<And>n. gmeasure (S \<inter> cube n) = 0" using assms by auto
+ then show ?thesis unfolding lmeasure_def by simp
+qed
+
+lemma lmeasure_iff_LIMSEQ:
+ assumes "A \<in> sets lebesgue" "0 \<le> m"
+ shows "lmeasure A = Real m \<longleftrightarrow> (\<lambda>n. (gmeasure (A \<inter> cube n))) ----> m"
+ unfolding lmeasure_def using assms cube_subset[where 'a='a]
+ by (intro SUP_eq_LIMSEQ monoI measure_subset) force+
-lemma has_lmeasureI: assumes "lmeasurable s" "((\<lambda>n. Real (gmeasure (s \<inter> cube n))) ---> m) sequentially"
- shows "s has_lmeasure m" using assms unfolding has_lmeasure_def by auto
-
-definition lmeasure where
- "lmeasure s \<equiv> SOME m. s has_lmeasure m"
+interpretation lebesgue: measure_space lebesgue lmeasure
+proof
+ show "lmeasure {} = 0"
+ by (auto intro!: lmeasure_eq_0)
+ show "countably_additive lebesgue lmeasure"
+ proof (unfold countably_additive_def, intro allI impI conjI)
+ fix A :: "nat \<Rightarrow> 'b set" assume "range A \<subseteq> sets lebesgue" "disjoint_family A"
+ then have A: "\<And>i. A i \<in> sets lebesgue" by auto
+ show "(\<Sum>\<^isub>\<infinity>n. lmeasure (A n)) = lmeasure (\<Union>i. A i)" unfolding lmeasure_def
+ proof (subst psuminf_SUP_eq)
+ { fix i n
+ have "gmeasure (A i \<inter> cube n) \<le> gmeasure (A i \<inter> cube (Suc n))"
+ using A cube_subset[of n "Suc n"] by (auto intro!: measure_subset)
+ then show "Real (gmeasure (A i \<inter> cube n)) \<le> Real (gmeasure (A i \<inter> cube (Suc n)))"
+ by auto }
+ show "(SUP n. \<Sum>\<^isub>\<infinity>i. Real (gmeasure (A i \<inter> cube n))) = (SUP n. Real (gmeasure ((\<Union>i. A i) \<inter> cube n)))"
+ proof (intro arg_cong[where f="SUPR UNIV"] ext)
+ fix n
+ have sums: "(\<lambda>i. gmeasure (A i \<inter> cube n)) sums gmeasure (\<Union>{A i \<inter> cube n |i. i \<in> UNIV})"
+ proof (rule has_gmeasure_countable_negligible_unions(2))
+ fix i show "gmeasurable (A i \<inter> cube n)" using A by auto
+ next
+ fix i m :: nat assume "m \<noteq> i"
+ then have "A m \<inter> cube n \<inter> (A i \<inter> cube n) = {}"
+ using `disjoint_family A` unfolding disjoint_family_on_def by auto
+ then show "negligible (A m \<inter> cube n \<inter> (A i \<inter> cube n))" by auto
+ next
+ fix i
+ have "(\<Sum>k = 0..i. gmeasure (A k \<inter> cube n)) = gmeasure (\<Union>k\<le>i . A k \<inter> cube n)"
+ unfolding atLeast0AtMost using A
+ proof (intro gmeasure_setsum[symmetric])
+ fix s t :: nat assume "s \<noteq> t" then have "A t \<inter> A s = {}"
+ using `disjoint_family A` unfolding disjoint_family_on_def by auto
+ then show "A s \<inter> cube n \<inter> (A t \<inter> cube n) = {}" by auto
+ qed auto
+ also have "\<dots> \<le> gmeasure (cube n :: 'b set)" using A
+ by (intro measure_subset gmeasurable_finite_UNION) auto
+ finally show "(\<Sum>k = 0..i. gmeasure (A k \<inter> cube n)) \<le> gmeasure (cube n :: 'b set)" .
+ qed
+ show "(\<Sum>\<^isub>\<infinity>i. Real (gmeasure (A i \<inter> cube n))) = Real (gmeasure ((\<Union>i. A i) \<inter> cube n))"
+ unfolding psuminf_def
+ apply (subst setsum_Real)
+ apply (simp add: measure_pos_le)
+ proof (rule SUP_eq_LIMSEQ[THEN iffD2])
+ have "(\<Union>{A i \<inter> cube n |i. i \<in> UNIV}) = (\<Union>i. A i) \<inter> cube n" by auto
+ with sums show "(\<lambda>i. \<Sum>k<i. gmeasure (A k \<inter> cube n)) ----> gmeasure ((\<Union>i. A i) \<inter> cube n)"
+ unfolding sums_def atLeast0LessThan by simp
+ qed (auto intro!: monoI setsum_nonneg setsum_mono2)
+ qed
+ qed
+ qed
+qed
-lemma has_lmeasure_has_gmeasure: assumes "s has_lmeasure (Real m)" "m\<ge>0"
+lemma lmeasure_finite_has_gmeasure: assumes "s \<in> sets lebesgue" "lmeasure s = Real m" "0 \<le> m"
shows "s has_gmeasure m"
-proof- note s = has_lmeasureD[OF assms(1)]
+proof-
have *:"(\<lambda>n. (gmeasure (s \<inter> cube n))) ----> m"
- using s(3) apply(subst (asm) lim_Real) using s(2) assms(2) by auto
-
+ using `lmeasure s = Real m` unfolding lmeasure_iff_LIMSEQ[OF `s \<in> sets lebesgue` `0 \<le> m`] .
+ have s: "\<And>n. gmeasurable (s \<inter> cube n)" using assms by auto
have "(\<lambda>x. if x \<in> s then 1 else (0::real)) integrable_on UNIV \<and>
(\<lambda>k. integral UNIV (\<lambda>x. if x \<in> s \<inter> cube k then 1 else (0::real)))
----> integral UNIV (\<lambda>x. if x \<in> s then 1 else 0)"
proof(rule monotone_convergence_increasing)
- have "\<forall>n. gmeasure (s \<inter> cube n) \<le> m" apply(rule ccontr) unfolding not_all not_le
- proof(erule exE) fix k assume k:"m < gmeasure (s \<inter> cube k)"
- hence "gmeasure (s \<inter> cube k) - m > 0" by auto
- from *[unfolded Lim_sequentially,rule_format,OF this] guess N ..
- note this[unfolded dist_real_def,rule_format,of "N + k"]
- moreover have "gmeasure (s \<inter> cube (N + k)) \<ge> gmeasure (s \<inter> cube k)" apply-
- apply(rule measure_subset) prefer 3 using s(2)
- using cube_subset[of k "N + k"] by auto
- ultimately show False by auto
- qed
- thus *:"bounded {integral UNIV (\<lambda>x. if x \<in> s \<inter> cube k then 1 else (0::real)) |k. True}"
- unfolding integral_measure_univ[OF s(2)] bounded_def apply-
+ have "lmeasure s \<le> Real m" using `lmeasure s = Real m` by simp
+ then have "\<forall>n. gmeasure (s \<inter> cube n) \<le> m"
+ unfolding lmeasure_def complete_lattice_class.SUP_le_iff
+ using `0 \<le> m` by (auto simp: measure_pos_le)
+ thus *:"bounded {integral UNIV (\<lambda>x. if x \<in> s \<inter> cube k then 1 else (0::real)) |k. True}"
+ unfolding integral_measure_univ[OF s] bounded_def apply-
apply(rule_tac x=0 in exI,rule_tac x=m in exI) unfolding dist_real_def
by (auto simp: measure_pos_le)
-
show "\<forall>k. (\<lambda>x. if x \<in> s \<inter> cube k then (1::real) else 0) integrable_on UNIV"
unfolding integrable_restrict_univ
- using s(2) unfolding gmeasurable_def has_gmeasure_def by auto
+ using s unfolding gmeasurable_def has_gmeasure_def by auto
have *:"\<And>n. n \<le> Suc n" by auto
show "\<forall>k. \<forall>x\<in>UNIV. (if x \<in> s \<inter> cube k then 1 else 0) \<le> (if x \<in> s \<inter> cube (Suc k) then 1 else (0::real))"
using cube_subset[OF *] by fastsimp
show "\<forall>x\<in>UNIV. (\<lambda>k. if x \<in> s \<inter> cube k then 1 else 0) ----> (if x \<in> s then 1 else (0::real))"
- unfolding Lim_sequentially
+ unfolding Lim_sequentially
proof safe case goal1 from real_arch_lt[of "norm x"] guess N .. note N = this
show ?case apply(rule_tac x=N in exI)
proof safe case goal1
have "x \<in> cube n" using cube_subset[OF goal1] N
- using ball_subset_cube[of N] by(auto simp: dist_norm)
+ using ball_subset_cube[of N] by(auto simp: dist_norm)
thus ?case using `e>0` by auto
qed
qed
qed note ** = conjunctD2[OF this]
hence *:"m = integral UNIV (\<lambda>x. if x \<in> s then 1 else 0)" apply-
- apply(rule LIMSEQ_unique[OF _ **(2)]) unfolding measure_integral_univ[THEN sym,OF s(2)] using * .
+ apply(rule LIMSEQ_unique[OF _ **(2)]) unfolding measure_integral_univ[THEN sym,OF s] using * .
show ?thesis unfolding has_gmeasure * apply(rule integrable_integral) using ** by auto
qed
-lemma has_lmeasure_unique: "s has_lmeasure m1 \<Longrightarrow> s has_lmeasure m2 \<Longrightarrow> m1 = m2"
- unfolding has_lmeasure_def apply(rule Lim_unique) using trivial_limit_sequentially by auto
-
-lemma lmeasure_unique[intro]: assumes "A has_lmeasure m" shows "lmeasure A = m"
- using assms unfolding lmeasure_def lmeasurable_def apply-
- apply(rule some_equality) defer apply(rule has_lmeasure_unique) by auto
-
-lemma glmeasurable_finite: assumes "lmeasurable s" "lmeasure s \<noteq> \<omega>"
+lemma lmeasure_finite_gmeasurable: assumes "s \<in> sets lebesgue" "lmeasure s \<noteq> \<omega>"
shows "gmeasurable s"
-proof- have "\<exists>B. \<forall>n. gmeasure (s \<inter> cube n) \<le> B"
- proof(rule ccontr) case goal1
- note as = this[unfolded not_ex not_all not_le]
- have "s has_lmeasure \<omega>" apply- apply(rule has_lmeasureI[OF assms(1)])
- unfolding Lim_omega
- proof fix B::real
- from as[rule_format,of B] guess N .. note N = this
- have "\<And>n. N \<le> n \<Longrightarrow> B \<le> gmeasure (s \<inter> cube n)"
- apply(rule order_trans[where y="gmeasure (s \<inter> cube N)"]) defer
- apply(rule measure_subset) prefer 3
- using cube_subset N assms(1)[unfolded lmeasurable_def] by auto
- thus "\<exists>N. \<forall>n\<ge>N. Real B \<le> Real (gmeasure (s \<inter> cube n))" apply-
- apply(subst Real_max') apply(rule_tac x=N in exI,safe)
- unfolding pinfreal_less_eq apply(subst if_P) by auto
- qed note lmeasure_unique[OF this]
- thus False using assms(2) by auto
- qed then guess B .. note B=this
+proof (cases "lmeasure s")
+ case (preal m) from lmeasure_finite_has_gmeasure[OF `s \<in> sets lebesgue` this]
+ show ?thesis unfolding gmeasurable_def by auto
+qed (insert assms, auto)
- show ?thesis apply(rule gmeasurable_nested_unions[of "\<lambda>n. s \<inter> cube n",
- unfolded Union_inter_cube,THEN conjunct1, where B1=B])
- proof- fix n::nat
- show " gmeasurable (s \<inter> cube n)" using assms by auto
- show "gmeasure (s \<inter> cube n) \<le> B" using B by auto
- show "s \<inter> cube n \<subseteq> s \<inter> cube (Suc n)"
- by (rule Int_mono) (simp_all add: cube_subset)
- qed
-qed
-
-lemma lmeasure_empty[intro]:"lmeasure {} = 0"
- apply(rule lmeasure_unique)
- unfolding has_lmeasure_def by auto
-
-lemma lmeasurableI[dest]:"s has_lmeasure m \<Longrightarrow> lmeasurable s"
- unfolding has_lmeasure_def by auto
-
-lemma has_gmeasure_has_lmeasure: assumes "s has_gmeasure m"
- shows "s has_lmeasure (Real m)"
-proof- have gmea:"gmeasurable s" using assms by auto
+lemma has_gmeasure_lmeasure: assumes "s has_gmeasure m"
+ shows "lmeasure s = Real m"
+proof-
+ have gmea:"gmeasurable s" using assms by auto
+ then have s: "s \<in> sets lebesgue" by auto
have m:"m \<ge> 0" using assms by auto
have *:"m = gmeasure (\<Union>{s \<inter> cube n |n. n \<in> UNIV})" unfolding Union_inter_cube
using assms by(rule measure_unique[THEN sym])
- show ?thesis unfolding has_lmeasure_def
- apply(rule,rule measurable_imp_lmeasurable[OF gmea])
- apply(subst lim_Real) apply(rule,rule,rule m) unfolding *
+ show ?thesis
+ unfolding lmeasure_iff_LIMSEQ[OF s `0 \<le> m`] unfolding *
apply(rule gmeasurable_nested_unions[THEN conjunct2, where B1="gmeasure s"])
proof- fix n::nat show *:"gmeasurable (s \<inter> cube n)"
using gmeasurable_inter[OF gmea gmeasurable_cube] .
@@ -266,287 +335,26 @@
apply(rule * gmea)+ by auto
show "s \<inter> cube n \<subseteq> s \<inter> cube (Suc n)" using cube_subset[of n "Suc n"] by auto
qed
-qed
-
-lemma gmeasure_lmeasure: assumes "gmeasurable s" shows "lmeasure s = Real (gmeasure s)"
-proof- note has_gmeasure_measureI[OF assms]
- note has_gmeasure_has_lmeasure[OF this]
- thus ?thesis by(rule lmeasure_unique)
-qed
-
-lemma has_lmeasure_lmeasure: "lmeasurable s \<longleftrightarrow> s has_lmeasure (lmeasure s)" (is "?l = ?r")
-proof assume ?l let ?f = "\<lambda>n. Real (gmeasure (s \<inter> cube n))"
- have "\<forall>n m. n\<ge>m \<longrightarrow> ?f n \<ge> ?f m" unfolding pinfreal_less_eq apply safe
- apply(subst if_P) defer apply(rule measure_subset) prefer 3
- apply(drule cube_subset) using `?l` by auto
- from lim_pinfreal_increasing[OF this] guess l . note l=this
- hence "s has_lmeasure l" using `?l` apply-apply(rule has_lmeasureI) by auto
- thus ?r using lmeasure_unique by auto
-next assume ?r thus ?l unfolding has_lmeasure_def by auto
-qed
-
-lemma lmeasure_subset[dest]: assumes "lmeasurable s" "lmeasurable t" "s \<subseteq> t"
- shows "lmeasure s \<le> lmeasure t"
-proof(cases "lmeasure t = \<omega>")
- case False have som:"lmeasure s \<noteq> \<omega>"
- proof(rule ccontr,unfold not_not) assume as:"lmeasure s = \<omega>"
- have "t has_lmeasure \<omega>" using assms(2) apply(rule has_lmeasureI)
- unfolding Lim_omega
- proof case goal1
- note assms(1)[unfolded has_lmeasure_lmeasure]
- note has_lmeasureD(3)[OF this,unfolded as Lim_omega,rule_format,of B]
- then guess N .. note N = this
- show ?case apply(rule_tac x=N in exI) apply safe
- apply(rule order_trans) apply(rule N[rule_format],assumption)
- unfolding pinfreal_less_eq apply(subst if_P)defer
- apply(rule measure_subset) using assms by auto
- qed
- thus False using lmeasure_unique False by auto
- qed
-
- note assms(1)[unfolded has_lmeasure_lmeasure] note has_lmeasureD(3)[OF this]
- hence "(\<lambda>n. Real (gmeasure (s \<inter> cube n))) ----> Real (real (lmeasure s))"
- unfolding Real_real'[OF som] .
- hence l1:"(\<lambda>n. gmeasure (s \<inter> cube n)) ----> real (lmeasure s)"
- apply-apply(subst(asm) lim_Real) by auto
-
- note assms(2)[unfolded has_lmeasure_lmeasure] note has_lmeasureD(3)[OF this]
- hence "(\<lambda>n. Real (gmeasure (t \<inter> cube n))) ----> Real (real (lmeasure t))"
- unfolding Real_real'[OF False] .
- hence l2:"(\<lambda>n. gmeasure (t \<inter> cube n)) ----> real (lmeasure t)"
- apply-apply(subst(asm) lim_Real) by auto
-
- have "real (lmeasure s) \<le> real (lmeasure t)" apply(rule LIMSEQ_le[OF l1 l2])
- apply(rule_tac x=0 in exI,safe) apply(rule measure_subset) using assms by auto
- hence "Real (real (lmeasure s)) \<le> Real (real (lmeasure t))"
- unfolding pinfreal_less_eq by auto
- thus ?thesis unfolding Real_real'[OF som] Real_real'[OF False] .
-qed auto
-
-lemma has_lmeasure_negligible_unions_image:
- assumes "finite s" "\<And>x. x \<in> s ==> lmeasurable(f x)"
- "\<And>x y. x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x \<noteq> y \<Longrightarrow> negligible((f x) \<inter> (f y))"
- shows "(\<Union> (f ` s)) has_lmeasure (setsum (\<lambda>x. lmeasure(f x)) s)"
- unfolding has_lmeasure_def
-proof show lmeaf:"lmeasurable (\<Union>f ` s)" apply(rule lmeasurable_finite_unions)
- using assms(1-2) by auto
- show "(\<lambda>n. Real (gmeasure (\<Union>f ` s \<inter> cube n))) ----> (\<Sum>x\<in>s. lmeasure (f x))" (is ?l)
- proof(cases "\<exists>x\<in>s. lmeasure (f x) = \<omega>")
- case False hence *:"(\<Sum>x\<in>s. lmeasure (f x)) \<noteq> \<omega>" apply-
- apply(rule setsum_neq_omega) using assms(1) by auto
- have gmea:"\<And>x. x\<in>s \<Longrightarrow> gmeasurable (f x)" apply(rule glmeasurable_finite) using False assms(2) by auto
- have "(\<Sum>x\<in>s. lmeasure (f x)) = (\<Sum>x\<in>s. Real (gmeasure (f x)))" apply(rule setsum_cong2)
- apply(rule gmeasure_lmeasure) using False assms(2) gmea by auto
- also have "... = Real (\<Sum>x\<in>s. (gmeasure (f x)))" apply(rule setsum_Real) by auto
- finally have sum:"(\<Sum>x\<in>s. lmeasure (f x)) = Real (\<Sum>x\<in>s. gmeasure (f x))" .
- have sum_0:"(\<Sum>x\<in>s. gmeasure (f x)) \<ge> 0" apply(rule setsum_nonneg) by auto
- have int_un:"\<Union>f ` s has_gmeasure (\<Sum>x\<in>s. gmeasure (f x))"
- apply(rule has_gmeasure_negligible_unions_image) using assms gmea by auto
-
- have unun:"\<Union>{\<Union>f ` s \<inter> cube n |n. n \<in> UNIV} = \<Union>f ` s" unfolding simple_image
- proof safe fix x y assume as:"x \<in> f y" "y \<in> s"
- from mem_big_cube[of x] guess n . note n=this
- thus "x \<in> \<Union>range (\<lambda>n. \<Union>f ` s \<inter> cube n)" unfolding Union_iff
- apply-apply(rule_tac x="\<Union>f ` s \<inter> cube n" in bexI) using as by auto
- qed
- show ?l apply(subst Real_real'[OF *,THEN sym])apply(subst lim_Real)
- apply rule apply rule unfolding sum real_Real if_P[OF sum_0] apply(rule sum_0)
- unfolding measure_unique[OF int_un,THEN sym] apply(subst(2) unun[THEN sym])
- apply(rule has_gmeasure_nested_unions[THEN conjunct2])
- proof- fix n::nat
- show *:"gmeasurable (\<Union>f ` s \<inter> cube n)" using lmeaf unfolding lmeasurable_def by auto
- thus "gmeasure (\<Union>f ` s \<inter> cube n) \<le> gmeasure (\<Union>f ` s)"
- apply(rule measure_subset) using int_un by auto
- show "\<Union>f ` s \<inter> cube n \<subseteq> \<Union>f ` s \<inter> cube (Suc n)"
- using cube_subset[of n "Suc n"] by auto
- qed
-
- next case True then guess X .. note X=this
- hence sum:"(\<Sum>x\<in>s. lmeasure (f x)) = \<omega>" using setsum_\<omega>[THEN iffD2, of s] assms by fastsimp
- show ?l unfolding sum Lim_omega
- proof fix B::real
- have Xm:"(f X) has_lmeasure \<omega>" using X by (metis assms(2) has_lmeasure_lmeasure)
- note this[unfolded has_lmeasure_def,THEN conjunct2, unfolded Lim_omega]
- from this[rule_format,of B] guess N .. note N=this[rule_format]
- show "\<exists>N. \<forall>n\<ge>N. Real B \<le> Real (gmeasure (\<Union>f ` s \<inter> cube n))"
- apply(rule_tac x=N in exI)
- proof safe case goal1 show ?case apply(rule order_trans[OF N[OF goal1]])
- unfolding pinfreal_less_eq apply(subst if_P) defer
- apply(rule measure_subset) using has_lmeasureD(2)[OF Xm]
- using lmeaf unfolding lmeasurable_def using X(1) by auto
- qed qed qed qed
-
-lemma has_lmeasure_negligible_unions:
- assumes"finite f" "\<And>s. s \<in> f ==> s has_lmeasure (m s)"
- "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> negligible (s\<inter>t)"
- shows "(\<Union> f) has_lmeasure (setsum m f)"
-proof- have *:"setsum m f = setsum lmeasure f" apply(rule setsum_cong2)
- apply(subst lmeasure_unique[OF assms(2)]) by auto
- show ?thesis unfolding *
- apply(rule has_lmeasure_negligible_unions_image[where s=f and f=id,unfolded image_id id_apply])
- using assms by auto
-qed
-
-lemma has_lmeasure_disjoint_unions:
- assumes"finite f" "\<And>s. s \<in> f ==> s has_lmeasure (m s)"
- "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> s \<inter> t = {}"
- shows "(\<Union> f) has_lmeasure (setsum m f)"
-proof- have *:"setsum m f = setsum lmeasure f" apply(rule setsum_cong2)
- apply(subst lmeasure_unique[OF assms(2)]) by auto
- show ?thesis unfolding *
- apply(rule has_lmeasure_negligible_unions_image[where s=f and f=id,unfolded image_id id_apply])
- using assms by auto
qed
-lemma has_lmeasure_nested_unions:
- assumes "\<And>n. lmeasurable(s n)" "\<And>n. s(n) \<subseteq> s(Suc n)"
- shows "lmeasurable(\<Union> { s n | n. n \<in> UNIV }) \<and>
- (\<lambda>n. lmeasure(s n)) ----> lmeasure(\<Union> { s(n) | n. n \<in> UNIV })" (is "?mea \<and> ?lim")
-proof- have cube:"\<And>m. \<Union> { s(n) | n. n \<in> UNIV } \<inter> cube m = \<Union> { s(n) \<inter> cube m | n. n \<in> UNIV }" by blast
- have 3:"\<And>n. \<forall>m\<ge>n. s n \<subseteq> s m" apply(rule transitive_stepwise_le) using assms(2) by auto
- have mea:"?mea" unfolding lmeasurable_def cube apply rule
- apply(rule_tac B1="gmeasure (cube n)" in has_gmeasure_nested_unions[THEN conjunct1])
- prefer 3 apply rule using assms(1) unfolding lmeasurable_def
- by(auto intro!:assms(2)[unfolded subset_eq,rule_format])
- show ?thesis apply(rule,rule mea)
- proof(cases "lmeasure(\<Union> { s(n) | n. n \<in> UNIV }) = \<omega>")
- case True show ?lim unfolding True Lim_omega
- proof(rule ccontr) case goal1 note this[unfolded not_all not_ex]
- hence "\<exists>B. \<forall>n. \<exists>m\<ge>n. Real B > lmeasure (s m)" by(auto simp add:not_le)
- from this guess B .. note B=this[rule_format]
-
- have "\<forall>n. gmeasurable (s n) \<and> gmeasure (s n) \<le> max B 0"
- proof safe fix n::nat from B[of n] guess m .. note m=this
- hence *:"lmeasure (s n) < Real B" apply-apply(rule le_less_trans)
- apply(rule lmeasure_subset[OF assms(1,1)]) apply(rule 3[rule_format]) by auto
- thus **:"gmeasurable (s n)" apply-apply(rule glmeasurable_finite[OF assms(1)]) by auto
- thus "gmeasure (s n) \<le> max B 0" using * unfolding gmeasure_lmeasure[OF **] Real_max'[of B]
- unfolding pinfreal_less apply- apply(subst(asm) if_P) by auto
- qed
- hence "\<And>n. gmeasurable (s n)" "\<And>n. gmeasure (s n) \<le> max B 0" by auto
- note g = conjunctD2[OF has_gmeasure_nested_unions[of s, OF this assms(2)]]
- show False using True unfolding gmeasure_lmeasure[OF g(1)] by auto
- qed
- next let ?B = "lmeasure (\<Union>{s n |n. n \<in> UNIV})"
- case False note gmea_lim = glmeasurable_finite[OF mea this]
- have ls:"\<And>n. lmeasure (s n) \<le> lmeasure (\<Union>{s n |n. n \<in> UNIV})"
- apply(rule lmeasure_subset) using assms(1) mea by auto
- have "\<And>n. lmeasure (s n) \<noteq> \<omega>"
- proof(rule ccontr,safe) case goal1
- show False using False ls[of n] unfolding goal1 by auto
- qed
- note gmea = glmeasurable_finite[OF assms(1) this]
-
- have "\<And>n. gmeasure (s n) \<le> real ?B" unfolding gmeasure_lmeasure[OF gmea_lim]
- unfolding real_Real apply(subst if_P,rule) apply(rule measure_subset)
- using gmea gmea_lim by auto
- note has_gmeasure_nested_unions[of s, OF gmea this assms(2)]
- thus ?lim unfolding gmeasure_lmeasure[OF gmea] gmeasure_lmeasure[OF gmea_lim]
- apply-apply(subst lim_Real) by auto
- qed
-qed
-
-lemma has_lmeasure_countable_negligible_unions:
- assumes "\<And>n. lmeasurable(s n)" "\<And>m n. m \<noteq> n \<Longrightarrow> negligible(s m \<inter> s n)"
- shows "(\<lambda>m. setsum (\<lambda>n. lmeasure(s n)) {..m}) ----> (lmeasure(\<Union> { s(n) |n. n \<in> UNIV }))"
-proof- have *:"\<And>n. (\<Union> (s ` {0..n})) has_lmeasure (setsum (\<lambda>k. lmeasure(s k)) {0..n})"
- apply(rule has_lmeasure_negligible_unions_image) using assms by auto
- have **:"(\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV}) = (\<Union>{s n |n. n \<in> UNIV})" unfolding simple_image by fastsimp
- have "lmeasurable (\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV}) \<and>
- (\<lambda>n. lmeasure (\<Union>(s ` {0..n}))) ----> lmeasure (\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV})"
- apply(rule has_lmeasure_nested_unions) apply(rule has_lmeasureD(1)[OF *])
- apply(rule Union_mono,rule image_mono) by auto
- note lem = conjunctD2[OF this,unfolded **]
- show ?thesis using lem(2) unfolding lmeasure_unique[OF *] unfolding atLeast0AtMost .
-qed
-
-lemma lmeasure_eq_0: assumes "negligible s" shows "lmeasure s = 0"
-proof- note mea=negligible_imp_lmeasurable[OF assms]
- have *:"\<And>n. (gmeasure (s \<inter> cube n)) = 0"
- unfolding gmeasurable_measure_eq_0[OF mea[unfolded lmeasurable_def,rule_format]]
- using assms by auto
- show ?thesis
- apply(rule lmeasure_unique) unfolding has_lmeasure_def
- apply(rule,rule mea) unfolding * by auto
+lemma has_gmeasure_iff_lmeasure:
+ "A has_gmeasure m \<longleftrightarrow> (A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m)"
+proof
+ assume "A has_gmeasure m"
+ with has_gmeasure_lmeasure[OF this]
+ have "gmeasurable A" "0 \<le> m" "lmeasure A = Real m" by auto
+ then show "A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m" by auto
+next
+ assume "A \<in> sets lebesgue \<and> 0 \<le> m \<and> lmeasure A = Real m"
+ then show "A has_gmeasure m" by (intro lmeasure_finite_has_gmeasure) auto
qed
-lemma negligible_img_gmeasurable: fixes s::"'a::ordered_euclidean_space set"
- assumes "negligible s" shows "gmeasurable s"
- apply(rule glmeasurable_finite)
- using lmeasure_eq_0[OF assms] negligible_imp_lmeasurable[OF assms] by auto
-
-
-
-
-section {* Instantiation of _::euclidean_space as measure_space *}
-
-definition lebesgue_space :: "'a::ordered_euclidean_space algebra" where
- "lebesgue_space = \<lparr> space = UNIV, sets = lmeasurable \<rparr>"
-
-lemma lebesgue_measurable[simp]:"A \<in> sets lebesgue_space \<longleftrightarrow> lmeasurable A"
- unfolding lebesgue_space_def by(auto simp: mem_def)
-
-lemma mem_gmeasurable[simp]: "A \<in> gmeasurable \<longleftrightarrow> gmeasurable A"
- unfolding mem_def ..
-
-interpretation lebesgue: measure_space lebesgue_space lmeasure
- apply(intro_locales) unfolding measure_space_axioms_def countably_additive_def
- unfolding sigma_algebra_axioms_def algebra_def
- unfolding lebesgue_measurable
-proof safe
- fix A::"nat => _" assume as:"range A \<subseteq> sets lebesgue_space" "disjoint_family A"
- "lmeasurable (UNION UNIV A)"
- have *:"UNION UNIV A = \<Union>range A" by auto
- show "(\<Sum>\<^isub>\<infinity>n. lmeasure (A n)) = lmeasure (UNION UNIV A)"
- unfolding psuminf_def apply(rule SUP_Lim_pinfreal)
- proof- fix n m::nat assume mn:"m\<le>n"
- have *:"\<And>m. (\<Sum>n<m. lmeasure (A n)) = lmeasure (\<Union>A ` {..<m})"
- apply(subst lmeasure_unique[OF has_lmeasure_negligible_unions[where m=lmeasure]])
- apply(rule finite_imageI) apply rule apply(subst has_lmeasure_lmeasure[THEN sym])
- proof- fix m::nat
- show "(\<Sum>n<m. lmeasure (A n)) = setsum lmeasure (A ` {..<m})"
- apply(subst setsum_reindex_nonzero) unfolding o_def apply rule
- apply(rule lmeasure_eq_0) using as(2) unfolding disjoint_family_on_def
- apply(erule_tac x=x in ballE,safe,erule_tac x=y in ballE) by auto
- next fix m s assume "s \<in> A ` {..<m}"
- hence "s \<in> range A" by auto thus "lmeasurable s" using as(1) by fastsimp
- next fix m s t assume st:"s \<in> A ` {..<m}" "t \<in> A ` {..<m}" "s \<noteq> t"
- from st(1-2) guess sa ta unfolding image_iff apply-by(erule bexE)+ note a=this
- from st(3) have "sa \<noteq> ta" unfolding a by auto
- thus "negligible (s \<inter> t)"
- using as(2) unfolding disjoint_family_on_def a
- apply(erule_tac x=sa in ballE,erule_tac x=ta in ballE) by auto
- qed
-
- have "\<And>m. lmeasurable (\<Union>A ` {..<m})" apply(rule lmeasurable_finite_unions)
- apply(rule finite_imageI,rule) using as(1) by fastsimp
- from this this show "(\<Sum>n<m. lmeasure (A n)) \<le> (\<Sum>n<n. lmeasure (A n))" unfolding *
- apply(rule lmeasure_subset) apply(rule Union_mono) apply(rule image_mono) using mn by auto
-
- next have *:"UNION UNIV A = \<Union>{A n |n. n \<in> UNIV}" by auto
- show "(\<lambda>n. \<Sum>n<n. lmeasure (A n)) ----> lmeasure (UNION UNIV A)"
- apply(rule LIMSEQ_imp_Suc) unfolding lessThan_Suc_atMost *
- apply(rule has_lmeasure_countable_negligible_unions)
- using as unfolding disjoint_family_on_def subset_eq by auto
- qed
-
-next show "lmeasure {} = 0" by auto
-next fix A::"nat => _" assume as:"range A \<subseteq> sets lebesgue_space"
- have *:"UNION UNIV A = (\<Union>{A n |n. n \<in> UNIV})" unfolding simple_image by auto
- show "lmeasurable (UNION UNIV A)" unfolding * using as unfolding subset_eq
- using lmeasurable_countable_unions_strong[of A] by auto
-qed(auto simp: lebesgue_space_def mem_def)
-
-
-
-lemma lmeasurbale_closed_interval[intro]:
- "lmeasurable {a..b::'a::ordered_euclidean_space}"
- unfolding lmeasurable_def cube_def inter_interval by auto
-
-lemma space_lebesgue_space[simp]:"space lebesgue_space = UNIV"
- unfolding lebesgue_space_def by auto
-
-abbreviation "gintegral \<equiv> Integration.integral"
+lemma gmeasure_lmeasure: assumes "gmeasurable s" shows "lmeasure s = Real (gmeasure s)"
+proof -
+ note has_gmeasure_measureI[OF assms]
+ note has_gmeasure_lmeasure[OF this]
+ thus ?thesis .
+qed
lemma lebesgue_simple_function_indicator:
fixes f::"'a::ordered_euclidean_space \<Rightarrow> pinfreal"
@@ -556,21 +364,600 @@
lemma lmeasure_gmeasure:
"gmeasurable s \<Longrightarrow> gmeasure s = real (lmeasure s)"
- apply(subst gmeasure_lmeasure) by auto
+ by (subst gmeasure_lmeasure) auto
lemma lmeasure_finite: assumes "gmeasurable s" shows "lmeasure s \<noteq> \<omega>"
using gmeasure_lmeasure[OF assms] by auto
-lemma negligible_lmeasure: assumes "lmeasurable s"
- shows "lmeasure s = 0 \<longleftrightarrow> negligible s" (is "?l = ?r")
-proof assume ?l
- hence *:"gmeasurable s" using glmeasurable_finite[of s] assms by auto
- show ?r unfolding gmeasurable_measure_eq_0[THEN sym,OF *]
- unfolding lmeasure_gmeasure[OF *] using `?l` by auto
-next assume ?r
- note g=negligible_img_gmeasurable[OF this] and measure_eq_0[OF this]
- hence "real (lmeasure s) = 0" using lmeasure_gmeasure[of s] by auto
- thus ?l using lmeasure_finite[OF g] apply- apply(rule real_0_imp_eq_0) by auto
+lemma negligible_iff_lebesgue_null_sets:
+ "negligible A \<longleftrightarrow> A \<in> lebesgue.null_sets"
+proof
+ assume "negligible A"
+ from this[THEN lebesgueI_negligible] this[THEN lmeasure_eq_0]
+ show "A \<in> lebesgue.null_sets" by auto
+next
+ assume A: "A \<in> lebesgue.null_sets"
+ then have *:"gmeasurable A" using lmeasure_finite_gmeasurable[of A] by auto
+ show "negligible A"
+ unfolding gmeasurable_measure_eq_0[OF *, symmetric]
+ unfolding lmeasure_gmeasure[OF *] using A by auto
+qed
+
+lemma
+ fixes a b ::"'a::ordered_euclidean_space"
+ shows lmeasure_atLeastAtMost[simp]: "lmeasure {a..b} = Real (content {a..b})"
+ and lmeasure_greaterThanLessThan[simp]: "lmeasure {a <..< b} = Real (content {a..b})"
+ using has_gmeasure_interval[of a b] by (auto intro!: has_gmeasure_lmeasure)
+
+lemma lmeasure_cube:
+ "lmeasure (cube n::('a::ordered_euclidean_space) set) = (Real ((2 * real n) ^ (DIM('a))))"
+ by (intro has_gmeasure_lmeasure) auto
+
+lemma lmeasure_UNIV[intro]: "lmeasure UNIV = \<omega>"
+ unfolding lmeasure_def SUP_\<omega>
+proof (intro allI impI)
+ fix x assume "x < \<omega>"
+ then obtain r where r: "x = Real r" "0 \<le> r" by (cases x) auto
+ then obtain n where n: "r < of_nat n" using ex_less_of_nat by auto
+ show "\<exists>i\<in>UNIV. x < Real (gmeasure (UNIV \<inter> cube i))"
+ proof (intro bexI[of _ n])
+ have "x < Real (of_nat n)" using n r by auto
+ also have "Real (of_nat n) \<le> Real (gmeasure (UNIV \<inter> cube n))"
+ using gmeasure_cube_ge_n[of n] by (auto simp: real_eq_of_nat[symmetric])
+ finally show "x < Real (gmeasure (UNIV \<inter> cube n))" .
+ qed auto
+qed
+
+lemma atLeastAtMost_singleton_euclidean[simp]:
+ fixes a :: "'a::ordered_euclidean_space" shows "{a .. a} = {a}"
+ by (force simp: eucl_le[where 'a='a] euclidean_eq[where 'a='a])
+
+lemma content_singleton[simp]: "content {a} = 0"
+proof -
+ have "content {a .. a} = 0"
+ by (subst content_closed_interval) auto
+ then show ?thesis by simp
+qed
+
+lemma lmeasure_singleton[simp]:
+ fixes a :: "'a::ordered_euclidean_space" shows "lmeasure {a} = 0"
+ using has_gmeasure_interval[of a a] unfolding zero_pinfreal_def
+ by (intro has_gmeasure_lmeasure)
+ (simp add: content_closed_interval DIM_positive)
+
+declare content_real[simp]
+
+lemma
+ fixes a b :: real
+ shows lmeasure_real_greaterThanAtMost[simp]:
+ "lmeasure {a <.. b} = Real (if a \<le> b then b - a else 0)"
+proof cases
+ assume "a < b"
+ then have "lmeasure {a <.. b} = lmeasure {a <..< b} + lmeasure {b}"
+ by (subst lebesgue.measure_additive)
+ (auto intro!: lebesgueI_borel arg_cong[where f=lmeasure])
+ then show ?thesis by auto
+qed auto
+
+lemma
+ fixes a b :: real
+ shows lmeasure_real_atLeastLessThan[simp]:
+ "lmeasure {a ..< b} = Real (if a \<le> b then b - a else 0)" (is ?eqlt)
+proof cases
+ assume "a < b"
+ then have "lmeasure {a ..< b} = lmeasure {a} + lmeasure {a <..< b}"
+ by (subst lebesgue.measure_additive)
+ (auto intro!: lebesgueI_borel arg_cong[where f=lmeasure])
+ then show ?thesis by auto
+qed auto
+
+interpretation borel: measure_space borel lmeasure
+proof
+ show "countably_additive borel lmeasure"
+ using lebesgue.ca unfolding countably_additive_def
+ apply safe apply (erule_tac x=A in allE) by auto
+qed auto
+
+interpretation borel: sigma_finite_measure borel lmeasure
+proof (default, intro conjI exI[of _ "\<lambda>n. cube n"])
+ show "range cube \<subseteq> sets borel" by (auto intro: borel_closed)
+ { fix x have "\<exists>n. x\<in>cube n" using mem_big_cube by auto }
+ thus "(\<Union>i. cube i) = space borel" by auto
+ show "\<forall>i. lmeasure (cube i) \<noteq> \<omega>" unfolding lmeasure_cube by auto
+qed
+
+interpretation lebesgue: sigma_finite_measure lebesgue lmeasure
+proof
+ from borel.sigma_finite guess A ..
+ moreover then have "range A \<subseteq> sets lebesgue" using lebesgueI_borel by blast
+ ultimately show "\<exists>A::nat \<Rightarrow> 'b set. range A \<subseteq> sets lebesgue \<and> (\<Union>i. A i) = space lebesgue \<and> (\<forall>i. lmeasure (A i) \<noteq> \<omega>)"
+ by auto
+qed
+
+lemma simple_function_has_integral:
+ fixes f::"'a::ordered_euclidean_space \<Rightarrow> pinfreal"
+ assumes f:"lebesgue.simple_function f"
+ and f':"\<forall>x. f x \<noteq> \<omega>"
+ and om:"\<forall>x\<in>range f. lmeasure (f -` {x} \<inter> UNIV) = \<omega> \<longrightarrow> x = 0"
+ shows "((\<lambda>x. real (f x)) has_integral (real (lebesgue.simple_integral f))) UNIV"
+ unfolding lebesgue.simple_integral_def
+ apply(subst lebesgue_simple_function_indicator[OF f])
+proof- case goal1
+ have *:"\<And>x. \<forall>y\<in>range f. y * indicator (f -` {y}) x \<noteq> \<omega>"
+ "\<forall>x\<in>range f. x * lmeasure (f -` {x} \<inter> UNIV) \<noteq> \<omega>"
+ using f' om unfolding indicator_def by auto
+ show ?case unfolding space_lebesgue real_of_pinfreal_setsum'[OF *(1),THEN sym]
+ unfolding real_of_pinfreal_setsum'[OF *(2),THEN sym]
+ unfolding real_of_pinfreal_setsum space_lebesgue
+ apply(rule has_integral_setsum)
+ proof safe show "finite (range f)" using f by (auto dest: lebesgue.simple_functionD)
+ fix y::'a show "((\<lambda>x. real (f y * indicator (f -` {f y}) x)) has_integral
+ real (f y * lmeasure (f -` {f y} \<inter> UNIV))) UNIV"
+ proof(cases "f y = 0") case False
+ have mea:"gmeasurable (f -` {f y})" apply(rule lmeasure_finite_gmeasurable)
+ using assms unfolding lebesgue.simple_function_def using False by auto
+ have *:"\<And>x. real (indicator (f -` {f y}) x::pinfreal) = (if x \<in> f -` {f y} then 1 else 0)" by auto
+ show ?thesis unfolding real_of_pinfreal_mult[THEN sym]
+ apply(rule has_integral_cmul[where 'b=real, unfolded real_scaleR_def])
+ unfolding Int_UNIV_right lmeasure_gmeasure[OF mea,THEN sym]
+ unfolding measure_integral_univ[OF mea] * apply(rule integrable_integral)
+ unfolding gmeasurable_integrable[THEN sym] using mea .
+ qed auto
+ qed qed
+
+lemma bounded_realI: assumes "\<forall>x\<in>s. abs (x::real) \<le> B" shows "bounded s"
+ unfolding bounded_def dist_real_def apply(rule_tac x=0 in exI)
+ using assms by auto
+
+lemma simple_function_has_integral':
+ fixes f::"'a::ordered_euclidean_space \<Rightarrow> pinfreal"
+ assumes f:"lebesgue.simple_function f"
+ and i: "lebesgue.simple_integral f \<noteq> \<omega>"
+ shows "((\<lambda>x. real (f x)) has_integral (real (lebesgue.simple_integral f))) UNIV"
+proof- let ?f = "\<lambda>x. if f x = \<omega> then 0 else f x"
+ { fix x have "real (f x) = real (?f x)" by (cases "f x") auto } note * = this
+ have **:"{x. f x \<noteq> ?f x} = f -` {\<omega>}" by auto
+ have **:"lmeasure {x\<in>space lebesgue. f x \<noteq> ?f x} = 0"
+ using lebesgue.simple_integral_omega[OF assms] by(auto simp add:**)
+ show ?thesis apply(subst lebesgue.simple_integral_cong'[OF f _ **])
+ apply(rule lebesgue.simple_function_compose1[OF f])
+ unfolding * defer apply(rule simple_function_has_integral)
+ proof-
+ show "lebesgue.simple_function ?f"
+ using lebesgue.simple_function_compose1[OF f] .
+ show "\<forall>x. ?f x \<noteq> \<omega>" by auto
+ show "\<forall>x\<in>range ?f. lmeasure (?f -` {x} \<inter> UNIV) = \<omega> \<longrightarrow> x = 0"
+ proof (safe, simp, safe, rule ccontr)
+ fix y assume "f y \<noteq> \<omega>" "f y \<noteq> 0"
+ hence "(\<lambda>x. if f x = \<omega> then 0 else f x) -` {if f y = \<omega> then 0 else f y} = f -` {f y}"
+ by (auto split: split_if_asm)
+ moreover assume "lmeasure ((\<lambda>x. if f x = \<omega> then 0 else f x) -` {if f y = \<omega> then 0 else f y}) = \<omega>"
+ ultimately have "lmeasure (f -` {f y}) = \<omega>" by simp
+ moreover
+ have "f y * lmeasure (f -` {f y}) \<noteq> \<omega>" using i f
+ unfolding lebesgue.simple_integral_def setsum_\<omega> lebesgue.simple_function_def
+ by auto
+ ultimately have "f y = 0" by (auto split: split_if_asm)
+ then show False using `f y \<noteq> 0` by simp
+ qed
+ qed
+qed
+
+lemma (in measure_space) positive_integral_monotone_convergence:
+ fixes f::"nat \<Rightarrow> 'a \<Rightarrow> pinfreal"
+ assumes i: "\<And>i. f i \<in> borel_measurable M" and mono: "\<And>x. mono (\<lambda>n. f n x)"
+ and lim: "\<And>x. (\<lambda>i. f i x) ----> u x"
+ shows "u \<in> borel_measurable M"
+ and "(\<lambda>i. positive_integral (f i)) ----> positive_integral u" (is ?ilim)
+proof -
+ from positive_integral_isoton[unfolded isoton_fun_expand isoton_iff_Lim_mono, of f u]
+ show ?ilim using mono lim i by auto
+ have "(SUP i. f i) = u" using mono lim SUP_Lim_pinfreal
+ unfolding fun_eq_iff SUPR_fun_expand mono_def by auto
+ moreover have "(SUP i. f i) \<in> borel_measurable M"
+ using i by (rule borel_measurable_SUP)
+ ultimately show "u \<in> borel_measurable M" by simp
+qed
+
+lemma positive_integral_has_integral:
+ fixes f::"'a::ordered_euclidean_space => pinfreal"
+ assumes f:"f \<in> borel_measurable lebesgue"
+ and int_om:"lebesgue.positive_integral f \<noteq> \<omega>"
+ and f_om:"\<forall>x. f x \<noteq> \<omega>" (* TODO: remove this *)
+ shows "((\<lambda>x. real (f x)) has_integral (real (lebesgue.positive_integral f))) UNIV"
+proof- let ?i = "lebesgue.positive_integral f"
+ from lebesgue.borel_measurable_implies_simple_function_sequence[OF f]
+ guess u .. note conjunctD2[OF this,rule_format] note u = conjunctD2[OF this(1)] this(2)
+ let ?u = "\<lambda>i x. real (u i x)" and ?f = "\<lambda>x. real (f x)"
+ have u_simple:"\<And>k. lebesgue.simple_integral (u k) = lebesgue.positive_integral (u k)"
+ apply(subst lebesgue.positive_integral_eq_simple_integral[THEN sym,OF u(1)]) ..
+ have int_u_le:"\<And>k. lebesgue.simple_integral (u k) \<le> lebesgue.positive_integral f"
+ unfolding u_simple apply(rule lebesgue.positive_integral_mono)
+ using isoton_Sup[OF u(3)] unfolding le_fun_def by auto
+ have u_int_om:"\<And>i. lebesgue.simple_integral (u i) \<noteq> \<omega>"
+ proof- case goal1 thus ?case using int_u_le[of i] int_om by auto qed
+
+ note u_int = simple_function_has_integral'[OF u(1) this]
+ have "(\<lambda>x. real (f x)) integrable_on UNIV \<and>
+ (\<lambda>k. Integration.integral UNIV (\<lambda>x. real (u k x))) ----> Integration.integral UNIV (\<lambda>x. real (f x))"
+ apply(rule monotone_convergence_increasing) apply(rule,rule,rule u_int)
+ proof safe case goal1 show ?case apply(rule real_of_pinfreal_mono) using u(2,3) by auto
+ next case goal2 show ?case using u(3) apply(subst lim_Real[THEN sym])
+ prefer 3 apply(subst Real_real') defer apply(subst Real_real')
+ using isotone_Lim[OF u(3)[unfolded isoton_fun_expand, THEN spec]] using f_om u by auto
+ next case goal3
+ show ?case apply(rule bounded_realI[where B="real (lebesgue.positive_integral f)"])
+ apply safe apply(subst abs_of_nonneg) apply(rule integral_nonneg,rule) apply(rule u_int)
+ unfolding integral_unique[OF u_int] defer apply(rule real_of_pinfreal_mono[OF _ int_u_le])
+ using u int_om by auto
+ qed note int = conjunctD2[OF this]
+
+ have "(\<lambda>i. lebesgue.simple_integral (u i)) ----> ?i" unfolding u_simple
+ apply(rule lebesgue.positive_integral_monotone_convergence(2))
+ apply(rule lebesgue.borel_measurable_simple_function[OF u(1)])
+ using isotone_Lim[OF u(3)[unfolded isoton_fun_expand, THEN spec]] by auto
+ hence "(\<lambda>i. real (lebesgue.simple_integral (u i))) ----> real ?i" apply-
+ apply(subst lim_Real[THEN sym]) prefer 3
+ apply(subst Real_real') defer apply(subst Real_real')
+ using u f_om int_om u_int_om by auto
+ note * = LIMSEQ_unique[OF this int(2)[unfolded integral_unique[OF u_int]]]
+ show ?thesis unfolding * by(rule integrable_integral[OF int(1)])
+qed
+
+lemma lebesgue_integral_has_integral:
+ fixes f::"'a::ordered_euclidean_space => real"
+ assumes f:"lebesgue.integrable f"
+ shows "(f has_integral (lebesgue.integral f)) UNIV"
+proof- let ?n = "\<lambda>x. - min (f x) 0" and ?p = "\<lambda>x. max (f x) 0"
+ have *:"f = (\<lambda>x. ?p x - ?n x)" apply rule by auto
+ note f = lebesgue.integrableD[OF f]
+ show ?thesis unfolding lebesgue.integral_def apply(subst *)
+ proof(rule has_integral_sub) case goal1
+ have *:"\<forall>x. Real (f x) \<noteq> \<omega>" by auto
+ note lebesgue.borel_measurable_Real[OF f(1)]
+ from positive_integral_has_integral[OF this f(2) *]
+ show ?case unfolding real_Real_max .
+ next case goal2
+ have *:"\<forall>x. Real (- f x) \<noteq> \<omega>" by auto
+ note lebesgue.borel_measurable_uminus[OF f(1)]
+ note lebesgue.borel_measurable_Real[OF this]
+ from positive_integral_has_integral[OF this f(3) *]
+ show ?case unfolding real_Real_max minus_min_eq_max by auto
+ qed
+qed
+
+lemma continuous_on_imp_borel_measurable:
+ fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::ordered_euclidean_space"
+ assumes "continuous_on UNIV f"
+ shows "f \<in> borel_measurable lebesgue"
+ apply(rule lebesgue.borel_measurableI)
+ using continuous_open_preimage[OF assms] unfolding vimage_def by auto
+
+lemma (in measure_space) integral_monotone_convergence_pos':
+ assumes i: "\<And>i. integrable (f i)" and mono: "\<And>x. mono (\<lambda>n. f n x)"
+ and pos: "\<And>x i. 0 \<le> f i x"
+ and lim: "\<And>x. (\<lambda>i. f i x) ----> u x"
+ and ilim: "(\<lambda>i. integral (f i)) ----> x"
+ shows "integrable u \<and> integral u = x"
+ using integral_monotone_convergence_pos[OF assms] by auto
+
+definition e2p :: "'a::ordered_euclidean_space \<Rightarrow> (nat \<Rightarrow> real)" where
+ "e2p x = (\<lambda>i\<in>{..<DIM('a)}. x$$i)"
+
+definition p2e :: "(nat \<Rightarrow> real) \<Rightarrow> 'a::ordered_euclidean_space" where
+ "p2e x = (\<chi>\<chi> i. x i)"
+
+lemma bij_euclidean_component:
+ "bij_betw (e2p::'a::ordered_euclidean_space \<Rightarrow> _) (UNIV :: 'a set)
+ ({..<DIM('a)} \<rightarrow>\<^isub>E (UNIV :: real set))"
+ unfolding bij_betw_def e2p_def_raw
+proof let ?e = "\<lambda>x.\<lambda>i\<in>{..<DIM('a::ordered_euclidean_space)}. (x::'a)$$i"
+ show "inj ?e" unfolding inj_on_def restrict_def apply(subst euclidean_eq) apply safe
+ apply(drule_tac x=i in fun_cong) by auto
+ { fix x::"nat \<Rightarrow> real" assume x:"\<forall>i. i \<notin> {..<DIM('a)} \<longrightarrow> x i = undefined"
+ hence "x = ?e (\<chi>\<chi> i. x i)" apply-apply(rule,case_tac "xa<DIM('a)") by auto
+ hence "x \<in> range ?e" by fastsimp
+ } thus "range ?e = ({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)}"
+ unfolding extensional_def using DIM_positive by auto
+qed
+
+lemma bij_p2e:
+ "bij_betw (p2e::_ \<Rightarrow> 'a::ordered_euclidean_space) ({..<DIM('a)} \<rightarrow>\<^isub>E (UNIV :: real set))
+ (UNIV :: 'a set)" (is "bij_betw ?p ?U _")
+ unfolding bij_betw_def
+proof show "inj_on ?p ?U" unfolding inj_on_def p2e_def
+ apply(subst euclidean_eq) apply(safe,rule) unfolding extensional_def
+ apply(case_tac "xa<DIM('a)") by auto
+ { fix x::'a have "x \<in> ?p ` extensional {..<DIM('a)}"
+ unfolding image_iff apply(rule_tac x="\<lambda>i. if i<DIM('a) then x$$i else undefined" in bexI)
+ apply(subst euclidean_eq,safe) unfolding p2e_def extensional_def by auto
+ } thus "?p ` ?U = UNIV" by auto
+qed
+
+lemma e2p_p2e[simp]: fixes z::"'a::ordered_euclidean_space"
+ assumes "x \<in> extensional {..<DIM('a)}"
+ shows "e2p (p2e x::'a) = x"
+proof fix i::nat
+ show "e2p (p2e x::'a) i = x i" unfolding e2p_def p2e_def restrict_def
+ using assms unfolding extensional_def by auto
+qed
+
+lemma p2e_e2p[simp]: fixes x::"'a::ordered_euclidean_space"
+ shows "p2e (e2p x) = x"
+ apply(subst euclidean_eq) unfolding e2p_def p2e_def restrict_def by auto
+
+interpretation borel_product: product_sigma_finite "\<lambda>x. borel::real algebra" "\<lambda>x. lmeasure"
+ by default
+
+lemma cube_subset_Suc[intro]: "cube n \<subseteq> cube (Suc n)"
+ unfolding cube_def_raw subset_eq apply safe unfolding mem_interval by auto
+
+lemma borel_vimage_algebra_eq:
+ "sigma_algebra.vimage_algebra
+ (borel :: ('a::ordered_euclidean_space) algebra) ({..<DIM('a)} \<rightarrow>\<^isub>E UNIV) p2e =
+ sigma (product_algebra (\<lambda>x. \<lparr> space = UNIV::real set, sets = range (\<lambda>a. {..<a}) \<rparr>) {..<DIM('a)} )"
+proof- note bor = borel_eq_lessThan
+ def F \<equiv> "product_algebra (\<lambda>x. \<lparr> space = UNIV::real set, sets = range (\<lambda>a. {..<a}) \<rparr>) {..<DIM('a)}"
+ def E \<equiv> "\<lparr>space = (UNIV::'a set), sets = range lessThan\<rparr>"
+ have *:"(({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)}) = space F" unfolding F_def by auto
+ show ?thesis unfolding F_def[symmetric] * bor
+ proof(rule vimage_algebra_sigma,unfold E_def[symmetric])
+ show "sets E \<subseteq> Pow (space E)" "p2e \<in> space F \<rightarrow> space E" unfolding E_def by auto
+ next fix A assume "A \<in> sets F"
+ hence A:"A \<in> (Pi\<^isub>E {..<DIM('a)}) ` ({..<DIM('a)} \<rightarrow> range lessThan)"
+ unfolding F_def product_algebra_def algebra.simps .
+ then guess B unfolding image_iff .. note B=this
+ hence "\<forall>x<DIM('a). B x \<in> range lessThan" by auto
+ hence "\<forall>x. \<exists>xa. x<DIM('a) \<longrightarrow> B x = {..<xa}" unfolding image_iff by auto
+ from choice[OF this] guess b .. note b=this
+ hence b':"\<forall>i<DIM('a). Sup (B i) = b i" using Sup_lessThan by auto
+
+ show "A \<in> (\<lambda>X. p2e -` X \<inter> space F) ` sets E" unfolding image_iff B
+ proof(rule_tac x="{..< \<chi>\<chi> i. Sup (B i)}" in bexI)
+ show "Pi\<^isub>E {..<DIM('a)} B = p2e -` {..<(\<chi>\<chi> i. Sup (B i))::'a} \<inter> space F"
+ unfolding F_def E_def product_algebra_def algebra.simps
+ proof(rule,unfold subset_eq,rule_tac[!] ballI)
+ fix x assume "x \<in> Pi\<^isub>E {..<DIM('a)} B"
+ hence *:"\<forall>i<DIM('a). x i < b i" "\<forall>i\<ge>DIM('a). x i = undefined"
+ unfolding Pi_def extensional_def using b by auto
+ have "(p2e x::'a) < (\<chi>\<chi> i. Sup (B i))" unfolding less_prod_def eucl_less[of "p2e x"]
+ apply safe unfolding euclidean_lambda_beta b'[rule_format] p2e_def using * by auto
+ moreover have "x \<in> extensional {..<DIM('a)}"
+ using *(2) unfolding extensional_def by auto
+ ultimately show "x \<in> p2e -` {..<(\<chi>\<chi> i. Sup (B i)) ::'a} \<inter>
+ (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})" by auto
+ next fix x assume as:"x \<in> p2e -` {..<(\<chi>\<chi> i. Sup (B i))::'a} \<inter>
+ (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})"
+ hence "p2e x < ((\<chi>\<chi> i. Sup (B i))::'a)" by auto
+ hence "\<forall>i<DIM('a). x i \<in> B i" apply-apply(subst(asm) eucl_less)
+ unfolding p2e_def using b b' by auto
+ thus "x \<in> Pi\<^isub>E {..<DIM('a)} B" using as unfolding Pi_def extensional_def by auto
+ qed
+ show "{..<(\<chi>\<chi> i. Sup (B i))::'a} \<in> sets E" unfolding E_def algebra.simps by auto
+ qed
+ next fix A assume "A \<in> sets E"
+ then guess a unfolding E_def algebra.simps image_iff .. note a = this(2)
+ def B \<equiv> "\<lambda>i. {..<a $$ i}"
+ show "p2e -` A \<inter> space F \<in> sets F" unfolding F_def
+ unfolding product_algebra_def algebra.simps image_iff
+ apply(rule_tac x=B in bexI) apply rule unfolding subset_eq apply(rule_tac[1-2] ballI)
+ proof- show "B \<in> {..<DIM('a)} \<rightarrow> range lessThan" unfolding B_def by auto
+ fix x assume as:"x \<in> p2e -` A \<inter> (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})"
+ hence "p2e x \<in> A" by auto
+ hence "\<forall>i<DIM('a). x i \<in> B i" unfolding B_def a lessThan_iff
+ apply-apply(subst (asm) eucl_less) unfolding p2e_def by auto
+ thus "x \<in> Pi\<^isub>E {..<DIM('a)} B" using as unfolding Pi_def extensional_def by auto
+ next fix x assume x:"x \<in> Pi\<^isub>E {..<DIM('a)} B"
+ moreover have "p2e x \<in> A" unfolding a lessThan_iff p2e_def apply(subst eucl_less)
+ using x unfolding Pi_def extensional_def B_def by auto
+ ultimately show "x \<in> p2e -` A \<inter> (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})" by auto
+ qed
+ qed
+qed
+
+lemma e2p_Int:"e2p ` A \<inter> e2p ` B = e2p ` (A \<inter> B)" (is "?L = ?R")
+ apply(rule image_Int[THEN sym]) using bij_euclidean_component
+ unfolding bij_betw_def by auto
+
+lemma Int_stable_cuboids: fixes x::"'a::ordered_euclidean_space"
+ shows "Int_stable \<lparr>space = UNIV, sets = range (\<lambda>(a, b::'a). e2p ` {a..b})\<rparr>"
+ unfolding Int_stable_def algebra.select_convs
+proof safe fix a b x y::'a
+ have *:"e2p ` {a..b} \<inter> e2p ` {x..y} =
+ (\<lambda>(a, b). e2p ` {a..b}) (\<chi>\<chi> i. max (a $$ i) (x $$ i), \<chi>\<chi> i. min (b $$ i) (y $$ i)::'a)"
+ unfolding e2p_Int inter_interval by auto
+ show "e2p ` {a..b} \<inter> e2p ` {x..y} \<in> range (\<lambda>(a, b). e2p ` {a..b::'a})" unfolding *
+ apply(rule range_eqI) ..
+qed
+
+lemma Int_stable_cuboids': fixes x::"'a::ordered_euclidean_space"
+ shows "Int_stable \<lparr>space = UNIV, sets = range (\<lambda>(a, b::'a). {a..b})\<rparr>"
+ unfolding Int_stable_def algebra.select_convs
+ apply safe unfolding inter_interval by auto
+
+lemma product_borel_eq_vimage:
+ "sigma (product_algebra (\<lambda>x. borel) {..<DIM('a::ordered_euclidean_space)}) =
+ sigma_algebra.vimage_algebra borel (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})
+ (p2e:: _ \<Rightarrow> 'a::ordered_euclidean_space)"
+ unfolding borel_vimage_algebra_eq unfolding borel_eq_lessThan
+ apply(subst sigma_product_algebra_sigma_eq[where S="\<lambda>i. \<lambda>n. lessThan (real n)"])
+ unfolding lessThan_iff
+proof- fix i assume i:"i<DIM('a)"
+ show "(\<lambda>n. {..<real n}) \<up> space \<lparr>space = UNIV, sets = range lessThan\<rparr>"
+ by(auto intro!:real_arch_lt isotoneI)
+qed auto
+
+lemma inj_on_disjoint_family_on: assumes "disjoint_family_on A S" "inj f"
+ shows "disjoint_family_on (\<lambda>x. f ` A x) S"
+ unfolding disjoint_family_on_def
+proof(rule,rule,rule)
+ fix x1 x2 assume x:"x1 \<in> S" "x2 \<in> S" "x1 \<noteq> x2"
+ show "f ` A x1 \<inter> f ` A x2 = {}"
+ proof(rule ccontr) case goal1
+ then obtain z where z:"z \<in> f ` A x1 \<inter> f ` A x2" by auto
+ then obtain z1 z2 where z12:"z1 \<in> A x1" "z2 \<in> A x2" "f z1 = z" "f z2 = z" by auto
+ hence "z1 = z2" using assms(2) unfolding inj_on_def by blast
+ hence "x1 = x2" using z12(1-2) using assms[unfolded disjoint_family_on_def] using x by auto
+ thus False using x(3) by auto
+ qed
+qed
+
+declare restrict_extensional[intro]
+
+lemma e2p_extensional[intro]:"e2p (y::'a::ordered_euclidean_space) \<in> extensional {..<DIM('a)}"
+ unfolding e2p_def by auto
+
+lemma e2p_image_vimage: fixes A::"'a::ordered_euclidean_space set"
+ shows "e2p ` A = p2e -` A \<inter> (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})"
+proof(rule set_eqI,rule)
+ fix x assume "x \<in> e2p ` A" then guess y unfolding image_iff .. note y=this
+ show "x \<in> p2e -` A \<inter> (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})"
+ apply safe apply(rule vimageI[OF _ y(1)]) unfolding y p2e_e2p by auto
+next fix x assume "x \<in> p2e -` A \<inter> (({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)})"
+ thus "x \<in> e2p ` A" unfolding image_iff apply(rule_tac x="p2e x" in bexI) apply(subst e2p_p2e) by auto
+qed
+
+lemma lmeasure_measure_eq_borel_prod:
+ fixes A :: "('a::ordered_euclidean_space) set"
+ assumes "A \<in> sets borel"
+ shows "lmeasure A = borel_product.product_measure {..<DIM('a)} (e2p ` A :: (nat \<Rightarrow> real) set)"
+proof (rule measure_unique_Int_stable[where X=A and A=cube])
+ interpret fprod: finite_product_sigma_finite "\<lambda>x. borel" "\<lambda>x. lmeasure" "{..<DIM('a)}" by default auto
+ show "Int_stable \<lparr> space = UNIV :: 'a set, sets = range (\<lambda>(a,b). {a..b}) \<rparr>"
+ (is "Int_stable ?E" ) using Int_stable_cuboids' .
+ show "borel = sigma ?E" using borel_eq_atLeastAtMost .
+ show "\<And>i. lmeasure (cube i) \<noteq> \<omega>" unfolding lmeasure_cube by auto
+ show "\<And>X. X \<in> sets ?E \<Longrightarrow>
+ lmeasure X = borel_product.product_measure {..<DIM('a)} (e2p ` X :: (nat \<Rightarrow> real) set)"
+ proof- case goal1 then obtain a b where X:"X = {a..b}" by auto
+ { presume *:"X \<noteq> {} \<Longrightarrow> ?case"
+ show ?case apply(cases,rule *,assumption) by auto }
+ def XX \<equiv> "\<lambda>i. {a $$ i .. b $$ i}" assume "X \<noteq> {}" note X' = this[unfolded X interval_ne_empty]
+ have *:"Pi\<^isub>E {..<DIM('a)} XX = e2p ` X" apply(rule set_eqI)
+ proof fix x assume "x \<in> Pi\<^isub>E {..<DIM('a)} XX"
+ thus "x \<in> e2p ` X" unfolding image_iff apply(rule_tac x="\<chi>\<chi> i. x i" in bexI)
+ unfolding Pi_def extensional_def e2p_def restrict_def X mem_interval XX_def by rule auto
+ next fix x assume "x \<in> e2p ` X" then guess y unfolding image_iff .. note y = this
+ show "x \<in> Pi\<^isub>E {..<DIM('a)} XX" unfolding y using y(1)
+ unfolding Pi_def extensional_def e2p_def restrict_def X mem_interval XX_def by auto
+ qed
+ have "lmeasure X = (\<Prod>x<DIM('a). Real (b $$ x - a $$ x))" using X' apply- unfolding X
+ unfolding lmeasure_atLeastAtMost content_closed_interval apply(subst Real_setprod) by auto
+ also have "... = (\<Prod>i<DIM('a). lmeasure (XX i))" apply(rule setprod_cong2)
+ unfolding XX_def lmeasure_atLeastAtMost apply(subst content_real) using X' by auto
+ also have "... = borel_product.product_measure {..<DIM('a)} (e2p ` X)" unfolding *[THEN sym]
+ apply(rule fprod.measure_times[THEN sym]) unfolding XX_def by auto
+ finally show ?case .
+ qed
+
+ show "range cube \<subseteq> sets \<lparr>space = UNIV, sets = range (\<lambda>(a, b). {a..b})\<rparr>"
+ unfolding cube_def_raw by auto
+ have "\<And>x. \<exists>xa. x \<in> cube xa" apply(rule_tac x=x in mem_big_cube) by fastsimp
+ thus "cube \<up> space \<lparr>space = UNIV, sets = range (\<lambda>(a, b). {a..b})\<rparr>"
+ apply-apply(rule isotoneI) apply(rule cube_subset_Suc) by auto
+ show "A \<in> sets borel " by fact
+ show "measure_space borel lmeasure" by default
+ show "measure_space borel
+ (\<lambda>a::'a set. finite_product_sigma_finite.measure (\<lambda>x. borel) (\<lambda>x. lmeasure) {..<DIM('a)} (e2p ` a))"
+ apply default unfolding countably_additive_def
+ proof safe fix A::"nat \<Rightarrow> 'a set" assume A:"range A \<subseteq> sets borel" "disjoint_family A"
+ "(\<Union>i. A i) \<in> sets borel"
+ note fprod.ca[unfolded countably_additive_def,rule_format]
+ note ca = this[of "\<lambda> n. e2p ` (A n)"]
+ show "(\<Sum>\<^isub>\<infinity>n. finite_product_sigma_finite.measure
+ (\<lambda>x. borel) (\<lambda>x. lmeasure) {..<DIM('a)} (e2p ` A n)) =
+ finite_product_sigma_finite.measure (\<lambda>x. borel)
+ (\<lambda>x. lmeasure) {..<DIM('a)} (e2p ` (\<Union>i. A i))" unfolding image_UN
+ proof(rule ca) show "range (\<lambda>n. e2p ` A n) \<subseteq> sets
+ (sigma (product_algebra (\<lambda>x. borel) {..<DIM('a)}))"
+ unfolding product_borel_eq_vimage
+ proof case goal1
+ then guess y unfolding image_iff .. note y=this(2)
+ show ?case unfolding borel.in_vimage_algebra y apply-
+ apply(rule_tac x="A y" in bexI,rule e2p_image_vimage)
+ using A(1) by auto
+ qed
+
+ show "disjoint_family (\<lambda>n. e2p ` A n)" apply(rule inj_on_disjoint_family_on)
+ using bij_euclidean_component using A(2) unfolding bij_betw_def by auto
+ show "(\<Union>n. e2p ` A n) \<in> sets (sigma (product_algebra (\<lambda>x. borel) {..<DIM('a)}))"
+ unfolding product_borel_eq_vimage borel.in_vimage_algebra
+ proof(rule bexI[OF _ A(3)],rule set_eqI,rule)
+ fix x assume x:"x \<in> (\<Union>n. e2p ` A n)" hence "p2e x \<in> (\<Union>i. A i)" by auto
+ moreover have "x \<in> extensional {..<DIM('a)}"
+ using x unfolding extensional_def e2p_def_raw by auto
+ ultimately show "x \<in> p2e -` (\<Union>i. A i) \<inter> (({..<DIM('a)} \<rightarrow> UNIV) \<inter>
+ extensional {..<DIM('a)})" by auto
+ next fix x assume x:"x \<in> p2e -` (\<Union>i. A i) \<inter> (({..<DIM('a)} \<rightarrow> UNIV) \<inter>
+ extensional {..<DIM('a)})"
+ hence "p2e x \<in> (\<Union>i. A i)" by auto
+ hence "\<exists>n. x \<in> e2p ` A n" apply safe apply(rule_tac x=i in exI)
+ unfolding image_iff apply(rule_tac x="p2e x" in bexI)
+ apply(subst e2p_p2e) using x by auto
+ thus "x \<in> (\<Union>n. e2p ` A n)" by auto
+ qed
+ qed
+ qed auto
+qed
+
+lemma e2p_p2e'[simp]: fixes x::"'a::ordered_euclidean_space"
+ assumes "A \<subseteq> extensional {..<DIM('a)}"
+ shows "e2p ` (p2e ` A ::'a set) = A"
+ apply(rule set_eqI) unfolding image_iff Bex_def apply safe defer
+ apply(rule_tac x="p2e x" in exI,safe) using assms by auto
+
+lemma range_p2e:"range (p2e::_\<Rightarrow>'a::ordered_euclidean_space) = UNIV"
+ apply safe defer unfolding image_iff apply(rule_tac x="\<lambda>i. x $$ i" in bexI)
+ unfolding p2e_def by auto
+
+lemma p2e_inv_extensional:"(A::'a::ordered_euclidean_space set)
+ = p2e ` (p2e -` A \<inter> extensional {..<DIM('a)})"
+ unfolding p2e_def_raw apply safe unfolding image_iff
+proof- fix x assume "x\<in>A"
+ let ?y = "\<lambda>i. if i<DIM('a) then x$$i else undefined"
+ have *:"Chi ?y = x" apply(subst euclidean_eq) by auto
+ show "\<exists>xa\<in>Chi -` A \<inter> extensional {..<DIM('a)}. x = Chi xa" apply(rule_tac x="?y" in bexI)
+ apply(subst euclidean_eq) unfolding extensional_def using `x\<in>A` by(auto simp: *)
+qed
+
+lemma borel_fubini_positiv_integral:
+ fixes f :: "'a::ordered_euclidean_space \<Rightarrow> pinfreal"
+ assumes f: "f \<in> borel_measurable borel"
+ shows "borel.positive_integral f =
+ borel_product.product_positive_integral {..<DIM('a)} (f \<circ> p2e)"
+proof- def U \<equiv> "(({..<DIM('a)} \<rightarrow> UNIV) \<inter> extensional {..<DIM('a)}):: (nat \<Rightarrow> real) set"
+ interpret fprod: finite_product_sigma_finite "\<lambda>x. borel" "\<lambda>x. lmeasure" "{..<DIM('a)}" by default auto
+ have "\<And>x. \<exists>i::nat. x < real i" by (metis real_arch_lt)
+ hence "(\<lambda>n::nat. {..<real n}) \<up> UNIV" apply-apply(rule isotoneI) by auto
+ hence *:"sigma_algebra.vimage_algebra borel U (p2e:: _ \<Rightarrow> 'a)
+ = sigma (product_algebra (\<lambda>x. borel) {..<DIM('a)})"
+ unfolding U_def apply-apply(subst borel_vimage_algebra_eq)
+ apply(subst sigma_product_algebra_sigma_eq[where S="\<lambda>x. \<lambda>n. {..<(\<chi>\<chi> i. real n)}", THEN sym])
+ unfolding borel_eq_lessThan[THEN sym] by auto
+ show ?thesis unfolding borel.positive_integral_vimage[unfolded space_borel,OF bij_p2e]
+ apply(subst fprod.positive_integral_cong_measure[THEN sym, of "\<lambda>A. lmeasure (p2e ` A)"])
+ unfolding U_def[symmetric] *[THEN sym] o_def
+ proof- fix A assume A:"A \<in> sets (sigma_algebra.vimage_algebra borel U (p2e ::_ \<Rightarrow> 'a))"
+ hence *:"A \<subseteq> extensional {..<DIM('a)}" unfolding U_def by auto
+ from A guess B unfolding borel.in_vimage_algebra U_def .. note B=this
+ have "(p2e ` A::'a set) \<in> sets borel" unfolding B apply(subst Int_left_commute)
+ apply(subst Int_absorb1) unfolding p2e_inv_extensional[of B,THEN sym] using B(1) by auto
+ from lmeasure_measure_eq_borel_prod[OF this] show "lmeasure (p2e ` A::'a set) =
+ finite_product_sigma_finite.measure (\<lambda>x. borel) (\<lambda>x. lmeasure) {..<DIM('a)} A"
+ unfolding e2p_p2e'[OF *] .
+ qed auto
+qed
+
+lemma borel_fubini:
+ fixes f :: "'a::ordered_euclidean_space \<Rightarrow> real"
+ assumes f: "f \<in> borel_measurable borel"
+ shows "borel.integral f = borel_product.product_integral {..<DIM('a)} (f \<circ> p2e)"
+proof- interpret fprod: finite_product_sigma_finite "\<lambda>x. borel" "\<lambda>x. lmeasure" "{..<DIM('a)}" by default auto
+ have 1:"(\<lambda>x. Real (f x)) \<in> borel_measurable borel" using f by auto
+ have 2:"(\<lambda>x. Real (- f x)) \<in> borel_measurable borel" using f by auto
+ show ?thesis unfolding fprod.integral_def borel.integral_def
+ unfolding borel_fubini_positiv_integral[OF 1] borel_fubini_positiv_integral[OF 2]
+ unfolding o_def ..
qed
end
--- a/src/HOL/Probability/Measure.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Measure.thy Thu Dec 02 11:18:44 2010 -0800
@@ -1,10 +1,47 @@
-header {*Measures*}
+(* Author: Lawrence C Paulson; Armin Heller, Johannes Hoelzl, TU Muenchen *)
theory Measure
imports Caratheodory
begin
-text{*From the Hurd/Coble measure theory development, translated by Lawrence Paulson.*}
+lemma inj_on_image_eq_iff:
+ assumes "inj_on f S"
+ assumes "A \<subseteq> S" "B \<subseteq> S"
+ shows "(f ` A = f ` B) \<longleftrightarrow> (A = B)"
+proof -
+ have "inj_on f (A \<union> B)"
+ using assms by (auto intro: subset_inj_on)
+ from inj_on_Un_image_eq_iff[OF this]
+ show ?thesis .
+qed
+
+lemma image_vimage_inter_eq:
+ assumes "f ` S = T" "X \<subseteq> T"
+ shows "f ` (f -` X \<inter> S) = X"
+proof (intro antisym)
+ have "f ` (f -` X \<inter> S) \<subseteq> f ` (f -` X)" by auto
+ also have "\<dots> = X \<inter> range f" by simp
+ also have "\<dots> = X" using assms by auto
+ finally show "f ` (f -` X \<inter> S) \<subseteq> X" by auto
+next
+ show "X \<subseteq> f ` (f -` X \<inter> S)"
+ proof
+ fix x assume "x \<in> X"
+ then have "x \<in> T" using `X \<subseteq> T` by auto
+ then obtain y where "x = f y" "y \<in> S"
+ using assms by auto
+ then have "{y} \<subseteq> f -` X \<inter> S" using `x \<in> X` by auto
+ moreover have "x \<in> f ` {y}" using `x = f y` by auto
+ ultimately show "x \<in> f ` (f -` X \<inter> S)" by auto
+ qed
+qed
+
+text {*
+ This formalisation of measure theory is based on the work of Hurd/Coble wand
+ was later translated by Lawrence Paulson to Isabelle/HOL. Later it was
+ modified to use the positive infinite reals and to prove the uniqueness of
+ cut stable measures.
+*}
section {* Equations for the measure function @{text \<mu>} *}
@@ -157,11 +194,19 @@
qed
lemma (in measure_space) measure_up:
- assumes "P \<in> sets M" "\<And>i. B i \<in> sets M" "B \<up> P"
+ assumes "\<And>i. B i \<in> sets M" "B \<up> P"
shows "(\<lambda>i. \<mu> (B i)) \<up> \<mu> P"
using assms unfolding isoton_def
by (auto intro!: measure_mono continuity_from_below)
+lemma (in measure_space) continuity_from_below':
+ assumes A: "range A \<subseteq> sets M" "\<And>i. A i \<subseteq> A (Suc i)"
+ shows "(\<lambda>i. (\<mu> (A i))) ----> (\<mu> (\<Union>i. A i))"
+proof- let ?A = "\<Union>i. A i"
+ have " (\<lambda>i. \<mu> (A i)) \<up> \<mu> ?A" apply(rule measure_up)
+ using assms unfolding complete_lattice_class.isoton_def by auto
+ thus ?thesis by(rule isotone_Lim(1))
+qed
lemma (in measure_space) continuity_from_above:
assumes A: "range A \<subseteq> sets M"
@@ -196,7 +241,7 @@
qed
lemma (in measure_space) measure_down:
- assumes "P \<in> sets M" "\<And>i. B i \<in> sets M" "B \<down> P"
+ assumes "\<And>i. B i \<in> sets M" "B \<down> P"
and finite: "\<And>i. \<mu> (B i) \<noteq> \<omega>"
shows "(\<lambda>i. \<mu> (B i)) \<down> \<mu> P"
using assms unfolding antiton_def
@@ -414,6 +459,11 @@
finally show ?thesis .
qed
+lemma (in measure_space) measure_eq_0:
+ assumes "N \<in> sets M" and "\<mu> N = 0" and "K \<subseteq> N" and "K \<in> sets M"
+ shows "\<mu> K = 0"
+using measure_mono[OF assms(3,4,1)] assms(2) by auto
+
lemma (in measure_space) measure_finitely_subadditive:
assumes "finite I" "A ` I \<subseteq> sets M"
shows "\<mu> (\<Union>i\<in>I. A i) \<le> (\<Sum>i\<in>I. \<mu> (A i))"
@@ -427,7 +477,7 @@
finally show ?case .
qed simp
-lemma (in measure_space) measurable_countably_subadditive:
+lemma (in measure_space) measure_countably_subadditive:
assumes "range f \<subseteq> sets M"
shows "\<mu> (\<Union>i. f i) \<le> (\<Sum>\<^isub>\<infinity> i. \<mu> (f i))"
proof -
@@ -445,6 +495,11 @@
finally show ?thesis .
qed
+lemma (in measure_space) measure_UN_eq_0:
+ assumes "\<And> i :: nat. \<mu> (N i) = 0" and "range N \<subseteq> sets M"
+ shows "\<mu> (\<Union> i. N i) = 0"
+using measure_countably_subadditive[OF assms(2)] assms(1) by auto
+
lemma (in measure_space) measure_inter_full_set:
assumes "S \<in> sets M" "T \<in> sets M" and not_\<omega>: "\<mu> (T - S) \<noteq> \<omega>"
assumes T: "\<mu> T = \<mu> (space M)"
@@ -470,6 +525,353 @@
qed
qed
+lemma measure_unique_Int_stable:
+ fixes M E :: "'a algebra" and A :: "nat \<Rightarrow> 'a set"
+ assumes "Int_stable E" "M = sigma E"
+ and A: "range A \<subseteq> sets E" "A \<up> space E"
+ and ms: "measure_space M \<mu>" "measure_space M \<nu>"
+ and eq: "\<And>X. X \<in> sets E \<Longrightarrow> \<mu> X = \<nu> X"
+ and finite: "\<And>i. \<mu> (A i) \<noteq> \<omega>"
+ assumes "X \<in> sets M"
+ shows "\<mu> X = \<nu> X"
+proof -
+ let "?D F" = "{D. D \<in> sets M \<and> \<mu> (F \<inter> D) = \<nu> (F \<inter> D)}"
+ interpret M: measure_space M \<mu> by fact
+ interpret M': measure_space M \<nu> by fact
+ have "space E = space M"
+ using `M = sigma E` by simp
+ have sets_E: "sets E \<subseteq> Pow (space E)"
+ proof
+ fix X assume "X \<in> sets E"
+ then have "X \<in> sets M" unfolding `M = sigma E`
+ unfolding sigma_def by (auto intro!: sigma_sets.Basic)
+ with M.sets_into_space show "X \<in> Pow (space E)"
+ unfolding `space E = space M` by auto
+ qed
+ have A': "range A \<subseteq> sets M" using `M = sigma E` A
+ by (auto simp: sets_sigma intro!: sigma_sets.Basic)
+ { fix F assume "F \<in> sets E" and "\<mu> F \<noteq> \<omega>"
+ then have [intro]: "F \<in> sets M" unfolding `M = sigma E` sets_sigma
+ by (intro sigma_sets.Basic)
+ have "\<nu> F \<noteq> \<omega>" using `\<mu> F \<noteq> \<omega>` `F \<in> sets E` eq by simp
+ interpret D: dynkin_system "\<lparr>space=space E, sets=?D F\<rparr>"
+ proof (rule dynkin_systemI, simp_all)
+ fix A assume "A \<in> sets M \<and> \<mu> (F \<inter> A) = \<nu> (F \<inter> A)"
+ then show "A \<subseteq> space E"
+ unfolding `space E = space M` using M.sets_into_space by auto
+ next
+ have "F \<inter> space E = F" using `F \<in> sets E` sets_E by auto
+ then show "space E \<in> sets M \<and> \<mu> (F \<inter> space E) = \<nu> (F \<inter> space E)"
+ unfolding `space E = space M` using `F \<in> sets E` eq by auto
+ next
+ fix A assume *: "A \<in> sets M \<and> \<mu> (F \<inter> A) = \<nu> (F \<inter> A)"
+ then have **: "F \<inter> (space M - A) = F - (F \<inter> A)"
+ and [intro]: "F \<inter> A \<in> sets M"
+ using `F \<in> sets E` sets_E `space E = space M` by auto
+ have "\<nu> (F \<inter> A) \<le> \<nu> F" by (auto intro!: M'.measure_mono)
+ then have "\<nu> (F \<inter> A) \<noteq> \<omega>" using `\<nu> F \<noteq> \<omega>` by auto
+ have "\<mu> (F \<inter> A) \<le> \<mu> F" by (auto intro!: M.measure_mono)
+ then have "\<mu> (F \<inter> A) \<noteq> \<omega>" using `\<mu> F \<noteq> \<omega>` by auto
+ then have "\<mu> (F \<inter> (space M - A)) = \<mu> F - \<mu> (F \<inter> A)" unfolding **
+ using `F \<inter> A \<in> sets M` by (auto intro!: M.measure_Diff)
+ also have "\<dots> = \<nu> F - \<nu> (F \<inter> A)" using eq `F \<in> sets E` * by simp
+ also have "\<dots> = \<nu> (F \<inter> (space M - A))" unfolding **
+ using `F \<inter> A \<in> sets M` `\<nu> (F \<inter> A) \<noteq> \<omega>` by (auto intro!: M'.measure_Diff[symmetric])
+ finally show "space E - A \<in> sets M \<and> \<mu> (F \<inter> (space E - A)) = \<nu> (F \<inter> (space E - A))"
+ using `space E = space M` * by auto
+ next
+ fix A :: "nat \<Rightarrow> 'a set"
+ assume "disjoint_family A" "range A \<subseteq> {X \<in> sets M. \<mu> (F \<inter> X) = \<nu> (F \<inter> X)}"
+ then have A: "range (\<lambda>i. F \<inter> A i) \<subseteq> sets M" "F \<inter> (\<Union>x. A x) = (\<Union>x. F \<inter> A x)"
+ "disjoint_family (\<lambda>i. F \<inter> A i)" "\<And>i. \<mu> (F \<inter> A i) = \<nu> (F \<inter> A i)" "range A \<subseteq> sets M"
+ by ((fastsimp simp: disjoint_family_on_def)+)
+ then show "(\<Union>x. A x) \<in> sets M \<and> \<mu> (F \<inter> (\<Union>x. A x)) = \<nu> (F \<inter> (\<Union>x. A x))"
+ by (auto simp: M.measure_countably_additive[symmetric]
+ M'.measure_countably_additive[symmetric]
+ simp del: UN_simps)
+ qed
+ have *: "sigma E = \<lparr>space = space E, sets = ?D F\<rparr>"
+ using `M = sigma E` `F \<in> sets E` `Int_stable E`
+ by (intro D.dynkin_lemma)
+ (auto simp add: sets_sigma Int_stable_def eq intro: sigma_sets.Basic)
+ have "\<And>D. D \<in> sets M \<Longrightarrow> \<mu> (F \<inter> D) = \<nu> (F \<inter> D)"
+ unfolding `M = sigma E` by (auto simp: *) }
+ note * = this
+ { fix i have "\<mu> (A i \<inter> X) = \<nu> (A i \<inter> X)"
+ using *[of "A i" X] `X \<in> sets M` A finite by auto }
+ moreover
+ have "(\<lambda>i. A i \<inter> X) \<up> X"
+ using `X \<in> sets M` M.sets_into_space A `space E = space M`
+ by (auto simp: isoton_def)
+ then have "(\<lambda>i. \<mu> (A i \<inter> X)) \<up> \<mu> X" "(\<lambda>i. \<nu> (A i \<inter> X)) \<up> \<nu> X"
+ using `X \<in> sets M` A' by (auto intro!: M.measure_up M'.measure_up M.Int)
+ ultimately show ?thesis by (simp add: isoton_def)
+qed
+
+section "Isomorphisms between measure spaces"
+
+lemma (in measure_space) measure_space_isomorphic:
+ fixes f :: "'c \<Rightarrow> 'a"
+ assumes "bij_betw f S (space M)"
+ shows "measure_space (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A))"
+ (is "measure_space ?T ?\<mu>")
+proof -
+ have "f \<in> S \<rightarrow> space M" using assms unfolding bij_betw_def by auto
+ then interpret T: sigma_algebra ?T by (rule sigma_algebra_vimage)
+ show ?thesis
+ proof
+ show "\<mu> (f`{}) = 0" by simp
+ show "countably_additive ?T (\<lambda>A. \<mu> (f ` A))"
+ proof (unfold countably_additive_def, intro allI impI)
+ fix A :: "nat \<Rightarrow> 'c set" assume "range A \<subseteq> sets ?T" "disjoint_family A"
+ then have "\<forall>i. \<exists>F'. F' \<in> sets M \<and> A i = f -` F' \<inter> S"
+ by (auto simp: image_iff image_subset_iff Bex_def vimage_algebra_def)
+ from choice[OF this] obtain F where F: "\<And>i. F i \<in> sets M" and A: "\<And>i. A i = f -` F i \<inter> S" by auto
+ then have [simp]: "\<And>i. f ` (A i) = F i"
+ using sets_into_space assms
+ by (force intro!: image_vimage_inter_eq[where T="space M"] simp: bij_betw_def)
+ have "disjoint_family F"
+ proof (intro disjoint_family_on_bisimulation[OF `disjoint_family A`])
+ fix n m assume "A n \<inter> A m = {}"
+ then have "f -` (F n \<inter> F m) \<inter> S = {}" unfolding A by auto
+ moreover
+ have "F n \<in> sets M" "F m \<in> sets M" using F by auto
+ then have "f`S = space M" "F n \<inter> F m \<subseteq> space M"
+ using sets_into_space assms by (auto simp: bij_betw_def)
+ note image_vimage_inter_eq[OF this, symmetric]
+ ultimately show "F n \<inter> F m = {}" by simp
+ qed
+ with F show "(\<Sum>\<^isub>\<infinity> i. \<mu> (f ` A i)) = \<mu> (f ` (\<Union>i. A i))"
+ by (auto simp add: image_UN intro!: measure_countably_additive)
+ qed
+ qed
+qed
+
+section "@{text \<mu>}-null sets"
+
+abbreviation (in measure_space) "null_sets \<equiv> {N\<in>sets M. \<mu> N = 0}"
+
+lemma (in measure_space) null_sets_Un[intro]:
+ assumes "N \<in> null_sets" "N' \<in> null_sets"
+ shows "N \<union> N' \<in> null_sets"
+proof (intro conjI CollectI)
+ show "N \<union> N' \<in> sets M" using assms by auto
+ have "\<mu> (N \<union> N') \<le> \<mu> N + \<mu> N'"
+ using assms by (intro measure_subadditive) auto
+ then show "\<mu> (N \<union> N') = 0"
+ using assms by auto
+qed
+
+lemma UN_from_nat: "(\<Union>i. N i) = (\<Union>i. N (Countable.from_nat i))"
+proof -
+ have "(\<Union>i. N i) = (\<Union>i. (N \<circ> Countable.from_nat) i)"
+ unfolding SUPR_def image_compose
+ unfolding surj_from_nat ..
+ then show ?thesis by simp
+qed
+
+lemma (in measure_space) null_sets_UN[intro]:
+ assumes "\<And>i::'i::countable. N i \<in> null_sets"
+ shows "(\<Union>i. N i) \<in> null_sets"
+proof (intro conjI CollectI)
+ show "(\<Union>i. N i) \<in> sets M" using assms by auto
+ have "\<mu> (\<Union>i. N i) \<le> (\<Sum>\<^isub>\<infinity> n. \<mu> (N (Countable.from_nat n)))"
+ unfolding UN_from_nat[of N]
+ using assms by (intro measure_countably_subadditive) auto
+ then show "\<mu> (\<Union>i. N i) = 0"
+ using assms by auto
+qed
+
+lemma (in measure_space) null_sets_finite_UN:
+ assumes "finite S" "\<And>i. i \<in> S \<Longrightarrow> A i \<in> null_sets"
+ shows "(\<Union>i\<in>S. A i) \<in> null_sets"
+proof (intro CollectI conjI)
+ show "(\<Union>i\<in>S. A i) \<in> sets M" using assms by (intro finite_UN) auto
+ have "\<mu> (\<Union>i\<in>S. A i) \<le> (\<Sum>i\<in>S. \<mu> (A i))"
+ using assms by (intro measure_finitely_subadditive) auto
+ then show "\<mu> (\<Union>i\<in>S. A i) = 0"
+ using assms by auto
+qed
+
+lemma (in measure_space) null_set_Int1:
+ assumes "B \<in> null_sets" "A \<in> sets M" shows "A \<inter> B \<in> null_sets"
+using assms proof (intro CollectI conjI)
+ show "\<mu> (A \<inter> B) = 0" using assms by (intro measure_eq_0[of B "A \<inter> B"]) auto
+qed auto
+
+lemma (in measure_space) null_set_Int2:
+ assumes "B \<in> null_sets" "A \<in> sets M" shows "B \<inter> A \<in> null_sets"
+ using assms by (subst Int_commute) (rule null_set_Int1)
+
+lemma (in measure_space) measure_Diff_null_set:
+ assumes "B \<in> null_sets" "A \<in> sets M"
+ shows "\<mu> (A - B) = \<mu> A"
+proof -
+ have *: "A - B = (A - (A \<inter> B))" by auto
+ have "A \<inter> B \<in> null_sets" using assms by (rule null_set_Int1)
+ then show ?thesis
+ unfolding * using assms
+ by (subst measure_Diff) auto
+qed
+
+lemma (in measure_space) null_set_Diff:
+ assumes "B \<in> null_sets" "A \<in> sets M" shows "B - A \<in> null_sets"
+using assms proof (intro CollectI conjI)
+ show "\<mu> (B - A) = 0" using assms by (intro measure_eq_0[of B "B - A"]) auto
+qed auto
+
+lemma (in measure_space) measure_Un_null_set:
+ assumes "A \<in> sets M" "B \<in> null_sets"
+ shows "\<mu> (A \<union> B) = \<mu> A"
+proof -
+ have *: "A \<union> B = A \<union> (B - A)" by auto
+ have "B - A \<in> null_sets" using assms(2,1) by (rule null_set_Diff)
+ then show ?thesis
+ unfolding * using assms
+ by (subst measure_additive[symmetric]) auto
+qed
+
+section "Formalise almost everywhere"
+
+definition (in measure_space)
+ almost_everywhere :: "('a \<Rightarrow> bool) \<Rightarrow> bool" (binder "AE " 10) where
+ "almost_everywhere P \<longleftrightarrow> (\<exists>N\<in>null_sets. { x \<in> space M. \<not> P x } \<subseteq> N)"
+
+lemma (in measure_space) AE_I':
+ "N \<in> null_sets \<Longrightarrow> {x\<in>space M. \<not> P x} \<subseteq> N \<Longrightarrow> (AE x. P x)"
+ unfolding almost_everywhere_def by auto
+
+lemma (in measure_space) AE_iff_null_set:
+ assumes "{x\<in>space M. \<not> P x} \<in> sets M" (is "?P \<in> sets M")
+ shows "(AE x. P x) \<longleftrightarrow> {x\<in>space M. \<not> P x} \<in> null_sets"
+proof
+ assume "AE x. P x" then obtain N where N: "N \<in> sets M" "?P \<subseteq> N" "\<mu> N = 0"
+ unfolding almost_everywhere_def by auto
+ moreover have "\<mu> ?P \<le> \<mu> N"
+ using assms N(1,2) by (auto intro: measure_mono)
+ ultimately show "?P \<in> null_sets" using assms by auto
+next
+ assume "?P \<in> null_sets" with assms show "AE x. P x" by (auto intro: AE_I')
+qed
+
+lemma (in measure_space) AE_True[intro, simp]: "AE x. True"
+ unfolding almost_everywhere_def by auto
+
+lemma (in measure_space) AE_E[consumes 1]:
+ assumes "AE x. P x"
+ obtains N where "{x \<in> space M. \<not> P x} \<subseteq> N" "\<mu> N = 0" "N \<in> sets M"
+ using assms unfolding almost_everywhere_def by auto
+
+lemma (in measure_space) AE_I:
+ assumes "{x \<in> space M. \<not> P x} \<subseteq> N" "\<mu> N = 0" "N \<in> sets M"
+ shows "AE x. P x"
+ using assms unfolding almost_everywhere_def by auto
+
+lemma (in measure_space) AE_mp:
+ assumes AE_P: "AE x. P x" and AE_imp: "AE x. P x \<longrightarrow> Q x"
+ shows "AE x. Q x"
+proof -
+ from AE_P obtain A where P: "{x\<in>space M. \<not> P x} \<subseteq> A"
+ and A: "A \<in> sets M" "\<mu> A = 0"
+ by (auto elim!: AE_E)
+
+ from AE_imp obtain B where imp: "{x\<in>space M. P x \<and> \<not> Q x} \<subseteq> B"
+ and B: "B \<in> sets M" "\<mu> B = 0"
+ by (auto elim!: AE_E)
+
+ show ?thesis
+ proof (intro AE_I)
+ show "A \<union> B \<in> sets M" "\<mu> (A \<union> B) = 0" using A B
+ using measure_subadditive[of A B] by auto
+ show "{x\<in>space M. \<not> Q x} \<subseteq> A \<union> B"
+ using P imp by auto
+ qed
+qed
+
+lemma (in measure_space) AE_iffI:
+ assumes P: "AE x. P x" and Q: "AE x. P x \<longleftrightarrow> Q x" shows "AE x. Q x"
+ using AE_mp[OF Q, of "\<lambda>x. P x \<longrightarrow> Q x"] AE_mp[OF P, of Q] by auto
+
+lemma (in measure_space) AE_disjI1:
+ assumes P: "AE x. P x" shows "AE x. P x \<or> Q x"
+ by (rule AE_mp[OF P]) auto
+
+lemma (in measure_space) AE_disjI2:
+ assumes P: "AE x. Q x" shows "AE x. P x \<or> Q x"
+ by (rule AE_mp[OF P]) auto
+
+lemma (in measure_space) AE_conjI:
+ assumes AE_P: "AE x. P x" and AE_Q: "AE x. Q x"
+ shows "AE x. P x \<and> Q x"
+proof -
+ from AE_P obtain A where P: "{x\<in>space M. \<not> P x} \<subseteq> A"
+ and A: "A \<in> sets M" "\<mu> A = 0"
+ by (auto elim!: AE_E)
+
+ from AE_Q obtain B where Q: "{x\<in>space M. \<not> Q x} \<subseteq> B"
+ and B: "B \<in> sets M" "\<mu> B = 0"
+ by (auto elim!: AE_E)
+
+ show ?thesis
+ proof (intro AE_I)
+ show "A \<union> B \<in> sets M" "\<mu> (A \<union> B) = 0" using A B
+ using measure_subadditive[of A B] by auto
+ show "{x\<in>space M. \<not> (P x \<and> Q x)} \<subseteq> A \<union> B"
+ using P Q by auto
+ qed
+qed
+
+lemma (in measure_space) AE_E2:
+ assumes "AE x. P x" "{x\<in>space M. P x} \<in> sets M"
+ shows "\<mu> {x\<in>space M. \<not> P x} = 0" (is "\<mu> ?P = 0")
+proof -
+ obtain A where A: "?P \<subseteq> A" "A \<in> sets M" "\<mu> A = 0"
+ using assms by (auto elim!: AE_E)
+ have "?P = space M - {x\<in>space M. P x}" by auto
+ then have "?P \<in> sets M" using assms by auto
+ with assms `?P \<subseteq> A` `A \<in> sets M` have "\<mu> ?P \<le> \<mu> A"
+ by (auto intro!: measure_mono)
+ then show "\<mu> ?P = 0" using A by simp
+qed
+
+lemma (in measure_space) AE_space[simp, intro]: "AE x. x \<in> space M"
+ by (rule AE_I[where N="{}"]) auto
+
+lemma (in measure_space) AE_cong:
+ assumes "\<And>x. x \<in> space M \<Longrightarrow> P x" shows "AE x. P x"
+proof -
+ have [simp]: "\<And>x. (x \<in> space M \<longrightarrow> P x) \<longleftrightarrow> True" using assms by auto
+ show ?thesis
+ by (rule AE_mp[OF AE_space]) auto
+qed
+
+lemma (in measure_space) AE_conj_iff[simp]:
+ shows "(AE x. P x \<and> Q x) \<longleftrightarrow> (AE x. P x) \<and> (AE x. Q x)"
+proof (intro conjI iffI AE_conjI)
+ assume *: "AE x. P x \<and> Q x"
+ from * show "AE x. P x" by (rule AE_mp) auto
+ from * show "AE x. Q x" by (rule AE_mp) auto
+qed auto
+
+lemma (in measure_space) all_AE_countable:
+ "(\<forall>i::'i::countable. AE x. P i x) \<longleftrightarrow> (AE x. \<forall>i. P i x)"
+proof
+ assume "\<forall>i. AE x. P i x"
+ from this[unfolded almost_everywhere_def Bex_def, THEN choice]
+ obtain N where N: "\<And>i. N i \<in> null_sets" "\<And>i. {x\<in>space M. \<not> P i x} \<subseteq> N i" by auto
+ have "{x\<in>space M. \<not> (\<forall>i. P i x)} \<subseteq> (\<Union>i. {x\<in>space M. \<not> P i x})" by auto
+ also have "\<dots> \<subseteq> (\<Union>i. N i)" using N by auto
+ finally have "{x\<in>space M. \<not> (\<forall>i. P i x)} \<subseteq> (\<Union>i. N i)" .
+ moreover from N have "(\<Union>i. N i) \<in> null_sets"
+ by (intro null_sets_UN) auto
+ ultimately show "AE x. \<forall>i. P i x"
+ unfolding almost_everywhere_def by auto
+next
+ assume *: "AE x. \<forall>i. P i x"
+ show "\<forall>i. AE x. P i x"
+ by (rule allI, rule AE_mp[OF *]) simp
+qed
+
lemma (in measure_space) restricted_measure_space:
assumes "S \<in> sets M"
shows "measure_space (restricted_space S) \<mu>"
@@ -490,6 +892,7 @@
qed
lemma (in measure_space) measure_space_vimage:
+ fixes M' :: "'b algebra"
assumes "f \<in> measurable M M'"
and "sigma_algebra M'"
shows "measure_space M' (\<lambda>A. \<mu> (f -` A \<inter> space M))" (is "measure_space M' ?T")
@@ -502,7 +905,7 @@
show "countably_additive M' ?T"
proof (unfold countably_additive_def, safe)
- fix A :: "nat \<Rightarrow> 'c set" assume "range A \<subseteq> sets M'" "disjoint_family A"
+ fix A :: "nat \<Rightarrow> 'b set" assume "range A \<subseteq> sets M'" "disjoint_family A"
hence *: "\<And>i. f -` (A i) \<inter> space M \<in> sets M"
using `f \<in> measurable M M'` by (auto simp: measurable_def)
moreover have "(\<Union>i. f -` A i \<inter> space M) \<in> sets M"
@@ -564,6 +967,20 @@
qed
qed
+lemma (in sigma_finite_measure) sigma_finite_measure_cong:
+ assumes cong: "\<And>A. A \<in> sets M \<Longrightarrow> \<mu>' A = \<mu> A"
+ shows "sigma_finite_measure M \<mu>'"
+proof -
+ interpret \<mu>': measure_space M \<mu>'
+ using cong by (rule measure_space_cong)
+ from sigma_finite guess A .. note A = this
+ then have "\<And>i. A i \<in> sets M" by auto
+ with A have fin: "(\<forall>i. \<mu>' (A i) \<noteq> \<omega>)" using cong by auto
+ show ?thesis
+ apply default
+ using A fin by auto
+qed
+
lemma (in sigma_finite_measure) disjoint_sigma_finite:
"\<exists>A::nat\<Rightarrow>'a set. range A \<subseteq> sets M \<and> (\<Union>i. A i) = space M \<and>
(\<forall>i. \<mu> (A i) \<noteq> \<omega>) \<and> disjoint_family A"
@@ -583,6 +1000,50 @@
show ?thesis by (auto intro!: exI[of _ "disjointed A"])
qed
+lemma (in sigma_finite_measure) sigma_finite_up:
+ "\<exists>F. range F \<subseteq> sets M \<and> F \<up> space M \<and> (\<forall>i. \<mu> (F i) \<noteq> \<omega>)"
+proof -
+ obtain F :: "nat \<Rightarrow> 'a set" where
+ F: "range F \<subseteq> sets M" "(\<Union>i. F i) = space M" "\<And>i. \<mu> (F i) \<noteq> \<omega>"
+ using sigma_finite by auto
+ then show ?thesis unfolding isoton_def
+ proof (intro exI[of _ "\<lambda>n. \<Union>i\<le>n. F i"] conjI allI)
+ from F have "\<And>x. x \<in> space M \<Longrightarrow> \<exists>i. x \<in> F i" by auto
+ then show "(\<Union>n. \<Union> i\<le>n. F i) = space M"
+ using F by fastsimp
+ next
+ fix n
+ have "\<mu> (\<Union> i\<le>n. F i) \<le> (\<Sum>i\<le>n. \<mu> (F i))" using F
+ by (auto intro!: measure_finitely_subadditive)
+ also have "\<dots> < \<omega>"
+ using F by (auto simp: setsum_\<omega>)
+ finally show "\<mu> (\<Union> i\<le>n. F i) \<noteq> \<omega>" by simp
+ qed force+
+qed
+
+lemma (in sigma_finite_measure) sigma_finite_measure_isomorphic:
+ assumes f: "bij_betw f S (space M)"
+ shows "sigma_finite_measure (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A))"
+proof -
+ interpret M: measure_space "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
+ using f by (rule measure_space_isomorphic)
+ show ?thesis
+ proof default
+ from sigma_finite guess A::"nat \<Rightarrow> 'a set" .. note A = this
+ show "\<exists>A::nat\<Rightarrow>'b set. range A \<subseteq> sets (vimage_algebra S f) \<and> (\<Union>i. A i) = space (vimage_algebra S f) \<and> (\<forall>i. \<mu> (f ` A i) \<noteq> \<omega>)"
+ proof (intro exI conjI)
+ show "(\<Union>i::nat. f -` A i \<inter> S) = space (vimage_algebra S f)"
+ using A f[THEN bij_betw_imp_funcset] by (auto simp: vimage_UN[symmetric])
+ show "range (\<lambda>i. f -` A i \<inter> S) \<subseteq> sets (vimage_algebra S f)"
+ using A by (auto simp: vimage_algebra_def)
+ have "\<And>i. f ` (f -` A i \<inter> S) = A i"
+ using f A sets_into_space
+ by (intro image_vimage_inter_eq) (auto simp: bij_betw_def)
+ then show "\<forall>i. \<mu> (f ` (f -` A i \<inter> S)) \<noteq> \<omega>" using A by simp
+ qed
+ qed
+qed
+
section "Real measure values"
lemma (in measure_space) real_measure_Union:
@@ -638,12 +1099,12 @@
finally show ?thesis .
qed
-lemma (in measure_space) real_measurable_countably_subadditive:
+lemma (in measure_space) real_measure_countably_subadditive:
assumes "range f \<subseteq> sets M" and "(\<Sum>\<^isub>\<infinity> i. \<mu> (f i)) \<noteq> \<omega>"
shows "real (\<mu> (\<Union>i. f i)) \<le> (\<Sum> i. real (\<mu> (f i)))"
proof -
have "real (\<mu> (\<Union>i. f i)) \<le> real (\<Sum>\<^isub>\<infinity> i. \<mu> (f i))"
- using assms by (auto intro!: real_of_pinfreal_mono measurable_countably_subadditive)
+ using assms by (auto intro!: real_of_pinfreal_mono measure_countably_subadditive)
also have "\<dots> = (\<Sum> i. real (\<mu> (f i)))"
using assms by (auto intro!: sums_unique psuminf_imp_suminf)
finally show ?thesis .
@@ -725,6 +1186,17 @@
show "\<mu> (space ?r) \<noteq> \<omega>" using finite_measure[OF `S \<in> sets M`] by auto
qed
+lemma (in measure_space) restricted_to_finite_measure:
+ assumes "S \<in> sets M" "\<mu> S \<noteq> \<omega>"
+ shows "finite_measure (restricted_space S) \<mu>"
+proof -
+ have "measure_space (restricted_space S) \<mu>"
+ using `S \<in> sets M` by (rule restricted_measure_space)
+ then show ?thesis
+ unfolding finite_measure_def finite_measure_axioms_def
+ using assms by auto
+qed
+
lemma (in finite_measure) real_finite_measure_Diff:
assumes "A \<in> sets M" "B \<in> sets M" "B \<subseteq> A"
shows "real (\<mu> (A - B)) = real (\<mu> A) - real (\<mu> B)"
@@ -761,10 +1233,10 @@
shows "real (\<mu> (A \<union> B)) \<le> real (\<mu> A) + real (\<mu> B)"
using measurable measurable[THEN finite_measure] by (rule real_measure_subadditive)
-lemma (in finite_measure) real_finite_measurable_countably_subadditive:
+lemma (in finite_measure) real_finite_measure_countably_subadditive:
assumes "range f \<subseteq> sets M" and "summable (\<lambda>i. real (\<mu> (f i)))"
shows "real (\<mu> (\<Union>i. f i)) \<le> (\<Sum> i. real (\<mu> (f i)))"
-proof (rule real_measurable_countably_subadditive[OF assms(1)])
+proof (rule real_measure_countably_subadditive[OF assms(1)])
have *: "\<And>i. f i \<in> sets M" using assms by auto
have "(\<lambda>i. real (\<mu> (f i))) sums (\<Sum>i. real (\<mu> (f i)))"
using assms(2) by (rule summable_sums)
@@ -817,11 +1289,11 @@
{f \<in> measurable A B. (\<forall>y \<in> sets B. \<mu> (f -` y \<inter> space A) = \<nu> y)}"
lemma (in finite_measure) measure_preserving_lift:
- fixes f :: "'a \<Rightarrow> 'a2" and A :: "('a2, 'b2) algebra_scheme"
+ fixes f :: "'a \<Rightarrow> 'a2" and A :: "'a2 algebra"
assumes "algebra A"
- assumes "finite_measure (sigma (space A) (sets A)) \<nu>" (is "finite_measure ?sA _")
+ assumes "finite_measure (sigma A) \<nu>" (is "finite_measure ?sA _")
assumes fmp: "f \<in> measure_preserving M \<mu> A \<nu>"
- shows "f \<in> measure_preserving M \<mu> (sigma (space A) (sets A)) \<nu>"
+ shows "f \<in> measure_preserving M \<mu> (sigma A) \<nu>"
proof -
interpret sA: finite_measure ?sA \<nu> by fact
interpret A: algebra A by fact
@@ -916,24 +1388,8 @@
section "Finite spaces"
-locale finite_measure_space = measure_space +
- assumes finite_space: "finite (space M)"
- and sets_eq_Pow: "sets M = Pow (space M)"
- and finite_single_measure: "\<And>x. x \<in> space M \<Longrightarrow> \<mu> {x} \<noteq> \<omega>"
-
-lemma (in finite_measure_space) sets_image_space_eq_Pow:
- "sets (image_space X) = Pow (space (image_space X))"
-proof safe
- fix x S assume "S \<in> sets (image_space X)" "x \<in> S"
- then show "x \<in> space (image_space X)"
- using sets_into_space by (auto intro!: imageI simp: image_space_def)
-next
- fix S assume "S \<subseteq> space (image_space X)"
- then obtain S' where "S = X`S'" "S'\<in>sets M"
- by (auto simp: subset_image_iff sets_eq_Pow image_space_def)
- then show "S \<in> sets (image_space X)"
- by (auto simp: image_space_def)
-qed
+locale finite_measure_space = measure_space + finite_sigma_algebra +
+ assumes finite_single_measure[simp]: "\<And>x. x \<in> space M \<Longrightarrow> \<mu> {x} \<noteq> \<omega>"
lemma (in finite_measure_space) sum_over_space: "(\<Sum>x\<in>space M. \<mu> {x}) = \<mu> (space M)"
using measure_finitely_additive''[of "space M" "\<lambda>i. {i}"]
@@ -945,28 +1401,28 @@
and "\<mu> {} = 0"
shows "finite_measure_space M \<mu>"
unfolding finite_measure_space_def finite_measure_space_axioms_def
-proof (safe del: notI)
+proof (intro allI impI conjI)
show "measure_space M \<mu>"
proof (rule sigma_algebra.finite_additivity_sufficient)
+ have *: "\<lparr>space = space M, sets = sets M\<rparr> = M" by auto
show "sigma_algebra M"
- apply (rule sigma_algebra_cong)
- apply (rule sigma_algebra_Pow[of "space M"])
- using assms by simp_all
+ using sigma_algebra_Pow[of "space M" "more M"] assms(2)[symmetric] by (simp add: *)
show "finite (space M)" by fact
show "positive \<mu>" unfolding positive_def by fact
show "additive M \<mu>" unfolding additive_def using assms by simp
qed
- show "finite (space M)" by fact
- { fix A x assume "A \<in> sets M" "x \<in> A" then show "x \<in> space M"
- using assms by auto }
- { fix A assume "A \<subseteq> space M" then show "A \<in> sets M"
- using assms by auto }
+ then interpret measure_space M \<mu> .
+ show "finite_sigma_algebra M"
+ proof
+ show "finite (space M)" by fact
+ show "sets M = Pow (space M)" using assms by auto
+ qed
{ fix x assume *: "x \<in> space M"
with add[of "{x}" "space M - {x}"] space
show "\<mu> {x} \<noteq> \<omega>" by (auto simp: insert_absorb[OF *] Diff_subset) }
qed
-sublocale finite_measure_space < finite_measure
+sublocale finite_measure_space \<subseteq> finite_measure
proof
show "\<mu> (space M) \<noteq> \<omega>"
unfolding sum_over_space[symmetric] setsum_\<omega>
--- a/src/HOL/Probability/Positive_Infinite_Real.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Positive_Infinite_Real.thy Thu Dec 02 11:18:44 2010 -0800
@@ -86,6 +86,26 @@
ultimately show ?thesis by simp
qed
+lemma (in complete_lattice) lim_INF_le_lim_SUP:
+ fixes f :: "nat \<Rightarrow> 'a"
+ shows "(SUP n. INF m. f (n + m)) \<le> (INF n. SUP m. f (n + m))"
+proof (rule SUP_leI, rule le_INFI)
+ fix i j show "(INF m. f (i + m)) \<le> (SUP m. f (j + m))"
+ proof (cases rule: le_cases)
+ assume "i \<le> j"
+ have "(INF m. f (i + m)) \<le> f (i + (j - i))" by (rule INF_leI) simp
+ also have "\<dots> = f (j + 0)" using `i \<le> j` by auto
+ also have "\<dots> \<le> (SUP m. f (j + m))" by (rule le_SUPI) simp
+ finally show ?thesis .
+ next
+ assume "j \<le> i"
+ have "(INF m. f (i + m)) \<le> f (i + 0)" by (rule INF_leI) simp
+ also have "\<dots> = f (j + (i - j))" using `j \<le> i` by auto
+ also have "\<dots> \<le> (SUP m. f (j + m))" by (rule le_SUPI) simp
+ finally show ?thesis .
+ qed
+qed
+
text {*
We introduce the the positive real numbers as needed for measure theory.
@@ -340,6 +360,20 @@
lemma real_of_pinfreal_mult: "real X * real Y = real (X * Y :: pinfreal)"
by (cases X, cases Y) (auto simp: zero_le_mult_iff)
+lemma Real_mult_nonneg: assumes "x \<ge> 0" "y \<ge> 0"
+ shows "Real (x * y) = Real x * Real y" using assms by auto
+
+lemma Real_setprod: assumes "\<forall>x\<in>A. f x \<ge> 0" shows "Real (setprod f A) = setprod (\<lambda>x. Real (f x)) A"
+proof(cases "finite A")
+ case True thus ?thesis using assms
+ proof(induct A) case (insert x A)
+ have "0 \<le> setprod f A" apply(rule setprod_nonneg) using insert by auto
+ thus ?case unfolding setprod_insert[OF insert(1-2)] apply-
+ apply(subst Real_mult_nonneg) prefer 3 apply(subst insert(3)[THEN sym])
+ using insert by auto
+ qed auto
+qed auto
+
subsection "@{typ pinfreal} is a linear order"
instantiation pinfreal :: linorder
@@ -415,6 +449,13 @@
fixes x y :: pinfreal shows "0 < x * y \<longleftrightarrow> 0 < x \<and> 0 < y"
by (cases x, cases y) (auto simp: zero_less_mult_iff)
+lemma pinfreal_ord_one[simp]:
+ "Real p < 1 \<longleftrightarrow> p < 1"
+ "Real p \<le> 1 \<longleftrightarrow> p \<le> 1"
+ "1 < Real p \<longleftrightarrow> 1 < p"
+ "1 \<le> Real p \<longleftrightarrow> 1 \<le> p"
+ by (simp_all add: one_pinfreal_def del: Real_1)
+
subsection {* @{text "x - y"} on @{typ pinfreal} *}
instantiation pinfreal :: minus
@@ -534,12 +575,40 @@
lemma pinfreal_of_nat[simp]: "of_nat m = Real (real m)"
by (induct m) (auto simp: real_of_nat_Suc one_pinfreal_def simp del: Real_1)
+lemma less_\<omega>_Ex_of_nat: "x < \<omega> \<longleftrightarrow> (\<exists>n. x < of_nat n)"
+proof safe
+ assume "x < \<omega>"
+ then obtain r where "0 \<le> r" "x = Real r" by (cases x) auto
+ moreover obtain n where "r < of_nat n" using ex_less_of_nat by auto
+ ultimately show "\<exists>n. x < of_nat n" by (auto simp: real_eq_of_nat)
+qed auto
+
lemma real_of_pinfreal_mono:
fixes a b :: pinfreal
assumes "b \<noteq> \<omega>" "a \<le> b"
shows "real a \<le> real b"
using assms by (cases b, cases a) auto
+lemma setprod_pinfreal_0:
+ "(\<Prod>i\<in>I. f i) = (0::pinfreal) \<longleftrightarrow> finite I \<and> (\<exists>i\<in>I. f i = 0)"
+proof cases
+ assume "finite I" then show ?thesis
+ proof (induct I)
+ case (insert i I)
+ then show ?case by simp
+ qed simp
+qed simp
+
+lemma setprod_\<omega>:
+ "(\<Prod>i\<in>I. f i) = \<omega> \<longleftrightarrow> finite I \<and> (\<exists>i\<in>I. f i = \<omega>) \<and> (\<forall>i\<in>I. f i \<noteq> 0)"
+proof cases
+ assume "finite I" then show ?thesis
+ proof (induct I)
+ case (insert i I) then show ?case
+ by (auto simp: setprod_pinfreal_0)
+ qed simp
+qed simp
+
instance pinfreal :: "semiring_char_0"
proof
fix m n
@@ -796,6 +865,29 @@
qed simp
qed simp
+lemma SUP_\<omega>: "(SUP i:A. f i) = \<omega> \<longleftrightarrow> (\<forall>x<\<omega>. \<exists>i\<in>A. x < f i)"
+proof
+ assume *: "(SUP i:A. f i) = \<omega>"
+ show "(\<forall>x<\<omega>. \<exists>i\<in>A. x < f i)" unfolding *[symmetric]
+ proof (intro allI impI)
+ fix x assume "x < SUPR A f" then show "\<exists>i\<in>A. x < f i"
+ unfolding less_SUP_iff by auto
+ qed
+next
+ assume *: "\<forall>x<\<omega>. \<exists>i\<in>A. x < f i"
+ show "(SUP i:A. f i) = \<omega>"
+ proof (rule pinfreal_SUPI)
+ fix y assume **: "\<And>i. i \<in> A \<Longrightarrow> f i \<le> y"
+ show "\<omega> \<le> y"
+ proof cases
+ assume "y < \<omega>"
+ from *[THEN spec, THEN mp, OF this]
+ obtain i where "i \<in> A" "\<not> (f i \<le> y)" by auto
+ with ** show ?thesis by auto
+ qed auto
+ qed auto
+qed
+
subsubsection {* Equivalence between @{text "f ----> x"} and @{text SUP} on @{typ pinfreal} *}
lemma monoseq_monoI: "mono f \<Longrightarrow> monoseq f"
@@ -1206,7 +1298,6 @@
have [intro, simp]: "\<And>A. inj_on f A" using `bij f` unfolding bij_def by (auto intro: subset_inj_on)
have f[intro, simp]: "\<And>x. f (inv f x) = x"
using `bij f` unfolding bij_def by (auto intro: surj_f_inv_f)
-
show ?thesis
proof (rule psuminf_equality)
fix n
@@ -1231,49 +1322,6 @@
qed
qed
-lemma psuminf_2dimen:
- fixes f:: "nat * nat \<Rightarrow> pinfreal"
- assumes fsums: "\<And>m. g m = (\<Sum>\<^isub>\<infinity> n. f (m,n))"
- shows "psuminf (f \<circ> prod_decode) = psuminf g"
-proof (rule psuminf_equality)
- fix n :: nat
- let ?P = "prod_decode ` {..<n}"
- have "setsum (f \<circ> prod_decode) {..<n} = setsum f ?P"
- by (auto simp: setsum_reindex inj_prod_decode)
- also have "\<dots> \<le> setsum f ({..Max (fst ` ?P)} \<times> {..Max (snd ` ?P)})"
- proof (safe intro!: setsum_mono3 Max_ge image_eqI)
- fix a b x assume "(a, b) = prod_decode x"
- from this[symmetric] show "a = fst (prod_decode x)" "b = snd (prod_decode x)"
- by simp_all
- qed simp_all
- also have "\<dots> = (\<Sum>m\<le>Max (fst ` ?P). (\<Sum>n\<le>Max (snd ` ?P). f (m,n)))"
- unfolding setsum_cartesian_product by simp
- also have "\<dots> \<le> (\<Sum>m\<le>Max (fst ` ?P). g m)"
- by (auto intro!: setsum_mono psuminf_upper simp del: setsum_lessThan_Suc
- simp: fsums lessThan_Suc_atMost[symmetric])
- also have "\<dots> \<le> psuminf g"
- by (auto intro!: psuminf_upper simp del: setsum_lessThan_Suc
- simp: lessThan_Suc_atMost[symmetric])
- finally show "setsum (f \<circ> prod_decode) {..<n} \<le> psuminf g" .
-next
- fix y assume *: "\<And>n. setsum (f \<circ> prod_decode) {..<n} \<le> y"
- have g: "g = (\<lambda>m. \<Sum>\<^isub>\<infinity> n. f (m,n))" unfolding fsums[symmetric] ..
- show "psuminf g \<le> y" unfolding g
- proof (rule psuminf_bound, unfold setsum_pinfsum[symmetric], safe intro!: psuminf_bound)
- fix N M :: nat
- let ?P = "{..<N} \<times> {..<M}"
- let ?M = "Max (prod_encode ` ?P)"
- have "(\<Sum>n<M. \<Sum>m<N. f (m, n)) \<le> (\<Sum>(m, n)\<in>?P. f (m, n))"
- unfolding setsum_commute[of _ _ "{..<M}"] unfolding setsum_cartesian_product ..
- also have "\<dots> \<le> (\<Sum>(m,n)\<in>(prod_decode ` {..?M}). f (m, n))"
- by (auto intro!: setsum_mono3 image_eqI[where f=prod_decode, OF prod_encode_inverse[symmetric]])
- also have "\<dots> \<le> y" using *[of "Suc ?M"]
- by (simp add: lessThan_Suc_atMost[symmetric] setsum_reindex
- inj_prod_decode del: setsum_lessThan_Suc)
- finally show "(\<Sum>n<M. \<Sum>m<N. f (m, n)) \<le> y" .
- qed
-qed
-
lemma pinfreal_mult_less_right:
assumes "b * a < c * a" "0 < a" "a < \<omega>"
shows "b < c"
@@ -1349,6 +1397,80 @@
qed simp
qed simp
+lemma psuminf_SUP_eq:
+ assumes "\<And>n i. f n i \<le> f (Suc n) i"
+ shows "(\<Sum>\<^isub>\<infinity> i. SUP n::nat. f n i) = (SUP n::nat. \<Sum>\<^isub>\<infinity> i. f n i)"
+proof -
+ { fix n :: nat
+ have "(\<Sum>i<n. SUP k. f k i) = (SUP k. \<Sum>i<n. f k i)"
+ using assms by (auto intro!: SUPR_pinfreal_setsum[symmetric]) }
+ note * = this
+ show ?thesis
+ unfolding psuminf_def
+ unfolding *
+ apply (subst SUP_commute) ..
+qed
+
+lemma psuminf_commute:
+ shows "(\<Sum>\<^isub>\<infinity> i j. f i j) = (\<Sum>\<^isub>\<infinity> j i. f i j)"
+proof -
+ have "(SUP n. \<Sum> i < n. SUP m. \<Sum> j < m. f i j) = (SUP n. SUP m. \<Sum> i < n. \<Sum> j < m. f i j)"
+ apply (subst SUPR_pinfreal_setsum)
+ by auto
+ also have "\<dots> = (SUP m n. \<Sum> j < m. \<Sum> i < n. f i j)"
+ apply (subst SUP_commute)
+ apply (subst setsum_commute)
+ by auto
+ also have "\<dots> = (SUP m. \<Sum> j < m. SUP n. \<Sum> i < n. f i j)"
+ apply (subst SUPR_pinfreal_setsum)
+ by auto
+ finally show ?thesis
+ unfolding psuminf_def by auto
+qed
+
+lemma psuminf_2dimen:
+ fixes f:: "nat * nat \<Rightarrow> pinfreal"
+ assumes fsums: "\<And>m. g m = (\<Sum>\<^isub>\<infinity> n. f (m,n))"
+ shows "psuminf (f \<circ> prod_decode) = psuminf g"
+proof (rule psuminf_equality)
+ fix n :: nat
+ let ?P = "prod_decode ` {..<n}"
+ have "setsum (f \<circ> prod_decode) {..<n} = setsum f ?P"
+ by (auto simp: setsum_reindex inj_prod_decode)
+ also have "\<dots> \<le> setsum f ({..Max (fst ` ?P)} \<times> {..Max (snd ` ?P)})"
+ proof (safe intro!: setsum_mono3 Max_ge image_eqI)
+ fix a b x assume "(a, b) = prod_decode x"
+ from this[symmetric] show "a = fst (prod_decode x)" "b = snd (prod_decode x)"
+ by simp_all
+ qed simp_all
+ also have "\<dots> = (\<Sum>m\<le>Max (fst ` ?P). (\<Sum>n\<le>Max (snd ` ?P). f (m,n)))"
+ unfolding setsum_cartesian_product by simp
+ also have "\<dots> \<le> (\<Sum>m\<le>Max (fst ` ?P). g m)"
+ by (auto intro!: setsum_mono psuminf_upper simp del: setsum_lessThan_Suc
+ simp: fsums lessThan_Suc_atMost[symmetric])
+ also have "\<dots> \<le> psuminf g"
+ by (auto intro!: psuminf_upper simp del: setsum_lessThan_Suc
+ simp: lessThan_Suc_atMost[symmetric])
+ finally show "setsum (f \<circ> prod_decode) {..<n} \<le> psuminf g" .
+next
+ fix y assume *: "\<And>n. setsum (f \<circ> prod_decode) {..<n} \<le> y"
+ have g: "g = (\<lambda>m. \<Sum>\<^isub>\<infinity> n. f (m,n))" unfolding fsums[symmetric] ..
+ show "psuminf g \<le> y" unfolding g
+ proof (rule psuminf_bound, unfold setsum_pinfsum[symmetric], safe intro!: psuminf_bound)
+ fix N M :: nat
+ let ?P = "{..<N} \<times> {..<M}"
+ let ?M = "Max (prod_encode ` ?P)"
+ have "(\<Sum>n<M. \<Sum>m<N. f (m, n)) \<le> (\<Sum>(m, n)\<in>?P. f (m, n))"
+ unfolding setsum_commute[of _ _ "{..<M}"] unfolding setsum_cartesian_product ..
+ also have "\<dots> \<le> (\<Sum>(m,n)\<in>(prod_decode ` {..?M}). f (m, n))"
+ by (auto intro!: setsum_mono3 image_eqI[where f=prod_decode, OF prod_encode_inverse[symmetric]])
+ also have "\<dots> \<le> y" using *[of "Suc ?M"]
+ by (simp add: lessThan_Suc_atMost[symmetric] setsum_reindex
+ inj_prod_decode del: setsum_lessThan_Suc)
+ finally show "(\<Sum>n<M. \<Sum>m<N. f (m, n)) \<le> y" .
+ qed
+qed
+
lemma Real_max:
assumes "x \<ge> 0" "y \<ge> 0"
shows "Real (max x y) = max (Real x) (Real y)"
@@ -1573,7 +1695,25 @@
definition (in complete_lattice) antiton (infix "\<down>" 50) where
"A \<down> X \<longleftrightarrow> (\<forall>i. A i \<ge> A (Suc i)) \<and> (INF i. A i) = X"
-lemma range_const[simp]: "range (\<lambda>x. c) = {c}" by auto
+lemma isotoneI[intro?]: "\<lbrakk> \<And>i. f i \<le> f (Suc i) ; (SUP i. f i) = F \<rbrakk> \<Longrightarrow> f \<up> F"
+ unfolding isoton_def by auto
+
+lemma (in complete_lattice) isotonD[dest]:
+ assumes "A \<up> X" shows "A i \<le> A (Suc i)" "(SUP i. A i) = X"
+ using assms unfolding isoton_def by auto
+
+lemma isotonD'[dest]:
+ assumes "(A::_=>_) \<up> X" shows "A i x \<le> A (Suc i) x" "(SUP i. A i) = X"
+ using assms unfolding isoton_def le_fun_def by auto
+
+lemma isoton_mono_le:
+ assumes "f \<up> x" "i \<le> j"
+ shows "f i \<le> f j"
+ using `f \<up> x`[THEN isotonD(1)] lift_Suc_mono_le[of f, OF _ `i \<le> j`] by auto
+
+lemma isoton_const:
+ shows "(\<lambda> i. c) \<up> c"
+unfolding isoton_def by auto
lemma isoton_cmult_right:
assumes "f \<up> (x::pinfreal)"
@@ -1605,12 +1745,23 @@
shows "(\<lambda>i x. f i x * indicator A x) \<up> (\<lambda>x. g x * indicator A x :: pinfreal)"
using assms unfolding isoton_fun_expand by (auto intro!: isoton_cmult_left)
-lemma pinfreal_ord_one[simp]:
- "Real p < 1 \<longleftrightarrow> p < 1"
- "Real p \<le> 1 \<longleftrightarrow> p \<le> 1"
- "1 < Real p \<longleftrightarrow> 1 < p"
- "1 \<le> Real p \<longleftrightarrow> 1 \<le> p"
- by (simp_all add: one_pinfreal_def del: Real_1)
+lemma isoton_setsum:
+ fixes f :: "'a \<Rightarrow> nat \<Rightarrow> pinfreal"
+ assumes "finite A" "A \<noteq> {}"
+ assumes "\<And> x. x \<in> A \<Longrightarrow> f x \<up> y x"
+ shows "(\<lambda> i. (\<Sum> x \<in> A. f x i)) \<up> (\<Sum> x \<in> A. y x)"
+using assms
+proof (induct A rule:finite_ne_induct)
+ case singleton thus ?case by auto
+next
+ case (insert a A) note asms = this
+ hence *: "(\<lambda> i. \<Sum> x \<in> A. f x i) \<up> (\<Sum> x \<in> A. y x)" by auto
+ have **: "(\<lambda> i. f a i) \<up> y a" using asms by simp
+ have "(\<lambda> i. f a i + (\<Sum> x \<in> A. f x i)) \<up> (y a + (\<Sum> x \<in> A. y x))"
+ using * ** isoton_add by auto
+ thus "(\<lambda> i. \<Sum> x \<in> insert a A. f x i) \<up> (\<Sum> x \<in> insert a A. y x)"
+ using asms by fastsimp
+qed
lemma isoton_Sup:
assumes "f \<up> u"
@@ -1981,14 +2132,6 @@
apply(rule_tac x=N in exI,safe) apply(erule_tac x=n in allE,safe)
apply(rule_tac y="Real (max 1 B)" in order_trans) by auto
-lemma (in complete_lattice) isotonD[dest]:
- assumes "A \<up> X" shows "A i \<le> A (Suc i)" "(SUP i. A i) = X"
- using assms unfolding isoton_def by auto
-
-lemma isotonD'[dest]:
- assumes "(A::_=>_) \<up> X" shows "A i x \<le> A (Suc i) x" "(SUP i. A i) = X"
- using assms unfolding isoton_def le_fun_def by auto
-
lemma pinfreal_LimI_finite:
assumes "x \<noteq> \<omega>" "\<And>r. 0 < r \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. u n < x + r \<and> x < u n + r"
shows "u ----> x"
@@ -2020,20 +2163,6 @@
lemma real_Real_max:"real (Real x) = max x 0"
unfolding real_Real by auto
-lemma (in complete_lattice) SUPR_upper:
- "x \<in> A \<Longrightarrow> f x \<le> SUPR A f"
- unfolding SUPR_def apply(rule Sup_upper) by auto
-
-lemma (in complete_lattice) SUPR_subset:
- assumes "A \<subseteq> B" shows "SUPR A f \<le> SUPR B f"
- apply(rule SUP_leI) apply(rule SUPR_upper) using assms by auto
-
-lemma (in complete_lattice) SUPR_mono:
- assumes "\<forall>a\<in>A. \<exists>b\<in>B. f b \<ge> f a"
- shows "SUPR A f \<le> SUPR B f"
- unfolding SUPR_def apply(rule Sup_mono)
- using assms by auto
-
lemma Sup_lim:
assumes "\<forall>n. b n \<in> s" "b ----> (a::pinfreal)"
shows "a \<le> Sup s"
@@ -2105,11 +2234,6 @@
unfolding Real_real using om by auto
qed qed
-lemma less_SUP_iff:
- fixes a :: pinfreal
- shows "(a < (SUP i:A. f i)) \<longleftrightarrow> (\<exists>x\<in>A. a < f x)"
- unfolding SUPR_def less_Sup_iff by auto
-
lemma Sup_mono_lim:
assumes "\<forall>a\<in>A. \<exists>b. \<forall>n. b n \<in> B \<and> b ----> (a::pinfreal)"
shows "Sup A \<le> Sup B"
@@ -2315,26 +2439,6 @@
shows "a \<le> a - b \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> a \<noteq> \<omega> \<Longrightarrow> b = 0"
by (cases a, cases b, auto split: split_if_asm)
-lemma lim_INF_le_lim_SUP:
- fixes f :: "nat \<Rightarrow> pinfreal"
- shows "(SUP n. INF m. f (n + m)) \<le> (INF n. SUP m. f (n + m))"
-proof (rule complete_lattice_class.SUP_leI, rule complete_lattice_class.le_INFI)
- fix i j show "(INF m. f (i + m)) \<le> (SUP m. f (j + m))"
- proof (cases rule: le_cases)
- assume "i \<le> j"
- have "(INF m. f (i + m)) \<le> f (i + (j - i))" by (rule INF_leI) simp
- also have "\<dots> = f (j + 0)" using `i \<le> j` by auto
- also have "\<dots> \<le> (SUP m. f (j + m))" by (rule le_SUPI) simp
- finally show ?thesis .
- next
- assume "j \<le> i"
- have "(INF m. f (i + m)) \<le> f (i + 0)" by (rule INF_leI) simp
- also have "\<dots> = f (j + (i - j))" using `j \<le> i` by auto
- also have "\<dots> \<le> (SUP m. f (j + m))" by (rule le_SUPI) simp
- finally show ?thesis .
- qed
-qed
-
lemma lim_INF_eq_lim_SUP:
fixes X :: "nat \<Rightarrow> real"
assumes "\<And>i. 0 \<le> X i" and "0 \<le> x"
@@ -2651,4 +2755,21 @@
lemma lessThan_0_Empty: "{..< 0 :: pinfreal} = {}" by auto
+lemma real_of_pinfreal_inverse[simp]:
+ fixes X :: pinfreal
+ shows "real (inverse X) = 1 / real X"
+ by (cases X) (auto simp: inverse_eq_divide)
+
+lemma real_of_pinfreal_le_0[simp]: "real (X :: pinfreal) \<le> 0 \<longleftrightarrow> (X = 0 \<or> X = \<omega>)"
+ by (cases X) auto
+
+lemma real_of_pinfreal_less_0[simp]: "\<not> (real (X :: pinfreal) < 0)"
+ by (cases X) auto
+
+lemma abs_real_of_pinfreal[simp]: "\<bar>real (X :: pinfreal)\<bar> = real X"
+ by simp
+
+lemma zero_less_real_of_pinfreal: "0 < real (X :: pinfreal) \<longleftrightarrow> X \<noteq> 0 \<and> X \<noteq> \<omega>"
+ by (cases X) auto
+
end
--- a/src/HOL/Probability/Probability.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Probability.thy Thu Dec 02 11:18:44 2010 -0800
@@ -3,5 +3,4 @@
Information
"ex/Dining_Cryptographers"
begin
-
end
--- a/src/HOL/Probability/Probability_Space.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Probability_Space.thy Thu Dec 02 11:18:44 2010 -0800
@@ -1,34 +1,48 @@
theory Probability_Space
-imports Lebesgue_Integration Radon_Nikodym
+imports Lebesgue_Integration Radon_Nikodym Product_Measure
begin
+lemma real_of_pinfreal_inverse[simp]:
+ fixes X :: pinfreal
+ shows "real (inverse X) = 1 / real X"
+ by (cases X) (auto simp: inverse_eq_divide)
+
+lemma real_of_pinfreal_le_0[simp]: "real (X :: pinfreal) \<le> 0 \<longleftrightarrow> (X = 0 \<or> X = \<omega>)"
+ by (cases X) auto
+
+lemma real_of_pinfreal_less_0[simp]: "\<not> (real (X :: pinfreal) < 0)"
+ by (cases X) auto
+
locale prob_space = measure_space +
assumes measure_space_1: "\<mu> (space M) = 1"
+lemma abs_real_of_pinfreal[simp]: "\<bar>real (X :: pinfreal)\<bar> = real X"
+ by simp
+
+lemma zero_less_real_of_pinfreal: "0 < real (X :: pinfreal) \<longleftrightarrow> X \<noteq> 0 \<and> X \<noteq> \<omega>"
+ by (cases X) auto
+
sublocale prob_space < finite_measure
proof
from measure_space_1 show "\<mu> (space M) \<noteq> \<omega>" by simp
qed
-context prob_space
-begin
+abbreviation (in prob_space) "events \<equiv> sets M"
+abbreviation (in prob_space) "prob \<equiv> \<lambda>A. real (\<mu> A)"
+abbreviation (in prob_space) "prob_preserving \<equiv> measure_preserving"
+abbreviation (in prob_space) "random_variable M' X \<equiv> sigma_algebra M' \<and> X \<in> measurable M M'"
+abbreviation (in prob_space) "expectation \<equiv> integral"
-abbreviation "events \<equiv> sets M"
-abbreviation "prob \<equiv> \<lambda>A. real (\<mu> A)"
-abbreviation "prob_preserving \<equiv> measure_preserving"
-abbreviation "random_variable \<equiv> \<lambda> s X. X \<in> measurable M s"
-abbreviation "expectation \<equiv> integral"
-
-definition
+definition (in prob_space)
"indep A B \<longleftrightarrow> A \<in> events \<and> B \<in> events \<and> prob (A \<inter> B) = prob A * prob B"
-definition
+definition (in prob_space)
"indep_families F G \<longleftrightarrow> (\<forall> A \<in> F. \<forall> B \<in> G. indep A B)"
-definition
+definition (in prob_space)
"distribution X = (\<lambda>s. \<mu> ((X -` s) \<inter> (space M)))"
-abbreviation
+abbreviation (in prob_space)
"joint_distribution X Y \<equiv> distribution (\<lambda>x. (X x, Y x))"
lemma (in prob_space) distribution_cong:
@@ -44,10 +58,14 @@
unfolding distribution_def fun_eq_iff
using assms by (auto intro!: arg_cong[where f="\<mu>"])
-lemma prob_space: "prob (space M) = 1"
+lemma (in prob_space) distribution_id[simp]:
+ assumes "N \<in> sets M" shows "distribution (\<lambda>x. x) N = \<mu> N"
+ using assms by (auto simp: distribution_def intro!: arg_cong[where f=\<mu>])
+
+lemma (in prob_space) prob_space: "prob (space M) = 1"
unfolding measure_space_1 by simp
-lemma measure_le_1[simp, intro]:
+lemma (in prob_space) measure_le_1[simp, intro]:
assumes "A \<in> events" shows "\<mu> A \<le> 1"
proof -
have "\<mu> A \<le> \<mu> (space M)"
@@ -56,21 +74,21 @@
finally show ?thesis .
qed
-lemma prob_compl:
+lemma (in prob_space) prob_compl:
assumes "A \<in> events"
shows "prob (space M - A) = 1 - prob A"
using `A \<in> events`[THEN sets_into_space] `A \<in> events` measure_space_1
by (subst real_finite_measure_Diff) auto
-lemma indep_space:
+lemma (in prob_space) indep_space:
assumes "s \<in> events"
shows "indep (space M) s"
using assms prob_space by (simp add: indep_def)
-lemma prob_space_increasing: "increasing M prob"
+lemma (in prob_space) prob_space_increasing: "increasing M prob"
by (auto intro!: real_measure_mono simp: increasing_def)
-lemma prob_zero_union:
+lemma (in prob_space) prob_zero_union:
assumes "s \<in> events" "t \<in> events" "prob t = 0"
shows "prob (s \<union> t) = prob s"
using assms
@@ -82,13 +100,13 @@
ultimately show ?thesis by simp
qed
-lemma prob_eq_compl:
+lemma (in prob_space) prob_eq_compl:
assumes "s \<in> events" "t \<in> events"
assumes "prob (space M - s) = prob (space M - t)"
shows "prob s = prob t"
using assms prob_compl by auto
-lemma prob_one_inter:
+lemma (in prob_space) prob_one_inter:
assumes events:"s \<in> events" "t \<in> events"
assumes "prob t = 1"
shows "prob (s \<inter> t) = prob s"
@@ -101,7 +119,7 @@
using events by (auto intro!: prob_eq_compl[of "s \<inter> t" s])
qed
-lemma prob_eq_bigunion_image:
+lemma (in prob_space) prob_eq_bigunion_image:
assumes "range f \<subseteq> events" "range g \<subseteq> events"
assumes "disjoint_family f" "disjoint_family g"
assumes "\<And> n :: nat. prob (f n) = prob (g n)"
@@ -115,27 +133,27 @@
show ?thesis using sums_unique[OF b] sums_unique[OF a] assms by simp
qed
-lemma prob_countably_zero:
+lemma (in prob_space) prob_countably_zero:
assumes "range c \<subseteq> events"
assumes "\<And> i. prob (c i) = 0"
shows "prob (\<Union> i :: nat. c i) = 0"
proof (rule antisym)
show "prob (\<Union> i :: nat. c i) \<le> 0"
- using real_finite_measurable_countably_subadditive[OF assms(1)]
+ using real_finite_measure_countably_subadditive[OF assms(1)]
by (simp add: assms(2) suminf_zero summable_zero)
show "0 \<le> prob (\<Union> i :: nat. c i)" by (rule real_pinfreal_nonneg)
qed
-lemma indep_sym:
+lemma (in prob_space) indep_sym:
"indep a b \<Longrightarrow> indep b a"
unfolding indep_def using Int_commute[of a b] by auto
-lemma indep_refl:
+lemma (in prob_space) indep_refl:
assumes "a \<in> events"
shows "indep a a = (prob a = 0) \<or> (prob a = 1)"
using assms unfolding indep_def by auto
-lemma prob_equiprobable_finite_unions:
+lemma (in prob_space) prob_equiprobable_finite_unions:
assumes "s \<in> events"
assumes s_finite: "finite s" "\<And>x. x \<in> s \<Longrightarrow> {x} \<in> events"
assumes "\<And> x y. \<lbrakk>x \<in> s; y \<in> s\<rbrakk> \<Longrightarrow> (prob {x} = prob {y})"
@@ -152,7 +170,7 @@
finally show ?thesis by simp
qed simp
-lemma prob_real_sum_image_fn:
+lemma (in prob_space) prob_real_sum_image_fn:
assumes "e \<in> events"
assumes "\<And> x. x \<in> s \<Longrightarrow> e \<inter> f x \<in> events"
assumes "finite s"
@@ -173,12 +191,12 @@
finally show ?thesis .
qed
-lemma distribution_prob_space:
- assumes S: "sigma_algebra S" "random_variable S X"
+lemma (in prob_space) distribution_prob_space:
+ assumes "random_variable S X"
shows "prob_space S (distribution X)"
proof -
interpret S: measure_space S "distribution X"
- using measure_space_vimage[OF S(2,1)] unfolding distribution_def .
+ using measure_space_vimage[of X S] assms unfolding distribution_def by simp
show ?thesis
proof
have "X -` space S \<inter> space M = space M"
@@ -188,7 +206,19 @@
qed
qed
-lemma distribution_lebesgue_thm1:
+lemma (in prob_space) AE_distribution:
+ assumes X: "random_variable MX X" and "measure_space.almost_everywhere MX (distribution X) (\<lambda>x. Q x)"
+ shows "AE x. Q (X x)"
+proof -
+ interpret X: prob_space MX "distribution X" using X by (rule distribution_prob_space)
+ obtain N where N: "N \<in> sets MX" "distribution X N = 0" "{x\<in>space MX. \<not> Q x} \<subseteq> N"
+ using assms unfolding X.almost_everywhere_def by auto
+ show "AE x. Q (X x)"
+ using X[unfolded measurable_def] N unfolding distribution_def
+ by (intro AE_I'[where N="X -` N \<inter> space M"]) auto
+qed
+
+lemma (in prob_space) distribution_lebesgue_thm1:
assumes "random_variable s X"
assumes "A \<in> sets s"
shows "real (distribution X A) = expectation (indicator (X -` A \<inter> space M))"
@@ -196,34 +226,34 @@
using assms unfolding measurable_def
using integral_indicator by auto
-lemma distribution_lebesgue_thm2:
- assumes "sigma_algebra S" "random_variable S X" and "A \<in> sets S"
+lemma (in prob_space) distribution_lebesgue_thm2:
+ assumes "random_variable S X" and "A \<in> sets S"
shows "distribution X A =
measure_space.positive_integral S (distribution X) (indicator A)"
(is "_ = measure_space.positive_integral _ ?D _")
proof -
- interpret S: prob_space S "distribution X" using assms(1,2) by (rule distribution_prob_space)
+ interpret S: prob_space S "distribution X" using assms(1) by (rule distribution_prob_space)
show ?thesis
using S.positive_integral_indicator(1)
using assms unfolding distribution_def by auto
qed
-lemma finite_expectation1:
- assumes "finite (X`space M)" and rv: "random_variable borel_space X"
+lemma (in prob_space) finite_expectation1:
+ assumes f: "finite (X`space M)" and rv: "random_variable borel X"
shows "expectation X = (\<Sum> r \<in> X ` space M. r * prob (X -` {r} \<inter> space M))"
-proof (rule integral_on_finite(2)[OF assms(2,1)])
+proof (rule integral_on_finite(2)[OF rv[THEN conjunct2] f])
fix x have "X -` {x} \<inter> space M \<in> sets M"
using rv unfolding measurable_def by auto
thus "\<mu> (X -` {x} \<inter> space M) \<noteq> \<omega>" using finite_measure by simp
qed
-lemma finite_expectation:
- assumes "finite (space M)" "random_variable borel_space X"
+lemma (in prob_space) finite_expectation:
+ assumes "finite (space M)" "random_variable borel X"
shows "expectation X = (\<Sum> r \<in> X ` (space M). r * real (distribution X {r}))"
using assms unfolding distribution_def using finite_expectation1 by auto
-lemma prob_x_eq_1_imp_prob_y_eq_0:
+lemma (in prob_space) prob_x_eq_1_imp_prob_y_eq_0:
assumes "{x} \<in> events"
assumes "prob {x} = 1"
assumes "{y} \<in> events"
@@ -231,17 +261,17 @@
shows "prob {y} = 0"
using prob_one_inter[of "{y}" "{x}"] assms by auto
-lemma distribution_empty[simp]: "distribution X {} = 0"
+lemma (in prob_space) distribution_empty[simp]: "distribution X {} = 0"
unfolding distribution_def by simp
-lemma distribution_space[simp]: "distribution X (X ` space M) = 1"
+lemma (in prob_space) distribution_space[simp]: "distribution X (X ` space M) = 1"
proof -
have "X -` X ` space M \<inter> space M = space M" by auto
thus ?thesis unfolding distribution_def by (simp add: measure_space_1)
qed
-lemma distribution_one:
- assumes "random_variable M X" and "A \<in> events"
+lemma (in prob_space) distribution_one:
+ assumes "random_variable M' X" and "A \<in> sets M'"
shows "distribution X A \<le> 1"
proof -
have "distribution X A \<le> \<mu> (space M)" unfolding distribution_def
@@ -249,31 +279,27 @@
thus ?thesis by (simp add: measure_space_1)
qed
-lemma distribution_finite:
- assumes "random_variable M X" and "A \<in> events"
+lemma (in prob_space) distribution_finite:
+ assumes "random_variable M' X" and "A \<in> sets M'"
shows "distribution X A \<noteq> \<omega>"
using distribution_one[OF assms] by auto
-lemma distribution_x_eq_1_imp_distribution_y_eq_0:
+lemma (in prob_space) distribution_x_eq_1_imp_distribution_y_eq_0:
assumes X: "random_variable \<lparr>space = X ` (space M), sets = Pow (X ` (space M))\<rparr> X"
(is "random_variable ?S X")
assumes "distribution X {x} = 1"
assumes "y \<noteq> x"
shows "distribution X {y} = 0"
proof -
- have "sigma_algebra ?S" by (rule sigma_algebra_Pow)
- from distribution_prob_space[OF this X]
+ from distribution_prob_space[OF X]
interpret S: prob_space ?S "distribution X" by simp
-
have x: "{x} \<in> sets ?S"
proof (rule ccontr)
assume "{x} \<notin> sets ?S"
hence "X -` {x} \<inter> space M = {}" by auto
thus "False" using assms unfolding distribution_def by auto
qed
-
have [simp]: "{y} \<inter> {x} = {}" "{x} - {y} = {x}" using `y \<noteq> x` by auto
-
show ?thesis
proof cases
assume "{y} \<in> sets ?S"
@@ -287,10 +313,341 @@
qed
qed
-end
+lemma (in prob_space) joint_distribution_Times_le_fst:
+ assumes X: "random_variable MX X" and Y: "random_variable MY Y"
+ and A: "A \<in> sets MX" and B: "B \<in> sets MY"
+ shows "joint_distribution X Y (A \<times> B) \<le> distribution X A"
+ unfolding distribution_def
+proof (intro measure_mono)
+ show "(\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M \<subseteq> X -` A \<inter> space M" by force
+ show "X -` A \<inter> space M \<in> events"
+ using X A unfolding measurable_def by simp
+ have *: "(\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M =
+ (X -` A \<inter> space M) \<inter> (Y -` B \<inter> space M)" by auto
+ show "(\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M \<in> events"
+ unfolding * apply (rule Int)
+ using assms unfolding measurable_def by auto
+qed
+
+lemma (in prob_space) joint_distribution_commute:
+ "joint_distribution X Y x = joint_distribution Y X ((\<lambda>(x,y). (y,x))`x)"
+ unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>])
+
+lemma (in prob_space) joint_distribution_Times_le_snd:
+ assumes X: "random_variable MX X" and Y: "random_variable MY Y"
+ and A: "A \<in> sets MX" and B: "B \<in> sets MY"
+ shows "joint_distribution X Y (A \<times> B) \<le> distribution Y B"
+ using assms
+ by (subst joint_distribution_commute)
+ (simp add: swap_product joint_distribution_Times_le_fst)
+
+lemma (in prob_space) random_variable_pairI:
+ assumes "random_variable MX X"
+ assumes "random_variable MY Y"
+ shows "random_variable (sigma (pair_algebra MX MY)) (\<lambda>x. (X x, Y x))"
+proof
+ interpret MX: sigma_algebra MX using assms by simp
+ interpret MY: sigma_algebra MY using assms by simp
+ interpret P: pair_sigma_algebra MX MY by default
+ show "sigma_algebra (sigma (pair_algebra MX MY))" by default
+ have sa: "sigma_algebra M" by default
+ show "(\<lambda>x. (X x, Y x)) \<in> measurable M (sigma (pair_algebra MX MY))"
+ unfolding P.measurable_pair[OF sa] using assms by (simp add: comp_def)
+qed
+
+lemma (in prob_space) distribution_order:
+ assumes "random_variable MX X" "random_variable MY Y"
+ assumes "{x} \<in> sets MX" "{y} \<in> sets MY"
+ shows "r \<le> joint_distribution X Y {(x, y)} \<Longrightarrow> r \<le> distribution X {x}"
+ and "r \<le> joint_distribution X Y {(x, y)} \<Longrightarrow> r \<le> distribution Y {y}"
+ and "r < joint_distribution X Y {(x, y)} \<Longrightarrow> r < distribution X {x}"
+ and "r < joint_distribution X Y {(x, y)} \<Longrightarrow> r < distribution Y {y}"
+ and "distribution X {x} = 0 \<Longrightarrow> joint_distribution X Y {(x, y)} = 0"
+ and "distribution Y {y} = 0 \<Longrightarrow> joint_distribution X Y {(x, y)} = 0"
+ using joint_distribution_Times_le_snd[OF assms]
+ using joint_distribution_Times_le_fst[OF assms]
+ by auto
+
+lemma (in prob_space) joint_distribution_commute_singleton:
+ "joint_distribution X Y {(x, y)} = joint_distribution Y X {(y, x)}"
+ unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>])
+
+lemma (in prob_space) joint_distribution_assoc_singleton:
+ "joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)} =
+ joint_distribution (\<lambda>x. (X x, Y x)) Z {((x, y), z)}"
+ unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>])
+
+locale pair_prob_space = M1: prob_space M1 p1 + M2: prob_space M2 p2 for M1 p1 M2 p2
+
+sublocale pair_prob_space \<subseteq> pair_sigma_finite M1 p1 M2 p2 by default
+
+sublocale pair_prob_space \<subseteq> P: prob_space P pair_measure
+proof
+ show "pair_measure (space P) = 1"
+ by (simp add: pair_algebra_def pair_measure_times M1.measure_space_1 M2.measure_space_1)
+qed
+
+lemma countably_additiveI[case_names countably]:
+ assumes "\<And>A. \<lbrakk> range A \<subseteq> sets M ; disjoint_family A ; (\<Union>i. A i) \<in> sets M\<rbrakk> \<Longrightarrow>
+ (\<Sum>\<^isub>\<infinity>n. \<mu> (A n)) = \<mu> (\<Union>i. A i)"
+ shows "countably_additive M \<mu>"
+ using assms unfolding countably_additive_def by auto
+
+lemma (in prob_space) joint_distribution_prob_space:
+ assumes "random_variable MX X" "random_variable MY Y"
+ shows "prob_space (sigma (pair_algebra MX MY)) (joint_distribution X Y)"
+proof -
+ interpret X: prob_space MX "distribution X" by (intro distribution_prob_space assms)
+ interpret Y: prob_space MY "distribution Y" by (intro distribution_prob_space assms)
+ interpret XY: pair_sigma_finite MX "distribution X" MY "distribution Y" by default
+ show ?thesis
+ proof
+ let "?X A" = "(\<lambda>x. (X x, Y x)) -` A \<inter> space M"
+ show "joint_distribution X Y {} = 0" by (simp add: distribution_def)
+ show "countably_additive XY.P (joint_distribution X Y)"
+ proof (rule countably_additiveI)
+ fix A :: "nat \<Rightarrow> ('b \<times> 'c) set"
+ assume A: "range A \<subseteq> sets XY.P" and df: "disjoint_family A"
+ have "(\<Sum>\<^isub>\<infinity>n. \<mu> (?X (A n))) = \<mu> (\<Union>x. ?X (A x))"
+ proof (intro measure_countably_additive)
+ from assms have *: "(\<lambda>x. (X x, Y x)) \<in> measurable M XY.P"
+ by (intro XY.measurable_prod_sigma) (simp_all add: comp_def, default)
+ show "range (\<lambda>n. ?X (A n)) \<subseteq> events"
+ using measurable_sets[OF *] A by auto
+ show "disjoint_family (\<lambda>n. ?X (A n))"
+ by (intro disjoint_family_on_bisimulation[OF df]) auto
+ qed
+ then show "(\<Sum>\<^isub>\<infinity>n. joint_distribution X Y (A n)) = joint_distribution X Y (\<Union>i. A i)"
+ by (simp add: distribution_def vimage_UN)
+ qed
+ have "?X (space MX \<times> space MY) = space M"
+ using assms by (auto simp: measurable_def)
+ then show "joint_distribution X Y (space XY.P) = 1"
+ by (simp add: space_pair_algebra distribution_def measure_space_1)
+ qed
+qed
+
+section "Probability spaces on finite sets"
locale finite_prob_space = prob_space + finite_measure_space
+abbreviation (in prob_space) "finite_random_variable M' X \<equiv> finite_sigma_algebra M' \<and> X \<in> measurable M M'"
+
+lemma (in prob_space) finite_random_variableD:
+ assumes "finite_random_variable M' X" shows "random_variable M' X"
+proof -
+ interpret M': finite_sigma_algebra M' using assms by simp
+ then show "random_variable M' X" using assms by simp default
+qed
+
+lemma (in prob_space) distribution_finite_prob_space:
+ assumes "finite_random_variable MX X"
+ shows "finite_prob_space MX (distribution X)"
+proof -
+ interpret X: prob_space MX "distribution X"
+ using assms[THEN finite_random_variableD] by (rule distribution_prob_space)
+ interpret MX: finite_sigma_algebra MX
+ using assms by simp
+ show ?thesis
+ proof
+ fix x assume "x \<in> space MX"
+ then have "X -` {x} \<inter> space M \<in> sets M"
+ using assms unfolding measurable_def by simp
+ then show "distribution X {x} \<noteq> \<omega>"
+ unfolding distribution_def by simp
+ qed
+qed
+
+lemma (in prob_space) simple_function_imp_finite_random_variable[simp, intro]:
+ assumes "simple_function X"
+ shows "finite_random_variable \<lparr> space = X`space M, sets = Pow (X`space M) \<rparr> X"
+proof (intro conjI)
+ have [simp]: "finite (X ` space M)" using assms unfolding simple_function_def by simp
+ interpret X: sigma_algebra "\<lparr>space = X ` space M, sets = Pow (X ` space M)\<rparr>"
+ by (rule sigma_algebra_Pow)
+ show "finite_sigma_algebra \<lparr>space = X ` space M, sets = Pow (X ` space M)\<rparr>"
+ by default auto
+ show "X \<in> measurable M \<lparr>space = X ` space M, sets = Pow (X ` space M)\<rparr>"
+ proof (unfold measurable_def, clarsimp)
+ fix A assume A: "A \<subseteq> X`space M"
+ then have "finite A" by (rule finite_subset) simp
+ then have "X -` (\<Union>a\<in>A. {a}) \<inter> space M \<in> events"
+ unfolding vimage_UN UN_extend_simps
+ apply (rule finite_UN)
+ using A assms unfolding simple_function_def by auto
+ then show "X -` A \<inter> space M \<in> events" by simp
+ qed
+qed
+
+lemma (in prob_space) simple_function_imp_random_variable[simp, intro]:
+ assumes "simple_function X"
+ shows "random_variable \<lparr> space = X`space M, sets = Pow (X`space M) \<rparr> X"
+ using simple_function_imp_finite_random_variable[OF assms]
+ by (auto dest!: finite_random_variableD)
+
+lemma (in prob_space) sum_over_space_real_distribution:
+ "simple_function X \<Longrightarrow> (\<Sum>x\<in>X`space M. real (distribution X {x})) = 1"
+ unfolding distribution_def prob_space[symmetric]
+ by (subst real_finite_measure_finite_Union[symmetric])
+ (auto simp add: disjoint_family_on_def simple_function_def
+ intro!: arg_cong[where f=prob])
+
+lemma (in prob_space) finite_random_variable_pairI:
+ assumes "finite_random_variable MX X"
+ assumes "finite_random_variable MY Y"
+ shows "finite_random_variable (sigma (pair_algebra MX MY)) (\<lambda>x. (X x, Y x))"
+proof
+ interpret MX: finite_sigma_algebra MX using assms by simp
+ interpret MY: finite_sigma_algebra MY using assms by simp
+ interpret P: pair_finite_sigma_algebra MX MY by default
+ show "finite_sigma_algebra (sigma (pair_algebra MX MY))" by default
+ have sa: "sigma_algebra M" by default
+ show "(\<lambda>x. (X x, Y x)) \<in> measurable M (sigma (pair_algebra MX MY))"
+ unfolding P.measurable_pair[OF sa] using assms by (simp add: comp_def)
+qed
+
+lemma (in prob_space) finite_random_variable_imp_sets:
+ "finite_random_variable MX X \<Longrightarrow> x \<in> space MX \<Longrightarrow> {x} \<in> sets MX"
+ unfolding finite_sigma_algebra_def finite_sigma_algebra_axioms_def by simp
+
+lemma (in prob_space) finite_random_variable_vimage:
+ assumes X: "finite_random_variable MX X" shows "X -` A \<inter> space M \<in> events"
+proof -
+ interpret X: finite_sigma_algebra MX using X by simp
+ from X have vimage: "\<And>A. A \<subseteq> space MX \<Longrightarrow> X -` A \<inter> space M \<in> events" and
+ "X \<in> space M \<rightarrow> space MX"
+ by (auto simp: measurable_def)
+ then have *: "X -` A \<inter> space M = X -` (A \<inter> space MX) \<inter> space M"
+ by auto
+ show "X -` A \<inter> space M \<in> events"
+ unfolding * by (intro vimage) auto
+qed
+
+lemma (in prob_space) joint_distribution_finite_Times_le_fst:
+ assumes X: "finite_random_variable MX X" and Y: "finite_random_variable MY Y"
+ shows "joint_distribution X Y (A \<times> B) \<le> distribution X A"
+ unfolding distribution_def
+proof (intro measure_mono)
+ show "(\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M \<subseteq> X -` A \<inter> space M" by force
+ show "X -` A \<inter> space M \<in> events"
+ using finite_random_variable_vimage[OF X] .
+ have *: "(\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M =
+ (X -` A \<inter> space M) \<inter> (Y -` B \<inter> space M)" by auto
+ show "(\<lambda>x. (X x, Y x)) -` (A \<times> B) \<inter> space M \<in> events"
+ unfolding * apply (rule Int)
+ using assms[THEN finite_random_variable_vimage] by auto
+qed
+
+lemma (in prob_space) joint_distribution_finite_Times_le_snd:
+ assumes X: "finite_random_variable MX X" and Y: "finite_random_variable MY Y"
+ shows "joint_distribution X Y (A \<times> B) \<le> distribution Y B"
+ using assms
+ by (subst joint_distribution_commute)
+ (simp add: swap_product joint_distribution_finite_Times_le_fst)
+
+lemma (in prob_space) finite_distribution_order:
+ assumes "finite_random_variable MX X" "finite_random_variable MY Y"
+ shows "r \<le> joint_distribution X Y {(x, y)} \<Longrightarrow> r \<le> distribution X {x}"
+ and "r \<le> joint_distribution X Y {(x, y)} \<Longrightarrow> r \<le> distribution Y {y}"
+ and "r < joint_distribution X Y {(x, y)} \<Longrightarrow> r < distribution X {x}"
+ and "r < joint_distribution X Y {(x, y)} \<Longrightarrow> r < distribution Y {y}"
+ and "distribution X {x} = 0 \<Longrightarrow> joint_distribution X Y {(x, y)} = 0"
+ and "distribution Y {y} = 0 \<Longrightarrow> joint_distribution X Y {(x, y)} = 0"
+ using joint_distribution_finite_Times_le_snd[OF assms, of "{x}" "{y}"]
+ using joint_distribution_finite_Times_le_fst[OF assms, of "{x}" "{y}"]
+ by auto
+
+lemma (in prob_space) finite_distribution_finite:
+ assumes "finite_random_variable M' X"
+ shows "distribution X {x} \<noteq> \<omega>"
+proof -
+ have "distribution X {x} \<le> \<mu> (space M)"
+ unfolding distribution_def
+ using finite_random_variable_vimage[OF assms]
+ by (intro measure_mono) auto
+ then show ?thesis
+ by auto
+qed
+
+lemma (in prob_space) setsum_joint_distribution:
+ assumes X: "finite_random_variable MX X"
+ assumes Y: "random_variable MY Y" "B \<in> sets MY"
+ shows "(\<Sum>a\<in>space MX. joint_distribution X Y ({a} \<times> B)) = distribution Y B"
+ unfolding distribution_def
+proof (subst measure_finitely_additive'')
+ interpret MX: finite_sigma_algebra MX using X by auto
+ show "finite (space MX)" using MX.finite_space .
+ let "?d i" = "(\<lambda>x. (X x, Y x)) -` ({i} \<times> B) \<inter> space M"
+ { fix i assume "i \<in> space MX"
+ moreover have "?d i = (X -` {i} \<inter> space M) \<inter> (Y -` B \<inter> space M)" by auto
+ ultimately show "?d i \<in> events"
+ using measurable_sets[of X M MX] measurable_sets[of Y M MY B] X Y
+ using MX.sets_eq_Pow by auto }
+ show "disjoint_family_on ?d (space MX)" by (auto simp: disjoint_family_on_def)
+ show "\<mu> (\<Union>i\<in>space MX. ?d i) = \<mu> (Y -` B \<inter> space M)"
+ using X[unfolded measurable_def]
+ by (auto intro!: arg_cong[where f=\<mu>])
+qed
+
+lemma (in prob_space) setsum_joint_distribution_singleton:
+ assumes X: "finite_random_variable MX X"
+ assumes Y: "finite_random_variable MY Y" "b \<in> space MY"
+ shows "(\<Sum>a\<in>space MX. joint_distribution X Y {(a, b)}) = distribution Y {b}"
+ using setsum_joint_distribution[OF X
+ finite_random_variableD[OF Y(1)]
+ finite_random_variable_imp_sets[OF Y]] by simp
+
+lemma (in prob_space) setsum_real_joint_distribution:
+ assumes X: "finite_random_variable MX X"
+ assumes Y: "random_variable MY Y" "B \<in> sets MY"
+ shows "(\<Sum>a\<in>space MX. real (joint_distribution X Y ({a} \<times> B))) = real (distribution Y B)"
+proof -
+ interpret MX: finite_sigma_algebra MX using X by auto
+ show ?thesis
+ unfolding setsum_joint_distribution[OF assms, symmetric]
+ using distribution_finite[OF random_variable_pairI[OF finite_random_variableD[OF X] Y(1)]] Y(2)
+ by (simp add: space_pair_algebra in_sigma pair_algebraI MX.sets_eq_Pow real_of_pinfreal_setsum)
+qed
+
+lemma (in prob_space) setsum_real_joint_distribution_singleton:
+ assumes X: "finite_random_variable MX X"
+ assumes Y: "finite_random_variable MY Y" "b \<in> space MY"
+ shows "(\<Sum>a\<in>space MX. real (joint_distribution X Y {(a,b)})) = real (distribution Y {b})"
+ using setsum_real_joint_distribution[OF X
+ finite_random_variableD[OF Y(1)]
+ finite_random_variable_imp_sets[OF Y]] by simp
+
+locale pair_finite_prob_space = M1: finite_prob_space M1 p1 + M2: finite_prob_space M2 p2 for M1 p1 M2 p2
+
+sublocale pair_finite_prob_space \<subseteq> pair_prob_space M1 p1 M2 p2 by default
+sublocale pair_finite_prob_space \<subseteq> pair_finite_space M1 p1 M2 p2 by default
+sublocale pair_finite_prob_space \<subseteq> finite_prob_space P pair_measure by default
+
+lemma (in prob_space) joint_distribution_finite_prob_space:
+ assumes X: "finite_random_variable MX X"
+ assumes Y: "finite_random_variable MY Y"
+ shows "finite_prob_space (sigma (pair_algebra MX MY)) (joint_distribution X Y)"
+proof -
+ interpret X: finite_prob_space MX "distribution X"
+ using X by (rule distribution_finite_prob_space)
+ interpret Y: finite_prob_space MY "distribution Y"
+ using Y by (rule distribution_finite_prob_space)
+ interpret P: prob_space "sigma (pair_algebra MX MY)" "joint_distribution X Y"
+ using assms[THEN finite_random_variableD] by (rule joint_distribution_prob_space)
+ interpret XY: pair_finite_prob_space MX "distribution X" MY "distribution Y"
+ by default
+ show ?thesis
+ proof
+ fix x assume "x \<in> space XY.P"
+ moreover have "(\<lambda>x. (X x, Y x)) \<in> measurable M XY.P"
+ using X Y by (subst XY.measurable_pair) (simp_all add: o_def, default)
+ ultimately have "(\<lambda>x. (X x, Y x)) -` {x} \<inter> space M \<in> sets M"
+ unfolding measurable_def by simp
+ then show "joint_distribution X Y {x} \<noteq> \<omega>"
+ unfolding distribution_def by simp
+ qed
+qed
+
lemma finite_prob_space_eq:
"finite_prob_space M \<mu> \<longleftrightarrow> finite_measure_space M \<mu> \<and> \<mu> (space M) = 1"
unfolding finite_prob_space_def finite_measure_space_def prob_space_def prob_space_axioms_def
@@ -550,10 +907,6 @@
"finite_prob_space \<lparr> space = X ` space M, sets = Pow (X ` space M)\<rparr> (distribution X)"
by (simp add: finite_prob_space_eq finite_measure_space)
-lemma (in prob_space) joint_distribution_commute:
- "joint_distribution X Y x = joint_distribution Y X ((\<lambda>(x,y). (y,x))`x)"
- unfolding distribution_def by (auto intro!: arg_cong[where f=\<mu>])
-
lemma (in finite_prob_space) real_distribution_order':
shows "real (distribution X {x}) = 0 \<Longrightarrow> real (joint_distribution X Y {(x, y)}) = 0"
and "real (distribution Y {y}) = 0 \<Longrightarrow> real (joint_distribution X Y {(x, y)}) = 0"
@@ -586,6 +939,16 @@
(joint_distribution X Y)"
using finite_space by (auto intro!: finite_product_measure_space)
+lemma (in finite_prob_space) finite_product_prob_space_of_images:
+ "finite_prob_space \<lparr> space = X ` space M \<times> Y ` space M, sets = Pow (X ` space M \<times> Y ` space M)\<rparr>
+ (joint_distribution X Y)"
+ (is "finite_prob_space ?S _")
+proof (simp add: finite_prob_space_eq finite_product_measure_space_of_images)
+ have "X -` X ` space M \<inter> Y -` Y ` space M \<inter> space M = space M" by auto
+ thus "joint_distribution X Y (X ` space M \<times> Y ` space M) = 1"
+ by (simp add: distribution_def prob_space vimage_Times comp_def measure_space_1)
+qed
+
section "Conditional Expectation and Probability"
lemma (in prob_space) conditional_expectation_exists:
--- a/src/HOL/Probability/Product_Measure.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Product_Measure.thy Thu Dec 02 11:18:44 2010 -0800
@@ -2,367 +2,162 @@
imports Lebesgue_Integration
begin
-definition "dynkin M \<longleftrightarrow>
- space M \<in> sets M \<and>
- (\<forall> A \<in> sets M. A \<subseteq> space M) \<and>
- (\<forall> a \<in> sets M. \<forall> b \<in> sets M. a \<subseteq> b \<longrightarrow> b - a \<in> sets M) \<and>
- (\<forall>A. disjoint_family A \<and> range A \<subseteq> sets M \<longrightarrow> (\<Union>i::nat. A i) \<in> sets M)"
-
-lemma dynkinI:
- assumes "\<And> A. A \<in> sets M \<Longrightarrow> A \<subseteq> space M"
- assumes "space M \<in> sets M" and "\<forall> b \<in> sets M. \<forall> a \<in> sets M. a \<subseteq> b \<longrightarrow> b - a \<in> sets M"
- assumes "\<And> a. (\<And> i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {})
- \<Longrightarrow> (\<And> i :: nat. a i \<in> sets M) \<Longrightarrow> UNION UNIV a \<in> sets M"
- shows "dynkin M"
-using assms by (auto simp: dynkin_def disjoint_family_on_def image_subset_iff)
-
-lemma dynkin_subset:
- assumes "dynkin M"
- shows "\<And> A. A \<in> sets M \<Longrightarrow> A \<subseteq> space M"
-using assms unfolding dynkin_def by auto
+lemma times_Int_times: "A \<times> B \<inter> C \<times> D = (A \<inter> C) \<times> (B \<inter> D)"
+ by auto
-lemma dynkin_space:
- assumes "dynkin M"
- shows "space M \<in> sets M"
-using assms unfolding dynkin_def by auto
-
-lemma dynkin_diff:
- assumes "dynkin M"
- shows "\<And> a b. \<lbrakk> a \<in> sets M ; b \<in> sets M ; a \<subseteq> b \<rbrakk> \<Longrightarrow> b - a \<in> sets M"
-using assms unfolding dynkin_def by auto
-
-lemma dynkin_empty:
- assumes "dynkin M"
- shows "{} \<in> sets M"
-using dynkin_diff[OF assms dynkin_space[OF assms] dynkin_space[OF assms]] by auto
-
-lemma dynkin_UN:
- assumes "dynkin M"
- assumes "\<And> i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {}"
- assumes "\<And> i :: nat. a i \<in> sets M"
- shows "UNION UNIV a \<in> sets M"
-using assms by (auto simp: dynkin_def disjoint_family_on_def image_subset_iff)
-
-definition "Int_stable M \<longleftrightarrow> (\<forall> a \<in> sets M. \<forall> b \<in> sets M. a \<inter> b \<in> sets M)"
+lemma Pair_vimage_times[simp]: "\<And>A B x. Pair x -` (A \<times> B) = (if x \<in> A then B else {})"
+ by auto
-lemma dynkin_trivial:
- shows "dynkin \<lparr> space = A, sets = Pow A \<rparr>"
-by (rule dynkinI) auto
+lemma rev_Pair_vimage_times[simp]: "\<And>A B y. (\<lambda>x. (x, y)) -` (A \<times> B) = (if y \<in> B then A else {})"
+ by auto
-lemma dynkin_lemma:
- fixes D :: "'a algebra"
- assumes stab: "Int_stable E"
- and spac: "space E = space D"
- and subsED: "sets E \<subseteq> sets D"
- and subsDE: "sets D \<subseteq> sigma_sets (space E) (sets E)"
- and dyn: "dynkin D"
- shows "sigma (space E) (sets E) = D"
-proof -
- def sets_\<delta>E == "\<Inter> {sets d | d :: 'a algebra. dynkin d \<and> space d = space E \<and> sets E \<subseteq> sets d}"
- def \<delta>E == "\<lparr> space = space E, sets = sets_\<delta>E \<rparr>"
- have "\<lparr> space = space E, sets = Pow (space E) \<rparr> \<in> {d | d. dynkin d \<and> space d = space E \<and> sets E \<subseteq> sets d}"
- using dynkin_trivial spac subsED dynkin_subset[OF dyn] by fastsimp
- hence not_empty: "{sets (d :: 'a algebra) | d. dynkin d \<and> space d = space E \<and> sets E \<subseteq> sets d} \<noteq> {}"
- using exI[of "\<lambda> x. space x = space E \<and> dynkin x \<and> sets E \<subseteq> sets x" "\<lparr> space = space E, sets = Pow (space E) \<rparr>", simplified]
- by auto
- have \<delta>E_D: "sets_\<delta>E \<subseteq> sets D"
- unfolding sets_\<delta>E_def using assms by auto
- have \<delta>ynkin: "dynkin \<delta>E"
- proof (rule dynkinI, safe)
- fix A x assume asm: "A \<in> sets \<delta>E" "x \<in> A"
- { fix d :: "('a, 'b) algebra_scheme" assume "A \<in> sets d" "dynkin d \<and> space d = space E"
- hence "A \<subseteq> space d" using dynkin_subset by auto }
- show "x \<in> space \<delta>E" using asm unfolding \<delta>E_def sets_\<delta>E_def using not_empty
- by simp (metis dynkin_subset in_mono mem_def)
- next
- show "space \<delta>E \<in> sets \<delta>E"
- unfolding \<delta>E_def sets_\<delta>E_def
- using dynkin_space by fastsimp
- next
- fix a b assume "a \<in> sets \<delta>E" "b \<in> sets \<delta>E" "a \<subseteq> b"
- thus "b - a \<in> sets \<delta>E"
- unfolding \<delta>E_def sets_\<delta>E_def by (auto intro:dynkin_diff)
- next
- fix a assume asm: "\<And>i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {}" "\<And>i. a i \<in> sets \<delta>E"
- thus "UNION UNIV a \<in> sets \<delta>E"
- unfolding \<delta>E_def sets_\<delta>E_def apply (auto intro!:dynkin_UN[OF _ asm(1)])
- by blast
- qed
+lemma case_prod_distrib: "f (case x of (x, y) \<Rightarrow> g x y) = (case x of (x, y) \<Rightarrow> f (g x y))"
+ by (cases x) simp
+
+abbreviation
+ "Pi\<^isub>E A B \<equiv> Pi A B \<inter> extensional A"
- def Dy == "\<lambda> d. {A | A. A \<in> sets_\<delta>E \<and> A \<inter> d \<in> sets_\<delta>E}"
- { fix d assume dasm: "d \<in> sets_\<delta>E"
- have "dynkin \<lparr> space = space E, sets = Dy d \<rparr>"
- proof (rule dynkinI, safe, simp_all)
- fix A x assume "A \<in> Dy d" "x \<in> A"
- thus "x \<in> space E" unfolding Dy_def sets_\<delta>E_def using not_empty
- by simp (metis dynkin_subset in_mono mem_def)
- next
- show "space E \<in> Dy d"
- unfolding Dy_def \<delta>E_def sets_\<delta>E_def
- proof auto
- fix d assume asm: "dynkin d" "space d = space E" "sets E \<subseteq> sets d"
- hence "space d \<in> sets d" using dynkin_space[OF asm(1)] by auto
- thus "space E \<in> sets d" using asm by auto
- next
- fix da :: "'a algebra" assume asm: "dynkin da" "space da = space E" "sets E \<subseteq> sets da"
- have d: "d = space E \<inter> d"
- using dasm dynkin_subset[OF asm(1)] asm(2) dynkin_subset[OF \<delta>ynkin]
- unfolding \<delta>E_def by auto
- hence "space E \<inter> d \<in> sets \<delta>E" unfolding \<delta>E_def
- using dasm by auto
- have "sets \<delta>E \<subseteq> sets da" unfolding \<delta>E_def sets_\<delta>E_def using asm
- by auto
- thus "space E \<inter> d \<in> sets da" using dasm asm d dynkin_subset[OF \<delta>ynkin]
- unfolding \<delta>E_def by auto
- qed
- next
- fix a b assume absm: "a \<in> Dy d" "b \<in> Dy d" "a \<subseteq> b"
- hence "a \<in> sets \<delta>E" "b \<in> sets \<delta>E"
- unfolding Dy_def \<delta>E_def by auto
- hence *: "b - a \<in> sets \<delta>E"
- using dynkin_diff[OF \<delta>ynkin] `a \<subseteq> b` by auto
- have "a \<inter> d \<in> sets \<delta>E" "b \<inter> d \<in> sets \<delta>E"
- using absm unfolding Dy_def \<delta>E_def by auto
- hence "(b \<inter> d) - (a \<inter> d) \<in> sets \<delta>E"
- using dynkin_diff[OF \<delta>ynkin] `a \<subseteq> b` by auto
- hence **: "(b - a) \<inter> d \<in> sets \<delta>E" by (auto simp add:Diff_Int_distrib2)
- thus "b - a \<in> Dy d"
- using * ** unfolding Dy_def \<delta>E_def by auto
- next
- fix a assume aasm: "\<And>i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {}" "\<And>i. a i \<in> Dy d"
- hence "\<And> i. a i \<in> sets \<delta>E"
- unfolding Dy_def \<delta>E_def by auto
- from dynkin_UN[OF \<delta>ynkin aasm(1) this]
- have *: "UNION UNIV a \<in> sets \<delta>E" by auto
- from aasm
- have aE: "\<forall> i. a i \<inter> d \<in> sets \<delta>E"
- unfolding Dy_def \<delta>E_def by auto
- from aasm
- have "\<And>i j :: nat. i \<noteq> j \<Longrightarrow> (a i \<inter> d) \<inter> (a j \<inter> d) = {}" by auto
- from dynkin_UN[OF \<delta>ynkin this]
- have "UNION UNIV (\<lambda> i. a i \<inter> d) \<in> sets \<delta>E"
- using aE by auto
- hence **: "UNION UNIV a \<inter> d \<in> sets \<delta>E" by auto
- from * ** show "UNION UNIV a \<in> Dy d" unfolding Dy_def \<delta>E_def by auto
- qed } note Dy_nkin = this
- have E_\<delta>E: "sets E \<subseteq> sets \<delta>E"
- unfolding \<delta>E_def sets_\<delta>E_def by auto
- { fix d assume dasm: "d \<in> sets \<delta>E"
- { fix e assume easm: "e \<in> sets E"
- hence deasm: "e \<in> sets \<delta>E"
- unfolding \<delta>E_def sets_\<delta>E_def by auto
- have subset: "Dy e \<subseteq> sets \<delta>E"
- unfolding Dy_def \<delta>E_def by auto
- { fix e' assume e'asm: "e' \<in> sets E"
- have "e' \<inter> e \<in> sets E"
- using easm e'asm stab unfolding Int_stable_def by auto
- hence "e' \<inter> e \<in> sets \<delta>E"
- unfolding \<delta>E_def sets_\<delta>E_def by auto
- hence "e' \<in> Dy e" using e'asm unfolding Dy_def \<delta>E_def sets_\<delta>E_def by auto }
- hence E_Dy: "sets E \<subseteq> Dy e" by auto
- have "\<lparr> space = space E, sets = Dy e \<rparr> \<in> {d | d. dynkin d \<and> space d = space E \<and> sets E \<subseteq> sets d}"
- using Dy_nkin[OF deasm[unfolded \<delta>E_def, simplified]] E_\<delta>E E_Dy by auto
- hence "sets_\<delta>E \<subseteq> Dy e"
- unfolding sets_\<delta>E_def by auto (metis E_Dy simps(1) simps(2) spac)
- hence "sets \<delta>E = Dy e" using subset unfolding \<delta>E_def by auto
- hence "d \<inter> e \<in> sets \<delta>E"
- using dasm easm deasm unfolding Dy_def \<delta>E_def by auto
- hence "e \<in> Dy d" using deasm
- unfolding Dy_def \<delta>E_def
- by (auto simp add:Int_commute) }
- hence "sets E \<subseteq> Dy d" by auto
- hence "sets \<delta>E \<subseteq> Dy d" using Dy_nkin[OF dasm[unfolded \<delta>E_def, simplified]]
- unfolding \<delta>E_def sets_\<delta>E_def
- by auto (metis `sets E <= Dy d` simps(1) simps(2) spac)
- hence *: "sets \<delta>E = Dy d"
- unfolding Dy_def \<delta>E_def by auto
- fix a assume aasm: "a \<in> sets \<delta>E"
- hence "a \<inter> d \<in> sets \<delta>E"
- using * dasm unfolding Dy_def \<delta>E_def by auto } note \<delta>E_stab = this
- { fix A :: "nat \<Rightarrow> 'a set" assume Asm: "range A \<subseteq> sets \<delta>E" "\<And>A. A \<in> sets \<delta>E \<Longrightarrow> A \<subseteq> space \<delta>E"
- "\<And>a. a \<in> sets \<delta>E \<Longrightarrow> space \<delta>E - a \<in> sets \<delta>E"
- "{} \<in> sets \<delta>E" "space \<delta>E \<in> sets \<delta>E"
- let "?A i" = "A i \<inter> (\<Inter> j \<in> {..< i}. space \<delta>E - A j)"
- { fix i :: nat
- have *: "(\<Inter> j \<in> {..< i}. space \<delta>E - A j) \<inter> space \<delta>E \<in> sets \<delta>E"
- apply (induct i)
- using lessThan_Suc Asm \<delta>E_stab apply fastsimp
- apply (subst lessThan_Suc)
- apply (subst INT_insert)
- apply (subst Int_assoc)
- apply (subst \<delta>E_stab)
- using lessThan_Suc Asm \<delta>E_stab Asm
- apply (fastsimp simp add:Int_assoc dynkin_diff[OF \<delta>ynkin])
- prefer 2 apply simp
- apply (rule dynkin_diff[OF \<delta>ynkin, of _ "space \<delta>E", OF _ dynkin_space[OF \<delta>ynkin]])
- using Asm by auto
- have **: "\<And> i. A i \<subseteq> space \<delta>E" using Asm by auto
- have "(\<Inter> j \<in> {..< i}. space \<delta>E - A j) \<subseteq> space \<delta>E \<or> (\<Inter> j \<in> {..< i}. A j) = UNIV \<and> i = 0"
- apply (cases i)
- using Asm ** dynkin_subset[OF \<delta>ynkin, of "A (i - 1)"]
- by auto
- hence Aisets: "?A i \<in> sets \<delta>E"
- apply (cases i)
- using Asm * apply fastsimp
- apply (rule \<delta>E_stab)
- using Asm * **
- by (auto simp add:Int_absorb2)
- have "?A i = disjointed A i" unfolding disjointed_def
- atLeast0LessThan using Asm by auto
- hence "?A i = disjointed A i" "?A i \<in> sets \<delta>E"
- using Aisets by auto
- } note Ai = this
- from dynkin_UN[OF \<delta>ynkin _ this(2)] this disjoint_family_disjointed[of A]
- have "(\<Union> i. ?A i) \<in> sets \<delta>E"
- by (auto simp add:disjoint_family_on_def disjointed_def)
- hence "(\<Union> i. A i) \<in> sets \<delta>E"
- using Ai(1) UN_disjointed_eq[of A] by auto } note \<delta>E_UN = this
- { fix a b assume asm: "a \<in> sets \<delta>E" "b \<in> sets \<delta>E"
- let ?ab = "\<lambda> i. if (i::nat) = 0 then a else if i = 1 then b else {}"
- have *: "(\<Union> i. ?ab i) \<in> sets \<delta>E"
- apply (rule \<delta>E_UN)
- using asm \<delta>E_UN dynkin_empty[OF \<delta>ynkin]
- dynkin_subset[OF \<delta>ynkin]
- dynkin_space[OF \<delta>ynkin]
- dynkin_diff[OF \<delta>ynkin] by auto
- have "(\<Union> i. ?ab i) = a \<union> b" apply auto
- apply (case_tac "i = 0")
- apply auto
- apply (case_tac "i = 1")
- by auto
- hence "a \<union> b \<in> sets \<delta>E" using * by auto} note \<delta>E_Un = this
- have "sigma_algebra \<delta>E"
- apply unfold_locales
- using dynkin_subset[OF \<delta>ynkin]
- using dynkin_diff[OF \<delta>ynkin, of _ "space \<delta>E", OF _ dynkin_space[OF \<delta>ynkin]]
- using dynkin_diff[OF \<delta>ynkin, of "space \<delta>E" "space \<delta>E", OF dynkin_space[OF \<delta>ynkin] dynkin_space[OF \<delta>ynkin]]
- using dynkin_space[OF \<delta>ynkin]
- using \<delta>E_UN \<delta>E_Un
- by auto
- from sigma_algebra.sigma_subset[OF this E_\<delta>E] \<delta>E_D subsDE spac
- show ?thesis by (auto simp add:\<delta>E_def sigma_def)
-qed
+abbreviation
+ funcset_extensional :: "['a set, 'b set] => ('a => 'b) set"
+ (infixr "->\<^isub>E" 60) where
+ "A ->\<^isub>E B \<equiv> Pi\<^isub>E A (%_. B)"
+
+notation (xsymbols)
+ funcset_extensional (infixr "\<rightarrow>\<^isub>E" 60)
-lemma measure_eq:
- assumes fin: "\<mu> (space M) = \<nu> (space M)" "\<nu> (space M) < \<omega>"
- assumes E: "M = sigma (space E) (sets E)" "Int_stable E"
- assumes eq: "\<And> e. e \<in> sets E \<Longrightarrow> \<mu> e = \<nu> e"
- assumes ms: "measure_space M \<mu>" "measure_space M \<nu>"
- assumes A: "A \<in> sets M"
- shows "\<mu> A = \<nu> A"
-proof -
- interpret M: measure_space M \<mu>
- using ms by simp
- interpret M': measure_space M \<nu>
- using ms by simp
+lemma extensional_empty[simp]: "extensional {} = {\<lambda>x. undefined}"
+ by safe (auto simp add: extensional_def fun_eq_iff)
- let ?D_sets = "{A. A \<in> sets M \<and> \<mu> A = \<nu> A}"
- have \<delta>: "dynkin \<lparr> space = space M , sets = ?D_sets \<rparr>"
- proof (rule dynkinI, safe, simp_all)
- fix A x assume "A \<in> sets M \<and> \<mu> A = \<nu> A" "x \<in> A"
- thus "x \<in> space M" using assms M.sets_into_space by auto
- next
- show "\<mu> (space M) = \<nu> (space M)"
- using fin by auto
- next
- fix a b
- assume asm: "a \<in> sets M \<and> \<mu> a = \<nu> a"
- "b \<in> sets M \<and> \<mu> b = \<nu> b" "a \<subseteq> b"
- hence "a \<subseteq> space M"
- using M.sets_into_space by auto
- from M.measure_mono[OF this]
- have "\<mu> a \<le> \<mu> (space M)"
- using asm by auto
- hence afin: "\<mu> a < \<omega>"
- using fin by auto
- have *: "b = b - a \<union> a" using asm by auto
- have **: "(b - a) \<inter> a = {}" using asm by auto
- have iv: "\<mu> (b - a) + \<mu> a = \<mu> b"
- using M.measure_additive[of "b - a" a]
- conjunct1[OF asm(1)] conjunct1[OF asm(2)] * **
- by auto
- have v: "\<nu> (b - a) + \<nu> a = \<nu> b"
- using M'.measure_additive[of "b - a" a]
- conjunct1[OF asm(1)] conjunct1[OF asm(2)] * **
- by auto
- from iv v have "\<mu> (b - a) = \<nu> (b - a)" using asm afin
- pinfreal_add_cancel_right[of "\<mu> (b - a)" "\<nu> a" "\<nu> (b - a)"]
- by auto
- thus "b - a \<in> sets M \<and> \<mu> (b - a) = \<nu> (b - a)"
- using asm by auto
- next
- fix a assume "\<And>i j :: nat. i \<noteq> j \<Longrightarrow> a i \<inter> a j = {}"
- "\<And>i. a i \<in> sets M \<and> \<mu> (a i) = \<nu> (a i)"
- thus "(\<Union>x. a x) \<in> sets M \<and> \<mu> (\<Union>x. a x) = \<nu> (\<Union>x. a x)"
- using M.measure_countably_additive
- M'.measure_countably_additive
- M.countable_UN
- apply (auto simp add:disjoint_family_on_def image_def)
- apply (subst M.measure_countably_additive[symmetric])
- apply (auto simp add:disjoint_family_on_def)
- apply (subst M'.measure_countably_additive[symmetric])
- by (auto simp add:disjoint_family_on_def)
- qed
- have *: "sets E \<subseteq> ?D_sets"
- using eq E sigma_sets.Basic[of _ "sets E"]
- by (auto simp add:sigma_def)
- have **: "?D_sets \<subseteq> sets M" by auto
- have "M = \<lparr> space = space M , sets = ?D_sets \<rparr>"
- unfolding E(1)
- apply (rule dynkin_lemma[OF E(2)])
- using eq E space_sigma \<delta> sigma_sets.Basic
- by (auto simp add:sigma_def)
- from subst[OF this, of "\<lambda> M. A \<in> sets M", OF A]
- show ?thesis by auto
-qed
-(*
-lemma
- assumes sfin: "range A \<subseteq> sets M" "(\<Union>i. A i) = space M" "\<And> i :: nat. \<nu> (A i) < \<omega>"
- assumes A: "\<And> i. \<mu> (A i) = \<nu> (A i)" "\<And> i. A i \<subseteq> A (Suc i)"
- assumes E: "M = sigma (space E) (sets E)" "Int_stable E"
- assumes eq: "\<And> e. e \<in> sets E \<Longrightarrow> \<mu> e = \<nu> e"
- assumes ms: "measure_space (M :: 'a algebra) \<mu>" "measure_space M \<nu>"
- assumes B: "B \<in> sets M"
- shows "\<mu> B = \<nu> B"
-proof -
- interpret M: measure_space M \<mu> by (rule ms)
- interpret M': measure_space M \<nu> by (rule ms)
- have *: "M = \<lparr> space = space M, sets = sets M \<rparr>" by auto
- { fix i :: nat
- have **: "M\<lparr> space := A i, sets := op \<inter> (A i) ` sets M \<rparr> =
- \<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr>"
- by auto
- have mu_i: "measure_space \<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr> \<mu>"
- using M.restricted_measure_space[of "A i", simplified **]
- sfin by auto
- have nu_i: "measure_space \<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr> \<nu>"
- using M'.restricted_measure_space[of "A i", simplified **]
- sfin by auto
- let ?M = "\<lparr> space = A i, sets = op \<inter> (A i) ` sets M \<rparr>"
- have "\<mu> (A i \<inter> B) = \<nu> (A i \<inter> B)"
- apply (rule measure_eq[of \<mu> ?M \<nu> "\<lparr> space = space E \<inter> A i, sets = op \<inter> (A i) ` sets E\<rparr>" "A i \<inter> B", simplified])
- using assms nu_i mu_i
- apply (auto simp add:image_def) (* TODO *) sorry
- show ?thesis sorry
-qed
-*)
-definition prod_sets where
- "prod_sets A B = {z. \<exists>x \<in> A. \<exists>y \<in> B. z = x \<times> y}"
+lemma extensional_insert[intro, simp]:
+ assumes "a \<in> extensional (insert i I)"
+ shows "a(i := b) \<in> extensional (insert i I)"
+ using assms unfolding extensional_def by auto
+
+lemma extensional_Int[simp]:
+ "extensional I \<inter> extensional I' = extensional (I \<inter> I')"
+ unfolding extensional_def by auto
definition
- "prod_measure_space M1 M2 = sigma (space M1 \<times> space M2) (prod_sets (sets M1) (sets M2))"
+ "merge I x J y = (\<lambda>i. if i \<in> I then x i else if i \<in> J then y i else undefined)"
+
+lemma merge_apply[simp]:
+ "I \<inter> J = {} \<Longrightarrow> i \<in> I \<Longrightarrow> merge I x J y i = x i"
+ "I \<inter> J = {} \<Longrightarrow> i \<in> J \<Longrightarrow> merge I x J y i = y i"
+ "J \<inter> I = {} \<Longrightarrow> i \<in> I \<Longrightarrow> merge I x J y i = x i"
+ "J \<inter> I = {} \<Longrightarrow> i \<in> J \<Longrightarrow> merge I x J y i = y i"
+ "i \<notin> I \<Longrightarrow> i \<notin> J \<Longrightarrow> merge I x J y i = undefined"
+ unfolding merge_def by auto
+
+lemma merge_commute:
+ "I \<inter> J = {} \<Longrightarrow> merge I x J y = merge J y I x"
+ by (auto simp: merge_def intro!: ext)
+
+lemma Pi_cancel_merge_range[simp]:
+ "I \<inter> J = {} \<Longrightarrow> x \<in> Pi I (merge I A J B) \<longleftrightarrow> x \<in> Pi I A"
+ "I \<inter> J = {} \<Longrightarrow> x \<in> Pi I (merge J B I A) \<longleftrightarrow> x \<in> Pi I A"
+ "J \<inter> I = {} \<Longrightarrow> x \<in> Pi I (merge I A J B) \<longleftrightarrow> x \<in> Pi I A"
+ "J \<inter> I = {} \<Longrightarrow> x \<in> Pi I (merge J B I A) \<longleftrightarrow> x \<in> Pi I A"
+ by (auto simp: Pi_def)
+
+lemma Pi_cancel_merge[simp]:
+ "I \<inter> J = {} \<Longrightarrow> merge I x J y \<in> Pi I B \<longleftrightarrow> x \<in> Pi I B"
+ "J \<inter> I = {} \<Longrightarrow> merge I x J y \<in> Pi I B \<longleftrightarrow> x \<in> Pi I B"
+ "I \<inter> J = {} \<Longrightarrow> merge I x J y \<in> Pi J B \<longleftrightarrow> y \<in> Pi J B"
+ "J \<inter> I = {} \<Longrightarrow> merge I x J y \<in> Pi J B \<longleftrightarrow> y \<in> Pi J B"
+ by (auto simp: Pi_def)
+
+lemma extensional_merge[simp]: "merge I x J y \<in> extensional (I \<union> J)"
+ by (auto simp: extensional_def)
+
+lemma restrict_Pi_cancel: "restrict x I \<in> Pi I A \<longleftrightarrow> x \<in> Pi I A"
+ by (auto simp: restrict_def Pi_def)
+
+lemma restrict_merge[simp]:
+ "I \<inter> J = {} \<Longrightarrow> restrict (merge I x J y) I = restrict x I"
+ "I \<inter> J = {} \<Longrightarrow> restrict (merge I x J y) J = restrict y J"
+ "J \<inter> I = {} \<Longrightarrow> restrict (merge I x J y) I = restrict x I"
+ "J \<inter> I = {} \<Longrightarrow> restrict (merge I x J y) J = restrict y J"
+ by (auto simp: restrict_def intro!: ext)
+
+lemma extensional_insert_undefined[intro, simp]:
+ assumes "a \<in> extensional (insert i I)"
+ shows "a(i := undefined) \<in> extensional I"
+ using assms unfolding extensional_def by auto
+
+lemma extensional_insert_cancel[intro, simp]:
+ assumes "a \<in> extensional I"
+ shows "a \<in> extensional (insert i I)"
+ using assms unfolding extensional_def by auto
+
+lemma PiE_Int: "(Pi\<^isub>E I A) \<inter> (Pi\<^isub>E I B) = Pi\<^isub>E I (\<lambda>x. A x \<inter> B x)"
+ by auto
+
+lemma Pi_cancel_fupd_range[simp]: "i \<notin> I \<Longrightarrow> x \<in> Pi I (B(i := b)) \<longleftrightarrow> x \<in> Pi I B"
+ by (auto simp: Pi_def)
+
+lemma Pi_split_insert_domain[simp]: "x \<in> Pi (insert i I) X \<longleftrightarrow> x \<in> Pi I X \<and> x i \<in> X i"
+ by (auto simp: Pi_def)
-lemma
- fixes M1 :: "'a algebra" and M2 :: "'b algebra"
- assumes "algebra M1" "algebra M2"
- shows measureable_fst[intro!, simp]:
- "fst \<in> measurable (prod_measure_space M1 M2) M1" (is ?fst)
- and measureable_snd[intro!, simp]:
- "snd \<in> measurable (prod_measure_space M1 M2) M2" (is ?snd)
+lemma Pi_split_domain[simp]: "x \<in> Pi (I \<union> J) X \<longleftrightarrow> x \<in> Pi I X \<and> x \<in> Pi J X"
+ by (auto simp: Pi_def)
+
+lemma Pi_cancel_fupd[simp]: "i \<notin> I \<Longrightarrow> x(i := a) \<in> Pi I B \<longleftrightarrow> x \<in> Pi I B"
+ by (auto simp: Pi_def)
+
+section "Binary products"
+
+definition
+ "pair_algebra A B = \<lparr> space = space A \<times> space B,
+ sets = {a \<times> b | a b. a \<in> sets A \<and> b \<in> sets B} \<rparr>"
+
+locale pair_sigma_algebra = M1: sigma_algebra M1 + M2: sigma_algebra M2
+ for M1 M2
+
+abbreviation (in pair_sigma_algebra)
+ "E \<equiv> pair_algebra M1 M2"
+
+abbreviation (in pair_sigma_algebra)
+ "P \<equiv> sigma E"
+
+sublocale pair_sigma_algebra \<subseteq> sigma_algebra P
+ using M1.sets_into_space M2.sets_into_space
+ by (force simp: pair_algebra_def intro!: sigma_algebra_sigma)
+
+lemma pair_algebraI[intro, simp]:
+ "x \<in> sets A \<Longrightarrow> y \<in> sets B \<Longrightarrow> x \<times> y \<in> sets (pair_algebra A B)"
+ by (auto simp add: pair_algebra_def)
+
+lemma space_pair_algebra:
+ "space (pair_algebra A B) = space A \<times> space B"
+ by (simp add: pair_algebra_def)
+
+lemma pair_algebra_Int_snd:
+ assumes "sets S1 \<subseteq> Pow (space S1)"
+ shows "pair_algebra S1 (algebra.restricted_space S2 A) =
+ algebra.restricted_space (pair_algebra S1 S2) (space S1 \<times> A)"
+ (is "?L = ?R")
+proof (intro algebra.equality set_eqI iffI)
+ fix X assume "X \<in> sets ?L"
+ then obtain A1 A2 where X: "X = A1 \<times> (A \<inter> A2)" and "A1 \<in> sets S1" "A2 \<in> sets S2"
+ by (auto simp: pair_algebra_def)
+ then show "X \<in> sets ?R" unfolding pair_algebra_def
+ using assms apply simp by (intro image_eqI[of _ _ "A1 \<times> A2"]) auto
+next
+ fix X assume "X \<in> sets ?R"
+ then obtain A1 A2 where "X = space S1 \<times> A \<inter> A1 \<times> A2" "A1 \<in> sets S1" "A2 \<in> sets S2"
+ by (auto simp: pair_algebra_def)
+ moreover then have "X = A1 \<times> (A \<inter> A2)"
+ using assms by auto
+ ultimately show "X \<in> sets ?L"
+ unfolding pair_algebra_def by auto
+qed (auto simp add: pair_algebra_def)
+
+lemma (in pair_sigma_algebra)
+ shows measurable_fst[intro!, simp]:
+ "fst \<in> measurable P M1" (is ?fst)
+ and measurable_snd[intro!, simp]:
+ "snd \<in> measurable P M2" (is ?snd)
proof -
- interpret M1: algebra M1 by fact
- interpret M2: algebra M2 by fact
-
{ fix X assume "X \<in> sets M1"
then have "\<exists>X1\<in>sets M1. \<exists>X2\<in>sets M2. fst -` X \<inter> space M1 \<times> space M2 = X1 \<times> X2"
apply - apply (rule bexI[of _ X]) apply (rule bexI[of _ "space M2"])
@@ -372,186 +167,1437 @@
then have "\<exists>X1\<in>sets M1. \<exists>X2\<in>sets M2. snd -` X \<inter> space M1 \<times> space M2 = X1 \<times> X2"
apply - apply (rule bexI[of _ "space M1"]) apply (rule bexI[of _ X])
using M2.sets_into_space by force+ }
- ultimately show ?fst ?snd
- by (force intro!: sigma_sets.Basic
- simp: measurable_def prod_measure_space_def prod_sets_def sets_sigma)+
+ ultimately have "?fst \<and> ?snd"
+ by (fastsimp simp: measurable_def sets_sigma space_pair_algebra
+ intro!: sigma_sets.Basic)
+ then show ?fst ?snd by auto
+qed
+
+lemma (in pair_sigma_algebra) measurable_pair:
+ assumes "sigma_algebra M"
+ shows "f \<in> measurable M P \<longleftrightarrow>
+ (fst \<circ> f) \<in> measurable M M1 \<and> (snd \<circ> f) \<in> measurable M M2"
+proof -
+ interpret M: sigma_algebra M by fact
+ from assms show ?thesis
+ proof (safe intro!: measurable_comp[where b=P])
+ assume f: "(fst \<circ> f) \<in> measurable M M1" and s: "(snd \<circ> f) \<in> measurable M M2"
+ show "f \<in> measurable M P"
+ proof (rule M.measurable_sigma)
+ show "sets (pair_algebra M1 M2) \<subseteq> Pow (space E)"
+ unfolding pair_algebra_def using M1.sets_into_space M2.sets_into_space by auto
+ show "f \<in> space M \<rightarrow> space E"
+ using f s by (auto simp: mem_Times_iff measurable_def comp_def space_sigma space_pair_algebra)
+ fix A assume "A \<in> sets E"
+ then obtain B C where "B \<in> sets M1" "C \<in> sets M2" "A = B \<times> C"
+ unfolding pair_algebra_def by auto
+ moreover have "(fst \<circ> f) -` B \<inter> space M \<in> sets M"
+ using f `B \<in> sets M1` unfolding measurable_def by auto
+ moreover have "(snd \<circ> f) -` C \<inter> space M \<in> sets M"
+ using s `C \<in> sets M2` unfolding measurable_def by auto
+ moreover have "f -` A \<inter> space M = ((fst \<circ> f) -` B \<inter> space M) \<inter> ((snd \<circ> f) -` C \<inter> space M)"
+ unfolding `A = B \<times> C` by (auto simp: vimage_Times)
+ ultimately show "f -` A \<inter> space M \<in> sets M" by auto
+ qed
+ qed
+qed
+
+lemma (in pair_sigma_algebra) measurable_prod_sigma:
+ assumes "sigma_algebra M"
+ assumes 1: "(fst \<circ> f) \<in> measurable M M1" and 2: "(snd \<circ> f) \<in> measurable M M2"
+ shows "f \<in> measurable M P"
+proof -
+ interpret M: sigma_algebra M by fact
+ from 1 have fn1: "fst \<circ> f \<in> space M \<rightarrow> space M1"
+ and q1: "\<forall>y\<in>sets M1. (fst \<circ> f) -` y \<inter> space M \<in> sets M"
+ by (auto simp add: measurable_def)
+ from 2 have fn2: "snd \<circ> f \<in> space M \<rightarrow> space M2"
+ and q2: "\<forall>y\<in>sets M2. (snd \<circ> f) -` y \<inter> space M \<in> sets M"
+ by (auto simp add: measurable_def)
+ show ?thesis
+ proof (rule M.measurable_sigma)
+ show "sets E \<subseteq> Pow (space E)"
+ using M1.space_closed M2.space_closed
+ by (auto simp add: sigma_algebra_iff pair_algebra_def)
+ next
+ show "f \<in> space M \<rightarrow> space E"
+ by (simp add: space_pair_algebra) (rule prod_final [OF fn1 fn2])
+ next
+ fix z
+ assume z: "z \<in> sets E"
+ thus "f -` z \<inter> space M \<in> sets M"
+ proof (auto simp add: pair_algebra_def vimage_Times)
+ fix x y
+ assume x: "x \<in> sets M1" and y: "y \<in> sets M2"
+ have "(fst \<circ> f) -` x \<inter> (snd \<circ> f) -` y \<inter> space M =
+ ((fst \<circ> f) -` x \<inter> space M) \<inter> ((snd \<circ> f) -` y \<inter> space M)"
+ by blast
+ also have "... \<in> sets M" using x y q1 q2
+ by blast
+ finally show "(fst \<circ> f) -` x \<inter> (snd \<circ> f) -` y \<inter> space M \<in> sets M" .
+ qed
+ qed
+qed
+
+lemma pair_algebraE:
+ assumes "X \<in> sets (pair_algebra M1 M2)"
+ obtains A B where "X = A \<times> B" "A \<in> sets M1" "B \<in> sets M2"
+ using assms unfolding pair_algebra_def by auto
+
+lemma (in pair_sigma_algebra) pair_algebra_swap:
+ "(\<lambda>X. (\<lambda>(x,y). (y,x)) -` X \<inter> space M2 \<times> space M1) ` sets E = sets (pair_algebra M2 M1)"
+proof (safe elim!: pair_algebraE)
+ fix A B assume "A \<in> sets M1" "B \<in> sets M2"
+ moreover then have "(\<lambda>(x, y). (y, x)) -` (A \<times> B) \<inter> space M2 \<times> space M1 = B \<times> A"
+ using M1.sets_into_space M2.sets_into_space by auto
+ ultimately show "(\<lambda>(x, y). (y, x)) -` (A \<times> B) \<inter> space M2 \<times> space M1 \<in> sets (pair_algebra M2 M1)"
+ by (auto intro: pair_algebraI)
+next
+ fix A B assume "A \<in> sets M1" "B \<in> sets M2"
+ then show "B \<times> A \<in> (\<lambda>X. (\<lambda>(x, y). (y, x)) -` X \<inter> space M2 \<times> space M1) ` sets E"
+ using M1.sets_into_space M2.sets_into_space
+ by (auto intro!: image_eqI[where x="A \<times> B"] pair_algebraI)
+qed
+
+lemma (in pair_sigma_algebra) sets_pair_sigma_algebra_swap:
+ assumes Q: "Q \<in> sets P"
+ shows "(\<lambda>(x,y). (y, x)) ` Q \<in> sets (sigma (pair_algebra M2 M1))" (is "_ \<in> sets ?Q")
+proof -
+ have *: "(\<lambda>(x,y). (y, x)) \<in> space M2 \<times> space M1 \<rightarrow> (space M1 \<times> space M2)"
+ "sets (pair_algebra M1 M2) \<subseteq> Pow (space M1 \<times> space M2)"
+ using M1.sets_into_space M2.sets_into_space by (auto elim!: pair_algebraE)
+ from Q sets_into_space show ?thesis
+ by (auto intro!: image_eqI[where x=Q]
+ simp: pair_algebra_swap[symmetric] sets_sigma
+ sigma_sets_vimage[OF *] space_pair_algebra)
+qed
+
+lemma (in pair_sigma_algebra) pair_sigma_algebra_swap_measurable:
+ shows "(\<lambda>(x,y). (y, x)) \<in> measurable P (sigma (pair_algebra M2 M1))"
+ (is "?f \<in> measurable ?P ?Q")
+ unfolding measurable_def
+proof (intro CollectI conjI Pi_I ballI)
+ fix x assume "x \<in> space ?P" then show "(case x of (x, y) \<Rightarrow> (y, x)) \<in> space ?Q"
+ unfolding pair_algebra_def by auto
+next
+ fix A assume "A \<in> sets ?Q"
+ interpret Q: pair_sigma_algebra M2 M1 by default
+ have "?f -` A \<inter> space ?P = (\<lambda>(x,y). (y, x)) ` A"
+ using Q.sets_into_space `A \<in> sets ?Q` by (auto simp: pair_algebra_def)
+ with Q.sets_pair_sigma_algebra_swap[OF `A \<in> sets ?Q`]
+ show "?f -` A \<inter> space ?P \<in> sets ?P" by simp
+qed
+
+lemma (in pair_sigma_algebra) measurable_cut_fst:
+ assumes "Q \<in> sets P" shows "Pair x -` Q \<in> sets M2"
+proof -
+ let ?Q' = "{Q. Q \<subseteq> space P \<and> Pair x -` Q \<in> sets M2}"
+ let ?Q = "\<lparr> space = space P, sets = ?Q' \<rparr>"
+ interpret Q: sigma_algebra ?Q
+ proof qed (auto simp: vimage_UN vimage_Diff space_pair_algebra)
+ have "sets E \<subseteq> sets ?Q"
+ using M1.sets_into_space M2.sets_into_space
+ by (auto simp: pair_algebra_def space_pair_algebra)
+ then have "sets P \<subseteq> sets ?Q"
+ by (subst pair_algebra_def, intro Q.sets_sigma_subset)
+ (simp_all add: pair_algebra_def)
+ with assms show ?thesis by auto
+qed
+
+lemma (in pair_sigma_algebra) measurable_cut_snd:
+ assumes Q: "Q \<in> sets P" shows "(\<lambda>x. (x, y)) -` Q \<in> sets M1" (is "?cut Q \<in> sets M1")
+proof -
+ interpret Q: pair_sigma_algebra M2 M1 by default
+ have "Pair y -` (\<lambda>(x, y). (y, x)) ` Q = (\<lambda>x. (x, y)) -` Q" by auto
+ with Q.measurable_cut_fst[OF sets_pair_sigma_algebra_swap[OF Q], of y]
+ show ?thesis by simp
+qed
+
+lemma (in pair_sigma_algebra) measurable_pair_image_snd:
+ assumes m: "f \<in> measurable P M" and "x \<in> space M1"
+ shows "(\<lambda>y. f (x, y)) \<in> measurable M2 M"
+ unfolding measurable_def
+proof (intro CollectI conjI Pi_I ballI)
+ fix y assume "y \<in> space M2" with `f \<in> measurable P M` `x \<in> space M1`
+ show "f (x, y) \<in> space M" unfolding measurable_def pair_algebra_def by auto
+next
+ fix A assume "A \<in> sets M"
+ then have "Pair x -` (f -` A \<inter> space P) \<in> sets M2" (is "?C \<in> _")
+ using `f \<in> measurable P M`
+ by (intro measurable_cut_fst) (auto simp: measurable_def)
+ also have "?C = (\<lambda>y. f (x, y)) -` A \<inter> space M2"
+ using `x \<in> space M1` by (auto simp: pair_algebra_def)
+ finally show "(\<lambda>y. f (x, y)) -` A \<inter> space M2 \<in> sets M2" .
+qed
+
+lemma (in pair_sigma_algebra) measurable_pair_image_fst:
+ assumes m: "f \<in> measurable P M" and "y \<in> space M2"
+ shows "(\<lambda>x. f (x, y)) \<in> measurable M1 M"
+proof -
+ interpret Q: pair_sigma_algebra M2 M1 by default
+ from Q.measurable_pair_image_snd[OF measurable_comp `y \<in> space M2`,
+ OF Q.pair_sigma_algebra_swap_measurable m]
+ show ?thesis by simp
+qed
+
+lemma (in pair_sigma_algebra) Int_stable_pair_algebra: "Int_stable E"
+ unfolding Int_stable_def
+proof (intro ballI)
+ fix A B assume "A \<in> sets E" "B \<in> sets E"
+ then obtain A1 A2 B1 B2 where "A = A1 \<times> A2" "B = B1 \<times> B2"
+ "A1 \<in> sets M1" "A2 \<in> sets M2" "B1 \<in> sets M1" "B2 \<in> sets M2"
+ unfolding pair_algebra_def by auto
+ then show "A \<inter> B \<in> sets E"
+ by (auto simp add: times_Int_times pair_algebra_def)
+qed
+
+lemma finite_measure_cut_measurable:
+ fixes M1 :: "'a algebra" and M2 :: "'b algebra"
+ assumes "sigma_finite_measure M1 \<mu>1" "finite_measure M2 \<mu>2"
+ assumes "Q \<in> sets (sigma (pair_algebra M1 M2))"
+ shows "(\<lambda>x. \<mu>2 (Pair x -` Q)) \<in> borel_measurable M1"
+ (is "?s Q \<in> _")
+proof -
+ interpret M1: sigma_finite_measure M1 \<mu>1 by fact
+ interpret M2: finite_measure M2 \<mu>2 by fact
+ interpret pair_sigma_algebra M1 M2 by default
+ have [intro]: "sigma_algebra M1" by fact
+ have [intro]: "sigma_algebra M2" by fact
+ let ?D = "\<lparr> space = space P, sets = {A\<in>sets P. ?s A \<in> borel_measurable M1} \<rparr>"
+ note space_pair_algebra[simp]
+ interpret dynkin_system ?D
+ proof (intro dynkin_systemI)
+ fix A assume "A \<in> sets ?D" then show "A \<subseteq> space ?D"
+ using sets_into_space by simp
+ next
+ from top show "space ?D \<in> sets ?D"
+ by (auto simp add: if_distrib intro!: M1.measurable_If)
+ next
+ fix A assume "A \<in> sets ?D"
+ with sets_into_space have "\<And>x. \<mu>2 (Pair x -` (space M1 \<times> space M2 - A)) =
+ (if x \<in> space M1 then \<mu>2 (space M2) - ?s A x else 0)"
+ by (auto intro!: M2.finite_measure_compl measurable_cut_fst
+ simp: vimage_Diff)
+ with `A \<in> sets ?D` top show "space ?D - A \<in> sets ?D"
+ by (auto intro!: Diff M1.measurable_If M1.borel_measurable_pinfreal_diff)
+ next
+ fix F :: "nat \<Rightarrow> ('a\<times>'b) set" assume "disjoint_family F" "range F \<subseteq> sets ?D"
+ moreover then have "\<And>x. \<mu>2 (\<Union>i. Pair x -` F i) = (\<Sum>\<^isub>\<infinity> i. ?s (F i) x)"
+ by (intro M2.measure_countably_additive[symmetric])
+ (auto intro!: measurable_cut_fst simp: disjoint_family_on_def)
+ ultimately show "(\<Union>i. F i) \<in> sets ?D"
+ by (auto simp: vimage_UN intro!: M1.borel_measurable_psuminf)
+ qed
+ have "P = ?D"
+ proof (intro dynkin_lemma)
+ show "Int_stable E" by (rule Int_stable_pair_algebra)
+ from M1.sets_into_space have "\<And>A. A \<in> sets M1 \<Longrightarrow> {x \<in> space M1. x \<in> A} = A"
+ by auto
+ then show "sets E \<subseteq> sets ?D"
+ by (auto simp: pair_algebra_def sets_sigma if_distrib
+ intro: sigma_sets.Basic intro!: M1.measurable_If)
+ qed auto
+ with `Q \<in> sets P` have "Q \<in> sets ?D" by simp
+ then show "?s Q \<in> borel_measurable M1" by simp
+qed
+
+subsection {* Binary products of $\sigma$-finite measure spaces *}
+
+locale pair_sigma_finite = M1: sigma_finite_measure M1 \<mu>1 + M2: sigma_finite_measure M2 \<mu>2
+ for M1 \<mu>1 M2 \<mu>2
+
+sublocale pair_sigma_finite \<subseteq> pair_sigma_algebra M1 M2
+ by default
+
+lemma (in pair_sigma_finite) measure_cut_measurable_fst:
+ assumes "Q \<in> sets P" shows "(\<lambda>x. \<mu>2 (Pair x -` Q)) \<in> borel_measurable M1" (is "?s Q \<in> _")
+proof -
+ have [intro]: "sigma_algebra M1" and [intro]: "sigma_algebra M2" by default+
+ have M1: "sigma_finite_measure M1 \<mu>1" by default
+
+ from M2.disjoint_sigma_finite guess F .. note F = this
+ let "?C x i" = "F i \<inter> Pair x -` Q"
+ { fix i
+ let ?R = "M2.restricted_space (F i)"
+ have [simp]: "space M1 \<times> F i \<inter> space M1 \<times> space M2 = space M1 \<times> F i"
+ using F M2.sets_into_space by auto
+ have "(\<lambda>x. \<mu>2 (Pair x -` (space M1 \<times> F i \<inter> Q))) \<in> borel_measurable M1"
+ proof (intro finite_measure_cut_measurable[OF M1])
+ show "finite_measure (M2.restricted_space (F i)) \<mu>2"
+ using F by (intro M2.restricted_to_finite_measure) auto
+ have "space M1 \<times> F i \<in> sets P"
+ using M1.top F by blast
+ from sigma_sets_Int[symmetric,
+ OF this[unfolded pair_sigma_algebra_def sets_sigma]]
+ show "(space M1 \<times> F i) \<inter> Q \<in> sets (sigma (pair_algebra M1 ?R))"
+ using `Q \<in> sets P`
+ using pair_algebra_Int_snd[OF M1.space_closed, of "F i" M2]
+ by (auto simp: pair_algebra_def sets_sigma)
+ qed
+ moreover have "\<And>x. Pair x -` (space M1 \<times> F i \<inter> Q) = ?C x i"
+ using `Q \<in> sets P` sets_into_space by (auto simp: space_pair_algebra)
+ ultimately have "(\<lambda>x. \<mu>2 (?C x i)) \<in> borel_measurable M1"
+ by simp }
+ moreover
+ { fix x
+ have "(\<Sum>\<^isub>\<infinity>i. \<mu>2 (?C x i)) = \<mu>2 (\<Union>i. ?C x i)"
+ proof (intro M2.measure_countably_additive)
+ show "range (?C x) \<subseteq> sets M2"
+ using F `Q \<in> sets P` by (auto intro!: M2.Int measurable_cut_fst)
+ have "disjoint_family F" using F by auto
+ show "disjoint_family (?C x)"
+ by (rule disjoint_family_on_bisimulation[OF `disjoint_family F`]) auto
+ qed
+ also have "(\<Union>i. ?C x i) = Pair x -` Q"
+ using F sets_into_space `Q \<in> sets P`
+ by (auto simp: space_pair_algebra)
+ finally have "\<mu>2 (Pair x -` Q) = (\<Sum>\<^isub>\<infinity>i. \<mu>2 (?C x i))"
+ by simp }
+ ultimately show ?thesis
+ by (auto intro!: M1.borel_measurable_psuminf)
+qed
+
+lemma (in pair_sigma_finite) measure_cut_measurable_snd:
+ assumes "Q \<in> sets P" shows "(\<lambda>y. \<mu>1 ((\<lambda>x. (x, y)) -` Q)) \<in> borel_measurable M2"
+proof -
+ interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
+ have [simp]: "\<And>y. (Pair y -` (\<lambda>(x, y). (y, x)) ` Q) = (\<lambda>x. (x, y)) -` Q"
+ by auto
+ note sets_pair_sigma_algebra_swap[OF assms]
+ from Q.measure_cut_measurable_fst[OF this]
+ show ?thesis by simp
+qed
+
+lemma (in pair_sigma_algebra) pair_sigma_algebra_measurable:
+ assumes "f \<in> measurable P M"
+ shows "(\<lambda>(x,y). f (y, x)) \<in> measurable (sigma (pair_algebra M2 M1)) M"
+proof -
+ interpret Q: pair_sigma_algebra M2 M1 by default
+ have *: "(\<lambda>(x,y). f (y, x)) = f \<circ> (\<lambda>(x,y). (y, x))" by (simp add: fun_eq_iff)
+ show ?thesis
+ using Q.pair_sigma_algebra_swap_measurable assms
+ unfolding * by (rule measurable_comp)
qed
-lemma (in sigma_algebra) measureable_prod:
- fixes M1 :: "'a algebra" and M2 :: "'b algebra"
- assumes "algebra M1" "algebra M2"
- shows "f \<in> measurable M (prod_measure_space M1 M2) \<longleftrightarrow>
- (fst \<circ> f) \<in> measurable M M1 \<and> (snd \<circ> f) \<in> measurable M M2"
-using assms proof (safe intro!: measurable_comp[where b="prod_measure_space M1 M2"])
- interpret M1: algebra M1 by fact
- interpret M2: algebra M2 by fact
- assume f: "(fst \<circ> f) \<in> measurable M M1" and s: "(snd \<circ> f) \<in> measurable M M2"
+lemma (in pair_sigma_algebra) pair_sigma_algebra_swap:
+ "sigma (pair_algebra M2 M1) = (vimage_algebra (space M2 \<times> space M1) (\<lambda>(x, y). (y, x)))"
+ unfolding vimage_algebra_def
+ apply (simp add: sets_sigma)
+ apply (subst sigma_sets_vimage[symmetric])
+ apply (fastsimp simp: pair_algebra_def)
+ using M1.sets_into_space M2.sets_into_space apply (fastsimp simp: pair_algebra_def)
+proof -
+ have "(\<lambda>X. (\<lambda>(x, y). (y, x)) -` X \<inter> space M2 \<times> space M1) ` sets E
+ = sets (pair_algebra M2 M1)" (is "?S = _")
+ by (rule pair_algebra_swap)
+ then show "sigma (pair_algebra M2 M1) = \<lparr>space = space M2 \<times> space M1,
+ sets = sigma_sets (space M2 \<times> space M1) ?S\<rparr>"
+ by (simp add: pair_algebra_def sigma_def)
+qed
+
+definition (in pair_sigma_finite)
+ "pair_measure A = M1.positive_integral (\<lambda>x.
+ M2.positive_integral (\<lambda>y. indicator A (x, y)))"
+
+lemma (in pair_sigma_finite) pair_measure_alt:
+ assumes "A \<in> sets P"
+ shows "pair_measure A = M1.positive_integral (\<lambda>x. \<mu>2 (Pair x -` A))"
+ unfolding pair_measure_def
+proof (rule M1.positive_integral_cong)
+ fix x assume "x \<in> space M1"
+ have *: "\<And>y. indicator A (x, y) = (indicator (Pair x -` A) y :: pinfreal)"
+ unfolding indicator_def by auto
+ show "M2.positive_integral (\<lambda>y. indicator A (x, y)) = \<mu>2 (Pair x -` A)"
+ unfolding *
+ apply (subst M2.positive_integral_indicator)
+ apply (rule measurable_cut_fst[OF assms])
+ by simp
+qed
+
+lemma (in pair_sigma_finite) pair_measure_times:
+ assumes A: "A \<in> sets M1" and "B \<in> sets M2"
+ shows "pair_measure (A \<times> B) = \<mu>1 A * \<mu>2 B"
+proof -
+ from assms have "pair_measure (A \<times> B) =
+ M1.positive_integral (\<lambda>x. \<mu>2 B * indicator A x)"
+ by (auto intro!: M1.positive_integral_cong simp: pair_measure_alt)
+ with assms show ?thesis
+ by (simp add: M1.positive_integral_cmult_indicator ac_simps)
+qed
+
+lemma (in pair_sigma_finite) sigma_finite_up_in_pair_algebra:
+ "\<exists>F::nat \<Rightarrow> ('a \<times> 'b) set. range F \<subseteq> sets E \<and> F \<up> space E \<and>
+ (\<forall>i. pair_measure (F i) \<noteq> \<omega>)"
+proof -
+ obtain F1 :: "nat \<Rightarrow> 'a set" and F2 :: "nat \<Rightarrow> 'b set" where
+ F1: "range F1 \<subseteq> sets M1" "F1 \<up> space M1" "\<And>i. \<mu>1 (F1 i) \<noteq> \<omega>" and
+ F2: "range F2 \<subseteq> sets M2" "F2 \<up> space M2" "\<And>i. \<mu>2 (F2 i) \<noteq> \<omega>"
+ using M1.sigma_finite_up M2.sigma_finite_up by auto
+ then have space: "space M1 = (\<Union>i. F1 i)" "space M2 = (\<Union>i. F2 i)"
+ unfolding isoton_def by auto
+ let ?F = "\<lambda>i. F1 i \<times> F2 i"
+ show ?thesis unfolding isoton_def space_pair_algebra
+ proof (intro exI[of _ ?F] conjI allI)
+ show "range ?F \<subseteq> sets E" using F1 F2
+ by (fastsimp intro!: pair_algebraI)
+ next
+ have "space M1 \<times> space M2 \<subseteq> (\<Union>i. ?F i)"
+ proof (intro subsetI)
+ fix x assume "x \<in> space M1 \<times> space M2"
+ then obtain i j where "fst x \<in> F1 i" "snd x \<in> F2 j"
+ by (auto simp: space)
+ then have "fst x \<in> F1 (max i j)" "snd x \<in> F2 (max j i)"
+ using `F1 \<up> space M1` `F2 \<up> space M2`
+ by (auto simp: max_def dest: isoton_mono_le)
+ then have "(fst x, snd x) \<in> F1 (max i j) \<times> F2 (max i j)"
+ by (intro SigmaI) (auto simp add: min_max.sup_commute)
+ then show "x \<in> (\<Union>i. ?F i)" by auto
+ qed
+ then show "(\<Union>i. ?F i) = space M1 \<times> space M2"
+ using space by (auto simp: space)
+ next
+ fix i show "F1 i \<times> F2 i \<subseteq> F1 (Suc i) \<times> F2 (Suc i)"
+ using `F1 \<up> space M1` `F2 \<up> space M2` unfolding isoton_def
+ by auto
+ next
+ fix i
+ from F1 F2 have "F1 i \<in> sets M1" "F2 i \<in> sets M2" by auto
+ with F1 F2 show "pair_measure (F1 i \<times> F2 i) \<noteq> \<omega>"
+ by (simp add: pair_measure_times)
+ qed
+qed
+
+sublocale pair_sigma_finite \<subseteq> sigma_finite_measure P pair_measure
+proof
+ show "pair_measure {} = 0"
+ unfolding pair_measure_def by auto
+
+ show "countably_additive P pair_measure"
+ unfolding countably_additive_def
+ proof (intro allI impI)
+ fix F :: "nat \<Rightarrow> ('a \<times> 'b) set"
+ assume F: "range F \<subseteq> sets P" "disjoint_family F"
+ from F have *: "\<And>i. F i \<in> sets P" "(\<Union>i. F i) \<in> sets P" by auto
+ moreover from F have "\<And>i. (\<lambda>x. \<mu>2 (Pair x -` F i)) \<in> borel_measurable M1"
+ by (intro measure_cut_measurable_fst) auto
+ moreover have "\<And>x. disjoint_family (\<lambda>i. Pair x -` F i)"
+ by (intro disjoint_family_on_bisimulation[OF F(2)]) auto
+ moreover have "\<And>x. x \<in> space M1 \<Longrightarrow> range (\<lambda>i. Pair x -` F i) \<subseteq> sets M2"
+ using F by (auto intro!: measurable_cut_fst)
+ ultimately show "(\<Sum>\<^isub>\<infinity>n. pair_measure (F n)) = pair_measure (\<Union>i. F i)"
+ by (simp add: pair_measure_alt vimage_UN M1.positive_integral_psuminf[symmetric]
+ M2.measure_countably_additive
+ cong: M1.positive_integral_cong)
+ qed
+
+ from sigma_finite_up_in_pair_algebra guess F :: "nat \<Rightarrow> ('a \<times> 'c) set" .. note F = this
+ show "\<exists>F::nat \<Rightarrow> ('a \<times> 'b) set. range F \<subseteq> sets P \<and> (\<Union>i. F i) = space P \<and> (\<forall>i. pair_measure (F i) \<noteq> \<omega>)"
+ proof (rule exI[of _ F], intro conjI)
+ show "range F \<subseteq> sets P" using F by auto
+ show "(\<Union>i. F i) = space P"
+ using F by (auto simp: space_pair_algebra isoton_def)
+ show "\<forall>i. pair_measure (F i) \<noteq> \<omega>" using F by auto
+ qed
+qed
- show "f \<in> measurable M (prod_measure_space M1 M2)" unfolding prod_measure_space_def
- proof (rule measurable_sigma)
- show "prod_sets (sets M1) (sets M2) \<subseteq> Pow (space M1 \<times> space M2)"
- unfolding prod_sets_def using M1.sets_into_space M2.sets_into_space by auto
- show "f \<in> space M \<rightarrow> space M1 \<times> space M2"
- using f s by (auto simp: mem_Times_iff measurable_def comp_def)
- fix A assume "A \<in> prod_sets (sets M1) (sets M2)"
- then obtain B C where "B \<in> sets M1" "C \<in> sets M2" "A = B \<times> C"
- unfolding prod_sets_def by auto
- moreover have "(fst \<circ> f) -` B \<inter> space M \<in> sets M"
- using f `B \<in> sets M1` unfolding measurable_def by auto
- moreover have "(snd \<circ> f) -` C \<inter> space M \<in> sets M"
- using s `C \<in> sets M2` unfolding measurable_def by auto
- moreover have "f -` A \<inter> space M = ((fst \<circ> f) -` B \<inter> space M) \<inter> ((snd \<circ> f) -` C \<inter> space M)"
- unfolding `A = B \<times> C` by (auto simp: vimage_Times)
- ultimately show "f -` A \<inter> space M \<in> sets M" by auto
+lemma (in pair_sigma_finite) pair_measure_alt2:
+ assumes "A \<in> sets P"
+ shows "pair_measure A = M2.positive_integral (\<lambda>y. \<mu>1 ((\<lambda>x. (x, y)) -` A))"
+ (is "_ = ?\<nu> A")
+proof -
+ from sigma_finite_up_in_pair_algebra guess F :: "nat \<Rightarrow> ('a \<times> 'c) set" .. note F = this
+ show ?thesis
+ proof (rule measure_unique_Int_stable[where \<nu>="?\<nu>", OF Int_stable_pair_algebra],
+ simp_all add: pair_sigma_algebra_def[symmetric])
+ show "range F \<subseteq> sets E" "F \<up> space E" "\<And>i. pair_measure (F i) \<noteq> \<omega>"
+ using F by auto
+ show "measure_space P pair_measure" by default
+ next
+ show "measure_space P ?\<nu>"
+ proof
+ show "?\<nu> {} = 0" by auto
+ show "countably_additive P ?\<nu>"
+ unfolding countably_additive_def
+ proof (intro allI impI)
+ fix F :: "nat \<Rightarrow> ('a \<times> 'b) set"
+ assume F: "range F \<subseteq> sets P" "disjoint_family F"
+ from F have *: "\<And>i. F i \<in> sets P" "(\<Union>i. F i) \<in> sets P" by auto
+ moreover from F have "\<And>i. (\<lambda>y. \<mu>1 ((\<lambda>x. (x, y)) -` F i)) \<in> borel_measurable M2"
+ by (intro measure_cut_measurable_snd) auto
+ moreover have "\<And>y. disjoint_family (\<lambda>i. (\<lambda>x. (x, y)) -` F i)"
+ by (intro disjoint_family_on_bisimulation[OF F(2)]) auto
+ moreover have "\<And>y. y \<in> space M2 \<Longrightarrow> range (\<lambda>i. (\<lambda>x. (x, y)) -` F i) \<subseteq> sets M1"
+ using F by (auto intro!: measurable_cut_snd)
+ ultimately show "(\<Sum>\<^isub>\<infinity>n. ?\<nu> (F n)) = ?\<nu> (\<Union>i. F i)"
+ by (simp add: vimage_UN M2.positive_integral_psuminf[symmetric]
+ M1.measure_countably_additive
+ cong: M2.positive_integral_cong)
+ qed
+ qed
+ next
+ fix X assume "X \<in> sets E"
+ then obtain A B where X: "X = A \<times> B" and AB: "A \<in> sets M1" "B \<in> sets M2"
+ unfolding pair_algebra_def by auto
+ show "pair_measure X = ?\<nu> X"
+ proof -
+ from AB have "?\<nu> (A \<times> B) =
+ M2.positive_integral (\<lambda>y. \<mu>1 A * indicator B y)"
+ by (auto intro!: M2.positive_integral_cong)
+ with AB show ?thesis
+ unfolding pair_measure_times[OF AB] X
+ by (simp add: M2.positive_integral_cmult_indicator ac_simps)
+ qed
+ qed fact
+qed
+
+section "Fubinis theorem"
+
+lemma (in pair_sigma_finite) simple_function_cut:
+ assumes f: "simple_function f"
+ shows "(\<lambda>x. M2.positive_integral (\<lambda> y. f (x, y))) \<in> borel_measurable M1"
+ and "M1.positive_integral (\<lambda>x. M2.positive_integral (\<lambda>y. f (x, y)))
+ = positive_integral f"
+proof -
+ have f_borel: "f \<in> borel_measurable P"
+ using f by (rule borel_measurable_simple_function)
+ let "?F z" = "f -` {z} \<inter> space P"
+ let "?F' x z" = "Pair x -` ?F z"
+ { fix x assume "x \<in> space M1"
+ have [simp]: "\<And>z y. indicator (?F z) (x, y) = indicator (?F' x z) y"
+ by (auto simp: indicator_def)
+ have "\<And>y. y \<in> space M2 \<Longrightarrow> (x, y) \<in> space P" using `x \<in> space M1`
+ by (simp add: space_pair_algebra)
+ moreover have "\<And>x z. ?F' x z \<in> sets M2" using f_borel
+ by (intro borel_measurable_vimage measurable_cut_fst)
+ ultimately have "M2.simple_function (\<lambda> y. f (x, y))"
+ apply (rule_tac M2.simple_function_cong[THEN iffD2, OF _])
+ apply (rule simple_function_indicator_representation[OF f])
+ using `x \<in> space M1` by (auto simp del: space_sigma) }
+ note M2_sf = this
+ { fix x assume x: "x \<in> space M1"
+ then have "M2.positive_integral (\<lambda> y. f (x, y)) =
+ (\<Sum>z\<in>f ` space P. z * \<mu>2 (?F' x z))"
+ unfolding M2.positive_integral_eq_simple_integral[OF M2_sf[OF x]]
+ unfolding M2.simple_integral_def
+ proof (safe intro!: setsum_mono_zero_cong_left)
+ from f show "finite (f ` space P)" by (rule simple_functionD)
+ next
+ fix y assume "y \<in> space M2" then show "f (x, y) \<in> f ` space P"
+ using `x \<in> space M1` by (auto simp: space_pair_algebra)
+ next
+ fix x' y assume "(x', y) \<in> space P"
+ "f (x', y) \<notin> (\<lambda>y. f (x, y)) ` space M2"
+ then have *: "?F' x (f (x', y)) = {}"
+ by (force simp: space_pair_algebra)
+ show "f (x', y) * \<mu>2 (?F' x (f (x', y))) = 0"
+ unfolding * by simp
+ qed (simp add: vimage_compose[symmetric] comp_def
+ space_pair_algebra) }
+ note eq = this
+ moreover have "\<And>z. ?F z \<in> sets P"
+ by (auto intro!: f_borel borel_measurable_vimage simp del: space_sigma)
+ moreover then have "\<And>z. (\<lambda>x. \<mu>2 (?F' x z)) \<in> borel_measurable M1"
+ by (auto intro!: measure_cut_measurable_fst simp del: vimage_Int)
+ ultimately
+ show "(\<lambda> x. M2.positive_integral (\<lambda> y. f (x, y))) \<in> borel_measurable M1"
+ and "M1.positive_integral (\<lambda>x. M2.positive_integral (\<lambda>y. f (x, y)))
+ = positive_integral f"
+ by (auto simp del: vimage_Int cong: measurable_cong
+ intro!: M1.borel_measurable_pinfreal_setsum
+ simp add: M1.positive_integral_setsum simple_integral_def
+ M1.positive_integral_cmult
+ M1.positive_integral_cong[OF eq]
+ positive_integral_eq_simple_integral[OF f]
+ pair_measure_alt[symmetric])
+qed
+
+lemma (in pair_sigma_finite) positive_integral_fst_measurable:
+ assumes f: "f \<in> borel_measurable P"
+ shows "(\<lambda> x. M2.positive_integral (\<lambda> y. f (x, y))) \<in> borel_measurable M1"
+ (is "?C f \<in> borel_measurable M1")
+ and "M1.positive_integral (\<lambda> x. M2.positive_integral (\<lambda> y. f (x, y))) =
+ positive_integral f"
+proof -
+ from borel_measurable_implies_simple_function_sequence[OF f]
+ obtain F where F: "\<And>i. simple_function (F i)" "F \<up> f" by auto
+ then have F_borel: "\<And>i. F i \<in> borel_measurable P"
+ and F_mono: "\<And>i x. F i x \<le> F (Suc i) x"
+ and F_SUPR: "\<And>x. (SUP i. F i x) = f x"
+ unfolding isoton_def le_fun_def SUPR_fun_expand
+ by (auto intro: borel_measurable_simple_function)
+ note sf = simple_function_cut[OF F(1)]
+ then have "(SUP i. ?C (F i)) \<in> borel_measurable M1"
+ using F(1) by (auto intro!: M1.borel_measurable_SUP)
+ moreover
+ { fix x assume "x \<in> space M1"
+ have isotone: "(\<lambda> i y. F i (x, y)) \<up> (\<lambda>y. f (x, y))"
+ using `F \<up> f` unfolding isoton_fun_expand
+ by (auto simp: isoton_def)
+ note measurable_pair_image_snd[OF F_borel`x \<in> space M1`]
+ from M2.positive_integral_isoton[OF isotone this]
+ have "(SUP i. ?C (F i) x) = ?C f x"
+ by (simp add: isoton_def) }
+ note SUPR_C = this
+ ultimately show "?C f \<in> borel_measurable M1"
+ unfolding SUPR_fun_expand by (simp cong: measurable_cong)
+ have "positive_integral (\<lambda>x. SUP i. F i x) = (SUP i. positive_integral (F i))"
+ using F_borel F_mono
+ by (auto intro!: positive_integral_monotone_convergence_SUP[symmetric])
+ also have "(SUP i. positive_integral (F i)) =
+ (SUP i. M1.positive_integral (\<lambda>x. M2.positive_integral (\<lambda>y. F i (x, y))))"
+ unfolding sf(2) by simp
+ also have "\<dots> = M1.positive_integral (\<lambda>x. SUP i. M2.positive_integral (\<lambda>y. F i (x, y)))"
+ by (auto intro!: M1.positive_integral_monotone_convergence_SUP[OF _ sf(1)]
+ M2.positive_integral_mono F_mono)
+ also have "\<dots> = M1.positive_integral (\<lambda>x. M2.positive_integral (\<lambda>y. SUP i. F i (x, y)))"
+ using F_borel F_mono
+ by (auto intro!: M2.positive_integral_monotone_convergence_SUP
+ M1.positive_integral_cong measurable_pair_image_snd)
+ finally show "M1.positive_integral (\<lambda> x. M2.positive_integral (\<lambda> y. f (x, y))) =
+ positive_integral f"
+ unfolding F_SUPR by simp
+qed
+
+lemma (in pair_sigma_finite) positive_integral_snd_measurable:
+ assumes f: "f \<in> borel_measurable P"
+ shows "M2.positive_integral (\<lambda>y. M1.positive_integral (\<lambda>x. f (x, y))) =
+ positive_integral f"
+proof -
+ interpret Q: pair_sigma_finite M2 \<mu>2 M1 \<mu>1 by default
+ have s: "\<And>x y. (case (x, y) of (x, y) \<Rightarrow> f (y, x)) = f (y, x)" by simp
+ have t: "(\<lambda>x. f (case x of (x, y) \<Rightarrow> (y, x))) = (\<lambda>(x, y). f (y, x))" by (auto simp: fun_eq_iff)
+ have bij: "bij_betw (\<lambda>(x, y). (y, x)) (space M2 \<times> space M1) (space P)"
+ by (auto intro!: inj_onI simp: space_pair_algebra bij_betw_def)
+ note pair_sigma_algebra_measurable[OF f]
+ from Q.positive_integral_fst_measurable[OF this]
+ have "M2.positive_integral (\<lambda>y. M1.positive_integral (\<lambda>x. f (x, y))) =
+ Q.positive_integral (\<lambda>(x, y). f (y, x))"
+ by simp
+ also have "\<dots> = positive_integral f"
+ unfolding positive_integral_vimage[OF bij, of f] t
+ unfolding pair_sigma_algebra_swap[symmetric]
+ proof (rule Q.positive_integral_cong_measure[symmetric])
+ fix A assume "A \<in> sets Q.P"
+ from this Q.sets_pair_sigma_algebra_swap[OF this]
+ show "pair_measure ((\<lambda>(x, y). (y, x)) ` A) = Q.pair_measure A"
+ by (auto intro!: M1.positive_integral_cong arg_cong[where f=\<mu>2]
+ simp: pair_measure_alt Q.pair_measure_alt2)
+ qed
+ finally show ?thesis .
+qed
+
+lemma (in pair_sigma_finite) Fubini:
+ assumes f: "f \<in> borel_measurable P"
+ shows "M2.positive_integral (\<lambda>y. M1.positive_integral (\<lambda>x. f (x, y))) =
+ M1.positive_integral (\<lambda>x. M2.positive_integral (\<lambda>y. f (x, y)))"
+ unfolding positive_integral_snd_measurable[OF assms]
+ unfolding positive_integral_fst_measurable[OF assms] ..
+
+lemma (in pair_sigma_finite) AE_pair:
+ assumes "almost_everywhere (\<lambda>x. Q x)"
+ shows "M1.almost_everywhere (\<lambda>x. M2.almost_everywhere (\<lambda>y. Q (x, y)))"
+proof -
+ obtain N where N: "N \<in> sets P" "pair_measure N = 0" "{x\<in>space P. \<not> Q x} \<subseteq> N"
+ using assms unfolding almost_everywhere_def by auto
+ show ?thesis
+ proof (rule M1.AE_I)
+ from N measure_cut_measurable_fst[OF `N \<in> sets P`]
+ show "\<mu>1 {x\<in>space M1. \<mu>2 (Pair x -` N) \<noteq> 0} = 0"
+ by (simp add: M1.positive_integral_0_iff pair_measure_alt vimage_def)
+ show "{x \<in> space M1. \<mu>2 (Pair x -` N) \<noteq> 0} \<in> sets M1"
+ by (intro M1.borel_measurable_pinfreal_neq_const measure_cut_measurable_fst N)
+ { fix x assume "x \<in> space M1" "\<mu>2 (Pair x -` N) = 0"
+ have "M2.almost_everywhere (\<lambda>y. Q (x, y))"
+ proof (rule M2.AE_I)
+ show "\<mu>2 (Pair x -` N) = 0" by fact
+ show "Pair x -` N \<in> sets M2" by (intro measurable_cut_fst N)
+ show "{y \<in> space M2. \<not> Q (x, y)} \<subseteq> Pair x -` N"
+ using N `x \<in> space M1` unfolding space_sigma space_pair_algebra by auto
+ qed }
+ then show "{x \<in> space M1. \<not> M2.almost_everywhere (\<lambda>y. Q (x, y))} \<subseteq> {x \<in> space M1. \<mu>2 (Pair x -` N) \<noteq> 0}"
+ by auto
qed
qed
+section "Finite product spaces"
+
+section "Products"
+
+locale product_sigma_algebra =
+ fixes M :: "'i \<Rightarrow> 'a algebra"
+ assumes sigma_algebras: "\<And>i. sigma_algebra (M i)"
+
+locale finite_product_sigma_algebra = product_sigma_algebra M for M :: "'i \<Rightarrow> 'a algebra" +
+ fixes I :: "'i set"
+ assumes finite_index: "finite I"
+
+syntax
+ "_PiE" :: "[pttrn, 'a set, 'b set] => ('a => 'b) set" ("(3PIE _:_./ _)" 10)
+
+syntax (xsymbols)
+ "_PiE" :: "[pttrn, 'a set, 'b set] => ('a => 'b) set" ("(3\<Pi>\<^isub>E _\<in>_./ _)" 10)
+
+syntax (HTML output)
+ "_PiE" :: "[pttrn, 'a set, 'b set] => ('a => 'b) set" ("(3\<Pi>\<^isub>E _\<in>_./ _)" 10)
+
+translations
+ "PIE x:A. B" == "CONST Pi\<^isub>E A (%x. B)"
+
definition
- "prod_measure M \<mu> N \<nu> = (\<lambda>A. measure_space.positive_integral M \<mu> (\<lambda>s0. \<nu> ((\<lambda>s1. (s0, s1)) -` A)))"
+ "product_algebra M I = \<lparr> space = (\<Pi>\<^isub>E i\<in>I. space (M i)), sets = Pi\<^isub>E I ` (\<Pi> i \<in> I. sets (M i)) \<rparr>"
+
+abbreviation (in finite_product_sigma_algebra) "G \<equiv> product_algebra M I"
+abbreviation (in finite_product_sigma_algebra) "P \<equiv> sigma G"
+
+sublocale product_sigma_algebra \<subseteq> M: sigma_algebra "M i" for i by (rule sigma_algebras)
+
+lemma (in finite_product_sigma_algebra) product_algebra_into_space:
+ "sets G \<subseteq> Pow (space G)"
+ using M.sets_into_space unfolding product_algebra_def
+ by auto blast
+
+sublocale finite_product_sigma_algebra \<subseteq> sigma_algebra P
+ using product_algebra_into_space by (rule sigma_algebra_sigma)
+
+lemma space_product_algebra[simp]:
+ "space (product_algebra M I) = Pi\<^isub>E I (\<lambda>i. space (M i))"
+ unfolding product_algebra_def by simp
+
+lemma (in finite_product_sigma_algebra) P_empty:
+ "I = {} \<Longrightarrow> P = \<lparr> space = {\<lambda>k. undefined}, sets = { {}, {\<lambda>k. undefined} }\<rparr>"
+ unfolding product_algebra_def by (simp add: sigma_def image_constant)
+
+lemma (in finite_product_sigma_algebra) in_P[simp, intro]:
+ "\<lbrakk> \<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (M i) \<rbrakk> \<Longrightarrow> Pi\<^isub>E I A \<in> sets P"
+ by (auto simp: product_algebra_def sets_sigma intro!: sigma_sets.Basic)
+
+lemma bij_betw_prod_fold:
+ assumes "i \<notin> I"
+ shows "bij_betw (\<lambda>x. (x(i:=undefined), x i)) (\<Pi>\<^isub>E j\<in>insert i I. space (M j)) ((\<Pi>\<^isub>E j\<in>I. space (M j)) \<times> space (M i))"
+ (is "bij_betw ?f ?P ?F")
+ using `i \<notin> I`
+proof (unfold bij_betw_def, intro conjI set_eqI iffI)
+ show "inj_on ?f ?P"
+ proof (safe intro!: inj_onI ext)
+ fix a b x assume "a(i:=undefined) = b(i:=undefined)" "a i = b i"
+ then show "a x = b x"
+ by (cases "x = i") (auto simp: fun_eq_iff split: split_if_asm)
+ qed
+next
+ fix X assume *: "X \<in> ?F" show "X \<in> ?f ` ?P"
+ proof (cases X)
+ case (Pair a b) with * `i \<notin> I` show ?thesis
+ by (auto intro!: image_eqI[where x="a (i := b)"] ext simp: extensional_def)
+ qed
+qed auto
+
+section "Generating set generates also product algebra"
+
+lemma pair_sigma_algebra_sigma:
+ assumes 1: "S1 \<up> (space E1)" "range S1 \<subseteq> sets E1" and E1: "sets E1 \<subseteq> Pow (space E1)"
+ assumes 2: "S2 \<up> (space E2)" "range S2 \<subseteq> sets E2" and E2: "sets E2 \<subseteq> Pow (space E2)"
+ shows "sigma (pair_algebra (sigma E1) (sigma E2)) = sigma (pair_algebra E1 E2)"
+ (is "?S = ?E")
+proof -
+ interpret M1: sigma_algebra "sigma E1" using E1 by (rule sigma_algebra_sigma)
+ interpret M2: sigma_algebra "sigma E2" using E2 by (rule sigma_algebra_sigma)
+ have P: "sets (pair_algebra E1 E2) \<subseteq> Pow (space E1 \<times> space E2)"
+ using E1 E2 by (auto simp add: pair_algebra_def)
+ interpret E: sigma_algebra ?E unfolding pair_algebra_def
+ using E1 E2 by (intro sigma_algebra_sigma) auto
+ { fix A assume "A \<in> sets E1"
+ then have "fst -` A \<inter> space ?E = A \<times> (\<Union>i. S2 i)"
+ using E1 2 unfolding isoton_def pair_algebra_def by auto
+ also have "\<dots> = (\<Union>i. A \<times> S2 i)" by auto
+ also have "\<dots> \<in> sets ?E" unfolding pair_algebra_def sets_sigma
+ using 2 `A \<in> sets E1`
+ by (intro sigma_sets.Union)
+ (auto simp: image_subset_iff intro!: sigma_sets.Basic)
+ finally have "fst -` A \<inter> space ?E \<in> sets ?E" . }
+ moreover
+ { fix B assume "B \<in> sets E2"
+ then have "snd -` B \<inter> space ?E = (\<Union>i. S1 i) \<times> B"
+ using E2 1 unfolding isoton_def pair_algebra_def by auto
+ also have "\<dots> = (\<Union>i. S1 i \<times> B)" by auto
+ also have "\<dots> \<in> sets ?E"
+ using 1 `B \<in> sets E2` unfolding pair_algebra_def sets_sigma
+ by (intro sigma_sets.Union)
+ (auto simp: image_subset_iff intro!: sigma_sets.Basic)
+ finally have "snd -` B \<inter> space ?E \<in> sets ?E" . }
+ ultimately have proj:
+ "fst \<in> measurable ?E (sigma E1) \<and> snd \<in> measurable ?E (sigma E2)"
+ using E1 E2 by (subst (1 2) E.measurable_iff_sigma)
+ (auto simp: pair_algebra_def sets_sigma)
+ { fix A B assume A: "A \<in> sets (sigma E1)" and B: "B \<in> sets (sigma E2)"
+ with proj have "fst -` A \<inter> space ?E \<in> sets ?E" "snd -` B \<inter> space ?E \<in> sets ?E"
+ unfolding measurable_def by simp_all
+ moreover have "A \<times> B = (fst -` A \<inter> space ?E) \<inter> (snd -` B \<inter> space ?E)"
+ using A B M1.sets_into_space M2.sets_into_space
+ by (auto simp: pair_algebra_def)
+ ultimately have "A \<times> B \<in> sets ?E" by auto }
+ then have "sigma_sets (space ?E) (sets (pair_algebra (sigma E1) (sigma E2))) \<subseteq> sets ?E"
+ by (intro E.sigma_sets_subset) (auto simp add: pair_algebra_def sets_sigma)
+ then have subset: "sets ?S \<subseteq> sets ?E"
+ by (simp add: sets_sigma pair_algebra_def)
+ have "sets ?S = sets ?E"
+ proof (intro set_eqI iffI)
+ fix A assume "A \<in> sets ?E" then show "A \<in> sets ?S"
+ unfolding sets_sigma
+ proof induct
+ case (Basic A) then show ?case
+ by (auto simp: pair_algebra_def sets_sigma intro: sigma_sets.Basic)
+ qed (auto intro: sigma_sets.intros simp: pair_algebra_def)
+ next
+ fix A assume "A \<in> sets ?S" then show "A \<in> sets ?E" using subset by auto
+ qed
+ then show ?thesis
+ by (simp add: pair_algebra_def sigma_def)
+qed
+
+lemma Pi_fupd_iff: "i \<in> I \<Longrightarrow> f \<in> Pi I (B(i := A)) \<longleftrightarrow> f \<in> Pi (I - {i}) B \<and> f i \<in> A"
+ apply auto
+ apply (drule_tac x=x in Pi_mem)
+ apply (simp_all split: split_if_asm)
+ apply (drule_tac x=i in Pi_mem)
+ apply (auto dest!: Pi_mem)
+ done
+
+lemma Pi_UN:
+ fixes A :: "nat \<Rightarrow> 'i \<Rightarrow> 'a set"
+ assumes "finite I" and mono: "\<And>i n m. i \<in> I \<Longrightarrow> n \<le> m \<Longrightarrow> A n i \<subseteq> A m i"
+ shows "(\<Union>n. Pi I (A n)) = (\<Pi> i\<in>I. \<Union>n. A n i)"
+proof (intro set_eqI iffI)
+ fix f assume "f \<in> (\<Pi> i\<in>I. \<Union>n. A n i)"
+ then have "\<forall>i\<in>I. \<exists>n. f i \<in> A n i" by auto
+ from bchoice[OF this] obtain n where n: "\<And>i. i \<in> I \<Longrightarrow> f i \<in> (A (n i) i)" by auto
+ obtain k where k: "\<And>i. i \<in> I \<Longrightarrow> n i \<le> k"
+ using `finite I` finite_nat_set_iff_bounded_le[of "n`I"] by auto
+ have "f \<in> Pi I (A k)"
+ proof (intro Pi_I)
+ fix i assume "i \<in> I"
+ from mono[OF this, of "n i" k] k[OF this] n[OF this]
+ show "f i \<in> A k i" by auto
+ qed
+ then show "f \<in> (\<Union>n. Pi I (A n))" by auto
+qed auto
+
+lemma PiE_cong:
+ assumes "\<And>i. i\<in>I \<Longrightarrow> A i = B i"
+ shows "Pi\<^isub>E I A = Pi\<^isub>E I B"
+ using assms by (auto intro!: Pi_cong)
+
+lemma sigma_product_algebra_sigma_eq:
+ assumes "finite I"
+ assumes isotone: "\<And>i. i \<in> I \<Longrightarrow> (S i) \<up> (space (E i))"
+ assumes sets_into: "\<And>i. i \<in> I \<Longrightarrow> range (S i) \<subseteq> sets (E i)"
+ and E: "\<And>i. sets (E i) \<subseteq> Pow (space (E i))"
+ shows "sigma (product_algebra (\<lambda>i. sigma (E i)) I) = sigma (product_algebra E I)"
+ (is "?S = ?E")
+proof cases
+ assume "I = {}" then show ?thesis by (simp add: product_algebra_def)
+next
+ assume "I \<noteq> {}"
+ interpret E: sigma_algebra "sigma (E i)" for i
+ using E by (rule sigma_algebra_sigma)
+
+ have into_space[intro]: "\<And>i x A. A \<in> sets (E i) \<Longrightarrow> x i \<in> A \<Longrightarrow> x i \<in> space (E i)"
+ using E by auto
+
+ interpret G: sigma_algebra ?E
+ unfolding product_algebra_def using E
+ by (intro sigma_algebra_sigma) (auto dest: Pi_mem)
+
+ { fix A i assume "i \<in> I" and A: "A \<in> sets (E i)"
+ then have "(\<lambda>x. x i) -` A \<inter> space ?E = (\<Pi>\<^isub>E j\<in>I. if j = i then A else \<Union>n. S j n) \<inter> space ?E"
+ using isotone unfolding isoton_def product_algebra_def by (auto dest: Pi_mem)
+ also have "\<dots> = (\<Union>n. (\<Pi>\<^isub>E j\<in>I. if j = i then A else S j n))"
+ unfolding product_algebra_def
+ apply simp
+ apply (subst Pi_UN[OF `finite I`])
+ using isotone[THEN isoton_mono_le] apply simp
+ apply (simp add: PiE_Int)
+ apply (intro PiE_cong)
+ using A sets_into by (auto intro!: into_space)
+ also have "\<dots> \<in> sets ?E" unfolding product_algebra_def sets_sigma
+ using sets_into `A \<in> sets (E i)`
+ by (intro sigma_sets.Union)
+ (auto simp: image_subset_iff intro!: sigma_sets.Basic)
+ finally have "(\<lambda>x. x i) -` A \<inter> space ?E \<in> sets ?E" . }
+ then have proj:
+ "\<And>i. i\<in>I \<Longrightarrow> (\<lambda>x. x i) \<in> measurable ?E (sigma (E i))"
+ using E by (subst G.measurable_iff_sigma)
+ (auto simp: product_algebra_def sets_sigma)
+
+ { fix A assume A: "\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (sigma (E i))"
+ with proj have basic: "\<And>i. i \<in> I \<Longrightarrow> (\<lambda>x. x i) -` (A i) \<inter> space ?E \<in> sets ?E"
+ unfolding measurable_def by simp
+ have "Pi\<^isub>E I A = (\<Inter>i\<in>I. (\<lambda>x. x i) -` (A i) \<inter> space ?E)"
+ using A E.sets_into_space `I \<noteq> {}` unfolding product_algebra_def by auto blast
+ then have "Pi\<^isub>E I A \<in> sets ?E"
+ using G.finite_INT[OF `finite I` `I \<noteq> {}` basic, of "\<lambda>i. i"] by simp }
+ then have "sigma_sets (space ?E) (sets (product_algebra (\<lambda>i. sigma (E i)) I)) \<subseteq> sets ?E"
+ by (intro G.sigma_sets_subset) (auto simp add: sets_sigma product_algebra_def)
+ then have subset: "sets ?S \<subseteq> sets ?E"
+ by (simp add: sets_sigma product_algebra_def)
+
+ have "sets ?S = sets ?E"
+ proof (intro set_eqI iffI)
+ fix A assume "A \<in> sets ?E" then show "A \<in> sets ?S"
+ unfolding sets_sigma
+ proof induct
+ case (Basic A) then show ?case
+ by (auto simp: sets_sigma product_algebra_def intro: sigma_sets.Basic)
+ qed (auto intro: sigma_sets.intros simp: product_algebra_def)
+ next
+ fix A assume "A \<in> sets ?S" then show "A \<in> sets ?E" using subset by auto
+ qed
+ then show ?thesis
+ by (simp add: product_algebra_def sigma_def)
+qed
+
+lemma (in finite_product_sigma_algebra) pair_sigma_algebra_finite_product_space:
+ "sigma (pair_algebra P (M i)) = sigma (pair_algebra G (M i))"
+proof -
+ have "sigma (pair_algebra P (M i)) = sigma (pair_algebra P (sigma (M i)))" by simp
+ also have "\<dots> = sigma (pair_algebra G (M i))"
+ proof (rule pair_sigma_algebra_sigma)
+ show "(\<lambda>_. \<Pi>\<^isub>E i\<in>I. space (M i)) \<up> space G"
+ "(\<lambda>_. space (M i)) \<up> space (M i)"
+ by (simp_all add: isoton_const)
+ show "range (\<lambda>_. \<Pi>\<^isub>E i\<in>I. space (M i)) \<subseteq> sets G" "range (\<lambda>_. space (M i)) \<subseteq> sets (M i)"
+ by (auto intro!: image_eqI[where x="\<lambda>i\<in>I. space (M i)"] dest: Pi_mem
+ simp: product_algebra_def)
+ show "sets G \<subseteq> Pow (space G)" "sets (M i) \<subseteq> Pow (space (M i))"
+ using product_algebra_into_space M.sets_into_space by auto
+ qed
+ finally show ?thesis .
+qed
+
+lemma sets_pair_algebra: "sets (pair_algebra N M) = (\<lambda>(x, y). x \<times> y) ` (sets N \<times> sets M)"
+ unfolding pair_algebra_def by auto
+
+lemma (in finite_product_sigma_algebra) sigma_pair_algebra_sigma_eq:
+ "sigma (pair_algebra (sigma (product_algebra M I)) (sigma (product_algebra M J))) =
+ sigma (pair_algebra (product_algebra M I) (product_algebra M J))"
+ using M.sets_into_space
+ by (intro pair_sigma_algebra_sigma[of "\<lambda>_. \<Pi>\<^isub>E i\<in>I. space (M i)", of _ "\<lambda>_. \<Pi>\<^isub>E i\<in>J. space (M i)"])
+ (auto simp: isoton_const product_algebra_def, blast+)
+
+lemma (in product_sigma_algebra) product_product_vimage_algebra:
+ assumes [simp]: "I \<inter> J = {}" and "finite I" "finite J"
+ shows "sigma_algebra.vimage_algebra
+ (sigma (pair_algebra (sigma (product_algebra M I)) (sigma (product_algebra M J))))
+ (space (product_algebra M (I \<union> J))) (\<lambda>x. ((\<lambda>i\<in>I. x i), (\<lambda>i\<in>J. x i))) =
+ sigma (product_algebra M (I \<union> J))"
+ (is "sigma_algebra.vimage_algebra _ (space ?IJ) ?f = sigma ?IJ")
+proof -
+ have "finite (I \<union> J)" using assms by auto
+ interpret I: finite_product_sigma_algebra M I by default fact
+ interpret J: finite_product_sigma_algebra M J by default fact
+ interpret IJ: finite_product_sigma_algebra M "I \<union> J" by default fact
+ interpret pair_sigma_algebra I.P J.P by default
+
+ show "vimage_algebra (space ?IJ) ?f = sigma ?IJ"
+ unfolding I.sigma_pair_algebra_sigma_eq
+ proof (rule vimage_algebra_sigma)
+ from M.sets_into_space
+ show "sets (pair_algebra I.G J.G) \<subseteq> Pow (space (pair_algebra I.G J.G))"
+ by (auto simp: sets_pair_algebra space_pair_algebra product_algebra_def) blast+
+ show "?f \<in> space IJ.G \<rightarrow> space (pair_algebra I.G J.G)"
+ by (auto simp: space_pair_algebra product_algebra_def)
+ let ?F = "\<lambda>A. ?f -` A \<inter> (space IJ.G)"
+ let ?s = "\<lambda>I. Pi\<^isub>E I ` (\<Pi> i\<in>I. sets (M i))"
+ { fix A assume "A \<in> sets IJ.G"
+ then obtain F where A: "A = Pi\<^isub>E (I \<union> J) F" "F \<in> (\<Pi> i\<in>I. sets (M i))" "F \<in> (\<Pi> i\<in>J. sets (M i))"
+ by (auto simp: product_algebra_def)
+ show "A \<in> ?F ` sets (pair_algebra I.G J.G)"
+ using A M.sets_into_space
+ by (auto simp: restrict_Pi_cancel product_algebra_def
+ intro!: image_eqI[where x="Pi\<^isub>E I F \<times> Pi\<^isub>E J F"]) blast+ }
+ { fix A assume "A \<in> sets (pair_algebra I.G J.G)"
+ then obtain E F where A: "A = Pi\<^isub>E I E \<times> Pi\<^isub>E J F" "E \<in> (\<Pi> i\<in>I. sets (M i))" "F \<in> (\<Pi> i\<in>J. sets (M i))"
+ by (auto simp: product_algebra_def sets_pair_algebra)
+ then show "?F A \<in> sets IJ.G"
+ using A M.sets_into_space
+ by (auto simp: restrict_Pi_cancel product_algebra_def
+ intro!: image_eqI[where x="merge I E J F"]) blast+ }
+ qed
+qed
+
+lemma (in finite_product_sigma_algebra) sigma_pair_algebra_sigma_M_eq:
+ "sigma (pair_algebra P (M i)) = sigma (pair_algebra G (M i))"
+proof -
+ have "sigma (pair_algebra P (sigma (M i))) = sigma (pair_algebra G (M i))"
+ using M.sets_into_space
+ by (intro pair_sigma_algebra_sigma[of "\<lambda>_. \<Pi>\<^isub>E i\<in>I. space (M i)", of _ "\<lambda>_. space (M i)"])
+ (auto simp: isoton_const product_algebra_def, blast+)
+ then show ?thesis by simp
+qed
-lemma prod_setsI: "x \<in> A \<Longrightarrow> y \<in> B \<Longrightarrow> (x \<times> y) \<in> prod_sets A B"
- by (auto simp add: prod_sets_def)
+lemma (in product_sigma_algebra) product_singleton_vimage_algebra_eq:
+ assumes [simp]: "i \<notin> I" "finite I"
+ shows "sigma_algebra.vimage_algebra
+ (sigma (pair_algebra (sigma (product_algebra M I)) (M i)))
+ (space (product_algebra M (insert i I))) (\<lambda>x. ((\<lambda>i\<in>I. x i), x i)) =
+ sigma (product_algebra M (insert i I))"
+ (is "sigma_algebra.vimage_algebra _ (space ?I') ?f = sigma ?I'")
+proof -
+ have "finite (insert i I)" using assms by auto
+ interpret I: finite_product_sigma_algebra M I by default fact
+ interpret I': finite_product_sigma_algebra M "insert i I" by default fact
+ interpret pair_sigma_algebra I.P "M i" by default
+ show "vimage_algebra (space ?I') ?f = sigma ?I'"
+ unfolding I.sigma_pair_algebra_sigma_M_eq
+ proof (rule vimage_algebra_sigma)
+ from M.sets_into_space
+ show "sets (pair_algebra I.G (M i)) \<subseteq> Pow (space (pair_algebra I.G (M i)))"
+ by (auto simp: sets_pair_algebra space_pair_algebra product_algebra_def) blast
+ show "?f \<in> space I'.G \<rightarrow> space (pair_algebra I.G (M i))"
+ by (auto simp: space_pair_algebra product_algebra_def)
+ let ?F = "\<lambda>A. ?f -` A \<inter> (space I'.G)"
+ { fix A assume "A \<in> sets I'.G"
+ then obtain F where A: "A = Pi\<^isub>E (insert i I) F" "F \<in> (\<Pi> i\<in>I. sets (M i))" "F i \<in> sets (M i)"
+ by (auto simp: product_algebra_def)
+ show "A \<in> ?F ` sets (pair_algebra I.G (M i))"
+ using A M.sets_into_space
+ by (auto simp: restrict_Pi_cancel product_algebra_def
+ intro!: image_eqI[where x="Pi\<^isub>E I F \<times> F i"]) blast+ }
+ { fix A assume "A \<in> sets (pair_algebra I.G (M i))"
+ then obtain E F where A: "A = Pi\<^isub>E I E \<times> F" "E \<in> (\<Pi> i\<in>I. sets (M i))" "F \<in> sets (M i)"
+ by (auto simp: product_algebra_def sets_pair_algebra)
+ then show "?F A \<in> sets I'.G"
+ using A M.sets_into_space
+ by (auto simp: restrict_Pi_cancel product_algebra_def
+ intro!: image_eqI[where x="E(i:= F)"]) blast+ }
+ qed
+qed
+
+lemma restrict_fupd[simp]: "i \<notin> I \<Longrightarrow> restrict (f (i := x)) I = restrict f I"
+ by (auto simp: restrict_def intro!: ext)
+
+lemma bij_betw_restrict_I_i:
+ "i \<notin> I \<Longrightarrow> bij_betw (\<lambda>x. (restrict x I, x i))
+ (space (product_algebra M (insert i I)))
+ (space (pair_algebra (sigma (product_algebra M I)) (M i)))"
+ by (intro bij_betwI[where g="(\<lambda>(x,y). x(i:=y))"])
+ (auto simp: space_pair_algebra extensional_def intro!: ext)
+
+lemma (in product_sigma_algebra) product_singleton_vimage_algebra_inv_eq:
+ assumes [simp]: "i \<notin> I" "finite I"
+ shows "sigma_algebra.vimage_algebra
+ (sigma (product_algebra M (insert i I)))
+ (space (pair_algebra (sigma (product_algebra M I)) (M i))) (\<lambda>(x,y). x(i:=y)) =
+ sigma (pair_algebra (sigma (product_algebra M I)) (M i))"
+proof -
+ have "finite (insert i I)" using `finite I` by auto
+ interpret I: finite_product_sigma_algebra M I by default fact
+ interpret I': finite_product_sigma_algebra M "insert i I" by default fact
+ interpret pair_sigma_algebra I.P "M i" by default
+ show ?thesis
+ unfolding product_singleton_vimage_algebra_eq[OF assms, symmetric]
+ using bij_betw_restrict_I_i[OF `i \<notin> I`, of M]
+ by (rule vimage_vimage_inv[unfolded space_sigma])
+ (auto simp: space_pair_algebra product_algebra_def dest: extensional_restrict)
+qed
+
+locale product_sigma_finite =
+ fixes M :: "'i \<Rightarrow> 'a algebra" and \<mu> :: "'i \<Rightarrow> 'a set \<Rightarrow> pinfreal"
+ assumes sigma_finite_measures: "\<And>i. sigma_finite_measure (M i) (\<mu> i)"
+
+locale finite_product_sigma_finite = product_sigma_finite M \<mu> for M :: "'i \<Rightarrow> 'a algebra" and \<mu> +
+ fixes I :: "'i set" assumes finite_index': "finite I"
+
+sublocale product_sigma_finite \<subseteq> M: sigma_finite_measure "M i" "\<mu> i" for i
+ by (rule sigma_finite_measures)
+
+sublocale product_sigma_finite \<subseteq> product_sigma_algebra
+ by default
+
+sublocale finite_product_sigma_finite \<subseteq> finite_product_sigma_algebra
+ by default (fact finite_index')
+
+lemma (in finite_product_sigma_finite) sigma_finite_pairs:
+ "\<exists>F::'i \<Rightarrow> nat \<Rightarrow> 'a set.
+ (\<forall>i\<in>I. range (F i) \<subseteq> sets (M i)) \<and>
+ (\<forall>k. \<forall>i\<in>I. \<mu> i (F i k) \<noteq> \<omega>) \<and>
+ (\<lambda>k. \<Pi>\<^isub>E i\<in>I. F i k) \<up> space G"
+proof -
+ have "\<forall>i::'i. \<exists>F::nat \<Rightarrow> 'a set. range F \<subseteq> sets (M i) \<and> F \<up> space (M i) \<and> (\<forall>k. \<mu> i (F k) \<noteq> \<omega>)"
+ using M.sigma_finite_up by simp
+ from choice[OF this] guess F :: "'i \<Rightarrow> nat \<Rightarrow> 'a set" ..
+ then have "\<And>i. range (F i) \<subseteq> sets (M i)" "\<And>i. F i \<up> space (M i)" "\<And>i k. \<mu> i (F i k) \<noteq> \<omega>"
+ by auto
+ let ?F = "\<lambda>k. \<Pi>\<^isub>E i\<in>I. F i k"
+ note space_product_algebra[simp]
+ show ?thesis
+ proof (intro exI[of _ F] conjI allI isotoneI set_eqI iffI ballI)
+ fix i show "range (F i) \<subseteq> sets (M i)" by fact
+ next
+ fix i k show "\<mu> i (F i k) \<noteq> \<omega>" by fact
+ next
+ fix A assume "A \<in> (\<Union>i. ?F i)" then show "A \<in> space G"
+ using `\<And>i. range (F i) \<subseteq> sets (M i)` M.sets_into_space by auto blast
+ next
+ fix f assume "f \<in> space G"
+ with Pi_UN[OF finite_index, of "\<lambda>k i. F i k"]
+ `\<And>i. F i \<up> space (M i)`[THEN isotonD(2)]
+ `\<And>i. F i \<up> space (M i)`[THEN isoton_mono_le]
+ show "f \<in> (\<Union>i. ?F i)" by auto
+ next
+ fix i show "?F i \<subseteq> ?F (Suc i)"
+ using `\<And>i. F i \<up> space (M i)`[THEN isotonD(1)] by auto
+ qed
+qed
+
+lemma (in product_sigma_finite) product_measure_exists:
+ assumes "finite I"
+ shows "\<exists>\<nu>. (\<forall>A\<in>(\<Pi> i\<in>I. sets (M i)). \<nu> (Pi\<^isub>E I A) = (\<Prod>i\<in>I. \<mu> i (A i))) \<and>
+ sigma_finite_measure (sigma (product_algebra M I)) \<nu>"
+using `finite I` proof induct
+ case empty then show ?case unfolding product_algebra_def
+ by (auto intro!: exI[of _ "\<lambda>A. if A = {} then 0 else 1"] sigma_algebra_sigma
+ sigma_algebra.finite_additivity_sufficient
+ simp add: positive_def additive_def sets_sigma sigma_finite_measure_def
+ sigma_finite_measure_axioms_def image_constant)
+next
+ case (insert i I)
+ interpret finite_product_sigma_finite M \<mu> I by default fact
+ have "finite (insert i I)" using `finite I` by auto
+ interpret I': finite_product_sigma_finite M \<mu> "insert i I" by default fact
+ from insert obtain \<nu> where
+ prod: "\<And>A. A \<in> (\<Pi> i\<in>I. sets (M i)) \<Longrightarrow> \<nu> (Pi\<^isub>E I A) = (\<Prod>i\<in>I. \<mu> i (A i))" and
+ "sigma_finite_measure P \<nu>" by auto
+ interpret I: sigma_finite_measure P \<nu> by fact
+ interpret P: pair_sigma_finite P \<nu> "M i" "\<mu> i" ..
+
+ let ?h = "\<lambda>x. (restrict x I, x i)"
+ let ?\<nu> = "\<lambda>A. P.pair_measure (?h ` A)"
+ interpret I': measure_space "sigma (product_algebra M (insert i I))" ?\<nu>
+ unfolding product_singleton_vimage_algebra_eq[OF `i \<notin> I` `finite I`, symmetric]
+ using bij_betw_restrict_I_i[OF `i \<notin> I`, of M]
+ by (intro P.measure_space_isomorphic) auto
+ show ?case
+ proof (intro exI[of _ ?\<nu>] conjI ballI)
+ { fix A assume A: "A \<in> (\<Pi> i\<in>insert i I. sets (M i))"
+ moreover then have "A \<in> (\<Pi> i\<in>I. sets (M i))" by auto
+ moreover have "(\<lambda>x. (restrict x I, x i)) ` Pi\<^isub>E (insert i I) A = Pi\<^isub>E I A \<times> A i"
+ using `i \<notin> I`
+ apply auto
+ apply (rule_tac x="a(i:=b)" in image_eqI)
+ apply (auto simp: extensional_def fun_eq_iff)
+ done
+ ultimately show "?\<nu> (Pi\<^isub>E (insert i I) A) = (\<Prod>i\<in>insert i I. \<mu> i (A i))"
+ apply simp
+ apply (subst P.pair_measure_times)
+ apply fastsimp
+ apply fastsimp
+ using `i \<notin> I` `finite I` prod[of A] by (auto simp: ac_simps) }
+ note product = this
+ show "sigma_finite_measure I'.P ?\<nu>"
+ proof
+ from I'.sigma_finite_pairs guess F :: "'i \<Rightarrow> nat \<Rightarrow> 'a set" ..
+ then have F: "\<And>j. j \<in> insert i I \<Longrightarrow> range (F j) \<subseteq> sets (M j)"
+ "(\<lambda>k. \<Pi>\<^isub>E j \<in> insert i I. F j k) \<up> space I'.G"
+ "\<And>k. \<And>j. j \<in> insert i I \<Longrightarrow> \<mu> j (F j k) \<noteq> \<omega>"
+ by blast+
+ let "?F k" = "\<Pi>\<^isub>E j \<in> insert i I. F j k"
+ show "\<exists>F::nat \<Rightarrow> ('i \<Rightarrow> 'a) set. range F \<subseteq> sets I'.P \<and>
+ (\<Union>i. F i) = space I'.P \<and> (\<forall>i. ?\<nu> (F i) \<noteq> \<omega>)"
+ proof (intro exI[of _ ?F] conjI allI)
+ show "range ?F \<subseteq> sets I'.P" using F(1) by auto
+ next
+ from F(2)[THEN isotonD(2)]
+ show "(\<Union>i. ?F i) = space I'.P" by simp
+ next
+ fix j
+ show "?\<nu> (?F j) \<noteq> \<omega>"
+ using F `finite I`
+ by (subst product) (auto simp: setprod_\<omega>)
+ qed
+ qed
+ qed
+qed
+
+definition (in finite_product_sigma_finite)
+ measure :: "('i \<Rightarrow> 'a) set \<Rightarrow> pinfreal" where
+ "measure = (SOME \<nu>.
+ (\<forall>A\<in>\<Pi> i\<in>I. sets (M i). \<nu> (Pi\<^isub>E I A) = (\<Prod>i\<in>I. \<mu> i (A i))) \<and>
+ sigma_finite_measure P \<nu>)"
-lemma sigma_prod_sets_finite:
+sublocale finite_product_sigma_finite \<subseteq> sigma_finite_measure P measure
+proof -
+ show "sigma_finite_measure P measure"
+ unfolding measure_def
+ by (rule someI2_ex[OF product_measure_exists[OF finite_index]]) auto
+qed
+
+lemma (in finite_product_sigma_finite) measure_times:
+ assumes "\<And>i. i \<in> I \<Longrightarrow> A i \<in> sets (M i)"
+ shows "measure (Pi\<^isub>E I A) = (\<Prod>i\<in>I. \<mu> i (A i))"
+proof -
+ note ex = product_measure_exists[OF finite_index]
+ show ?thesis
+ unfolding measure_def
+ proof (rule someI2_ex[OF ex], elim conjE)
+ fix \<nu> assume *: "\<forall>A\<in>\<Pi> i\<in>I. sets (M i). \<nu> (Pi\<^isub>E I A) = (\<Prod>i\<in>I. \<mu> i (A i))"
+ have "Pi\<^isub>E I A = Pi\<^isub>E I (\<lambda>i\<in>I. A i)" by (auto dest: Pi_mem)
+ then have "\<nu> (Pi\<^isub>E I A) = \<nu> (Pi\<^isub>E I (\<lambda>i\<in>I. A i))" by simp
+ also have "\<dots> = (\<Prod>i\<in>I. \<mu> i ((\<lambda>i\<in>I. A i) i))" using assms * by auto
+ finally show "\<nu> (Pi\<^isub>E I A) = (\<Prod>i\<in>I. \<mu> i (A i))" by simp
+ qed
+qed
+
+abbreviation (in product_sigma_finite)
+ "product_measure I \<equiv> finite_product_sigma_finite.measure M \<mu> I"
+
+abbreviation (in product_sigma_finite)
+ "product_positive_integral I \<equiv>
+ measure_space.positive_integral (sigma (product_algebra M I)) (product_measure I)"
+
+abbreviation (in product_sigma_finite)
+ "product_integral I \<equiv>
+ measure_space.integral (sigma (product_algebra M I)) (product_measure I)"
+
+lemma (in product_sigma_finite) positive_integral_empty:
+ "product_positive_integral {} f = f (\<lambda>k. undefined)"
+proof -
+ interpret finite_product_sigma_finite M \<mu> "{}" by default (fact finite.emptyI)
+ have "\<And>A. measure (Pi\<^isub>E {} A) = 1"
+ using assms by (subst measure_times) auto
+ then show ?thesis
+ unfolding positive_integral_def simple_function_def simple_integral_def_raw
+ proof (simp add: P_empty, intro antisym)
+ show "f (\<lambda>k. undefined) \<le> (SUP f:{g. g \<le> f}. f (\<lambda>k. undefined))"
+ by (intro le_SUPI) auto
+ show "(SUP f:{g. g \<le> f}. f (\<lambda>k. undefined)) \<le> f (\<lambda>k. undefined)"
+ by (intro SUP_leI) (auto simp: le_fun_def)
+ qed
+qed
+
+lemma merge_restrict[simp]:
+ "merge I (restrict x I) J y = merge I x J y"
+ "merge I x J (restrict y J) = merge I x J y"
+ unfolding merge_def by (auto intro!: ext)
+
+lemma merge_x_x_eq_restrict[simp]:
+ "merge I x J x = restrict x (I \<union> J)"
+ unfolding merge_def by (auto intro!: ext)
+
+lemma bij_betw_restrict_I_J:
+ "I \<inter> J = {} \<Longrightarrow> bij_betw (\<lambda>x. (restrict x I, restrict x J))
+ (space (product_algebra M (I \<union> J)))
+ (space (pair_algebra (sigma (product_algebra M I)) (sigma (product_algebra M J))))"
+ by (intro bij_betwI[where g="\<lambda>(x,y). merge I x J y"])
+ (auto dest: extensional_restrict simp: space_pair_algebra)
+
+lemma (in product_sigma_algebra) product_product_vimage_algebra_eq:
+ assumes [simp]: "I \<inter> J = {}" and "finite I" "finite J"
+ shows "sigma_algebra.vimage_algebra
+ (sigma (product_algebra M (I \<union> J)))
+ (space (sigma (pair_algebra (sigma (product_algebra M I)) (sigma (product_algebra M J)))))
+ (\<lambda>(x, y). merge I x J y) =
+ sigma (pair_algebra (sigma (product_algebra M I)) (sigma (product_algebra M J)))"
+ (is "sigma_algebra.vimage_algebra ?IJ ?S ?m = ?P")
+proof -
+ interpret I: finite_product_sigma_algebra M I by default fact
+ interpret J: finite_product_sigma_algebra M J by default fact
+ have "finite (I \<union> J)" using assms by auto
+ interpret IJ: finite_product_sigma_algebra M "I \<union> J" by default fact
+ interpret P: pair_sigma_algebra I.P J.P by default
+
+ let ?g = "\<lambda>x. (restrict x I, restrict x J)"
+ let ?f = "\<lambda>(x, y). merge I x J y"
+ show "IJ.vimage_algebra (space P.P) ?f = P.P"
+ using bij_betw_restrict_I_J[OF `I \<inter> J = {}`]
+ by (subst P.vimage_vimage_inv[of ?g "space IJ.G" ?f,
+ unfolded product_product_vimage_algebra[OF assms]])
+ (auto simp: pair_algebra_def dest: extensional_restrict)
+qed
+
+lemma (in product_sigma_finite) measure_fold_left:
+ assumes IJ[simp]: "I \<inter> J = {}" and fin: "finite I" "finite J"
+ and f: "f \<in> borel_measurable (sigma (product_algebra M (I \<union> J)))"
+ shows "product_positive_integral (I \<union> J) f =
+ product_positive_integral I (\<lambda>x. product_positive_integral J (\<lambda>y. f (merge I x J y)))"
+proof -
+ interpret I: finite_product_sigma_finite M \<mu> I by default fact
+ interpret J: finite_product_sigma_finite M \<mu> J by default fact
+ have "finite (I \<union> J)" using fin by auto
+ interpret IJ: finite_product_sigma_finite M \<mu> "I \<union> J" by default fact
+ interpret P: pair_sigma_finite I.P I.measure J.P J.measure by default
+ let ?f = "\<lambda>x. ((\<lambda>i\<in>I. x i), (\<lambda>i\<in>J. x i))"
+ have P_borel: "(\<lambda>x. f (case x of (x, y) \<Rightarrow> merge I x J y)) \<in> borel_measurable P.P"
+ by (subst product_product_vimage_algebra_eq[OF IJ fin, symmetric])
+ (auto simp: space_pair_algebra intro!: IJ.measurable_vimage f)
+ have split_f_image[simp]: "\<And>F. ?f ` (Pi\<^isub>E (I \<union> J) F) = (Pi\<^isub>E I F) \<times> (Pi\<^isub>E J F)"
+ apply auto apply (rule_tac x="merge I a J b" in image_eqI)
+ by (auto dest: extensional_restrict)
+ have "IJ.positive_integral f = IJ.positive_integral (\<lambda>x. f (restrict x (I \<union> J)))"
+ by (auto intro!: IJ.positive_integral_cong arg_cong[where f=f] dest!: extensional_restrict)
+ also have "\<dots> = I.positive_integral (\<lambda>x. J.positive_integral (\<lambda>y. f (merge I x J y)))"
+ unfolding P.positive_integral_fst_measurable[OF P_borel, simplified]
+ unfolding P.positive_integral_vimage[unfolded space_sigma, OF bij_betw_restrict_I_J[OF IJ]]
+ unfolding product_product_vimage_algebra[OF IJ fin]
+ proof (simp, rule IJ.positive_integral_cong_measure[symmetric])
+ fix A assume *: "A \<in> sets IJ.P"
+ from IJ.sigma_finite_pairs obtain F where
+ F: "\<And>i. i\<in> I \<union> J \<Longrightarrow> range (F i) \<subseteq> sets (M i)"
+ "(\<lambda>k. \<Pi>\<^isub>E i\<in>I \<union> J. F i k) \<up> space IJ.G"
+ "\<And>k. \<forall>i\<in>I\<union>J. \<mu> i (F i k) \<noteq> \<omega>"
+ by auto
+ let ?F = "\<lambda>k. \<Pi>\<^isub>E i\<in>I \<union> J. F i k"
+ show "P.pair_measure (?f ` A) = IJ.measure A"
+ proof (rule measure_unique_Int_stable[OF _ _ _ _ _ _ _ _ *])
+ show "Int_stable IJ.G" by (simp add: PiE_Int Int_stable_def product_algebra_def) auto
+ show "range ?F \<subseteq> sets IJ.G" using F by (simp add: image_subset_iff product_algebra_def)
+ show "?F \<up> space IJ.G " using F(2) by simp
+ show "measure_space IJ.P (\<lambda>A. P.pair_measure (?f ` A))"
+ unfolding product_product_vimage_algebra[OF IJ fin, symmetric]
+ using bij_betw_restrict_I_J[OF IJ, of M]
+ by (auto intro!: P.measure_space_isomorphic)
+ show "measure_space IJ.P IJ.measure" by fact
+ next
+ fix A assume "A \<in> sets IJ.G"
+ then obtain F where A[simp]: "A = Pi\<^isub>E (I \<union> J) F" "F \<in> (\<Pi> i\<in>I \<union> J. sets (M i))"
+ by (auto simp: product_algebra_def)
+ then have F: "\<And>i. i \<in> I \<Longrightarrow> F i \<in> sets (M i)" "\<And>i. i \<in> J \<Longrightarrow> F i \<in> sets (M i)"
+ by auto
+ have "P.pair_measure (?f ` A) = (\<Prod>i\<in>I. \<mu> i (F i)) * (\<Prod>i\<in>J. \<mu> i (F i))"
+ using `finite J` `finite I` F
+ by (simp add: P.pair_measure_times I.measure_times J.measure_times)
+ also have "\<dots> = (\<Prod>i\<in>I \<union> J. \<mu> i (F i))"
+ using `finite J` `finite I` `I \<inter> J = {}` by (simp add: setprod_Un_one)
+ also have "\<dots> = IJ.measure A"
+ using `finite J` `finite I` F unfolding A
+ by (intro IJ.measure_times[symmetric]) auto
+ finally show "P.pair_measure (?f ` A) = IJ.measure A" .
+ next
+ fix k
+ have "\<And>i. i \<in> I \<union> J \<Longrightarrow> F i k \<in> sets (M i)" using F by auto
+ then have "P.pair_measure (?f ` ?F k) = (\<Prod>i\<in>I. \<mu> i (F i k)) * (\<Prod>i\<in>J. \<mu> i (F i k))"
+ by (simp add: P.pair_measure_times I.measure_times J.measure_times)
+ then show "P.pair_measure (?f ` ?F k) \<noteq> \<omega>"
+ using `finite I` F by (simp add: setprod_\<omega>)
+ qed simp
+ qed
+ finally show ?thesis .
+qed
+
+lemma (in product_sigma_finite) finite_pair_measure_singleton:
+ assumes f: "f \<in> borel_measurable (M i)"
+ shows "product_positive_integral {i} (\<lambda>x. f (x i)) = M.positive_integral i f"
+proof -
+ interpret I: finite_product_sigma_finite M \<mu> "{i}" by default simp
+ have bij: "bij_betw (\<lambda>x. \<lambda>j\<in>{i}. x) (space (M i)) (space I.P)"
+ by (auto intro!: bij_betwI ext simp: extensional_def)
+ have *: "(\<lambda>x. (\<lambda>x. \<lambda>j\<in>{i}. x) -` Pi\<^isub>E {i} x \<inter> space (M i)) ` (\<Pi> i\<in>{i}. sets (M i)) = sets (M i)"
+ proof (subst image_cong, rule refl)
+ fix x assume "x \<in> (\<Pi> i\<in>{i}. sets (M i))"
+ then show "(\<lambda>x. \<lambda>j\<in>{i}. x) -` Pi\<^isub>E {i} x \<inter> space (M i) = x i"
+ using sets_into_space by auto
+ qed auto
+ have vimage: "I.vimage_algebra (space (M i)) (\<lambda>x. \<lambda>j\<in>{i}. x) = M i"
+ unfolding I.vimage_algebra_def
+ unfolding product_sigma_algebra_def sets_sigma
+ apply (subst sigma_sets_vimage[symmetric])
+ apply (simp_all add: image_image sigma_sets_eq product_algebra_def * del: vimage_Int)
+ using sets_into_space by blast
+ show "I.positive_integral (\<lambda>x. f (x i)) = M.positive_integral i f"
+ unfolding I.positive_integral_vimage[OF bij]
+ unfolding vimage
+ apply (subst positive_integral_cong_measure)
+ proof -
+ fix A assume A: "A \<in> sets (M i)"
+ have "(\<lambda>x. \<lambda>j\<in>{i}. x) ` A = (\<Pi>\<^isub>E i\<in>{i}. A)"
+ by (auto intro!: image_eqI ext[where 'b='a] simp: extensional_def)
+ with A show "product_measure {i} ((\<lambda>x. \<lambda>j\<in>{i}. x) ` A) = \<mu> i A"
+ using I.measure_times[of "\<lambda>i. A"] by simp
+ qed simp
+qed
+
+section "Products on finite spaces"
+
+lemma sigma_sets_pair_algebra_finite:
assumes "finite A" and "finite B"
- shows "sigma_sets (A \<times> B) (prod_sets (Pow A) (Pow B)) = Pow (A \<times> B)"
+ shows "sigma_sets (A \<times> B) ((\<lambda>(x,y). x \<times> y) ` (Pow A \<times> Pow B)) = Pow (A \<times> B)"
+ (is "sigma_sets ?prod ?sets = _")
proof safe
have fin: "finite (A \<times> B)" using assms by (rule finite_cartesian_product)
-
fix x assume subset: "x \<subseteq> A \<times> B"
hence "finite x" using fin by (rule finite_subset)
- from this subset show "x \<in> sigma_sets (A\<times>B) (prod_sets (Pow A) (Pow B))"
- (is "x \<in> sigma_sets ?prod ?sets")
+ from this subset show "x \<in> sigma_sets ?prod ?sets"
proof (induct x)
case empty show ?case by (rule sigma_sets.Empty)
next
case (insert a x)
- hence "{a} \<in> sigma_sets ?prod ?sets" by (auto simp: prod_sets_def intro!: sigma_sets.Basic)
+ hence "{a} \<in> sigma_sets ?prod ?sets"
+ by (auto simp: pair_algebra_def intro!: sigma_sets.Basic)
moreover have "x \<in> sigma_sets ?prod ?sets" using insert by auto
ultimately show ?case unfolding insert_is_Un[of a x] by (rule sigma_sets_Un)
qed
next
fix x a b
- assume "x \<in> sigma_sets (A\<times>B) (prod_sets (Pow A) (Pow B))" and "(a, b) \<in> x"
+ assume "x \<in> sigma_sets ?prod ?sets" and "(a, b) \<in> x"
from sigma_sets_into_sp[OF _ this(1)] this(2)
- show "a \<in> A" and "b \<in> B"
- by (auto simp: prod_sets_def)
+ show "a \<in> A" and "b \<in> B" by auto
qed
-lemma (in sigma_algebra) measurable_prod_sigma:
- assumes sa1: "sigma_algebra a1" and sa2: "sigma_algebra a2"
- assumes 1: "(fst o f) \<in> measurable M a1" and 2: "(snd o f) \<in> measurable M a2"
- shows "f \<in> measurable M (sigma ((space a1) \<times> (space a2))
- (prod_sets (sets a1) (sets a2)))"
+locale pair_finite_sigma_algebra = M1: finite_sigma_algebra M1 + M2: finite_sigma_algebra M2 for M1 M2
+
+sublocale pair_finite_sigma_algebra \<subseteq> pair_sigma_algebra by default
+
+lemma (in pair_finite_sigma_algebra) finite_pair_sigma_algebra[simp]:
+ shows "P = (| space = space M1 \<times> space M2, sets = Pow (space M1 \<times> space M2) |)"
proof -
- from 1 have fn1: "fst \<circ> f \<in> space M \<rightarrow> space a1"
- and q1: "\<forall>y\<in>sets a1. (fst \<circ> f) -` y \<inter> space M \<in> sets M"
- by (auto simp add: measurable_def)
- from 2 have fn2: "snd \<circ> f \<in> space M \<rightarrow> space a2"
- and q2: "\<forall>y\<in>sets a2. (snd \<circ> f) -` y \<inter> space M \<in> sets M"
- by (auto simp add: measurable_def)
- show ?thesis
- proof (rule measurable_sigma)
- show "prod_sets (sets a1) (sets a2) \<subseteq> Pow (space a1 \<times> space a2)" using sa1 sa2
- by (auto simp add: prod_sets_def sigma_algebra_iff dest: algebra.space_closed)
- next
- show "f \<in> space M \<rightarrow> space a1 \<times> space a2"
- by (rule prod_final [OF fn1 fn2])
- next
- fix z
- assume z: "z \<in> prod_sets (sets a1) (sets a2)"
- thus "f -` z \<inter> space M \<in> sets M"
- proof (auto simp add: prod_sets_def vimage_Times)
- fix x y
- assume x: "x \<in> sets a1" and y: "y \<in> sets a2"
- have "(fst \<circ> f) -` x \<inter> (snd \<circ> f) -` y \<inter> space M =
- ((fst \<circ> f) -` x \<inter> space M) \<inter> ((snd \<circ> f) -` y \<inter> space M)"
- by blast
- also have "... \<in> sets M" using x y q1 q2
- by blast
- finally show "(fst \<circ> f) -` x \<inter> (snd \<circ> f) -` y \<inter> space M \<in> sets M" .
- qed
- qed
+ show ?thesis using M1.finite_space M2.finite_space
+ by (simp add: sigma_def space_pair_algebra sets_pair_algebra
+ sigma_sets_pair_algebra_finite M1.sets_eq_Pow M2.sets_eq_Pow)
+qed
+
+sublocale pair_finite_sigma_algebra \<subseteq> finite_sigma_algebra P
+proof
+ show "finite (space P)" "sets P = Pow (space P)"
+ using M1.finite_space M2.finite_space by auto
qed
-lemma (in sigma_finite_measure) prod_measure_times:
- assumes "sigma_finite_measure N \<nu>"
- and "A1 \<in> sets M" "A2 \<in> sets N"
- shows "prod_measure M \<mu> N \<nu> (A1 \<times> A2) = \<mu> A1 * \<nu> A2"
- oops
+locale pair_finite_space = M1: finite_measure_space M1 \<mu>1 + M2: finite_measure_space M2 \<mu>2
+ for M1 \<mu>1 M2 \<mu>2
+
+sublocale pair_finite_space \<subseteq> pair_finite_sigma_algebra
+ by default
-lemma (in sigma_finite_measure) sigma_finite_prod_measure_space:
- assumes "sigma_finite_measure N \<nu>"
- shows "sigma_finite_measure (prod_measure_space M N) (prod_measure M \<mu> N \<nu>)"
- oops
+sublocale pair_finite_space \<subseteq> pair_sigma_finite
+ by default
-lemma (in finite_measure_space) finite_prod_measure_times:
- assumes "finite_measure_space N \<nu>"
- and "A1 \<in> sets M" "A2 \<in> sets N"
- shows "prod_measure M \<mu> N \<nu> (A1 \<times> A2) = \<mu> A1 * \<nu> A2"
+lemma (in pair_finite_space) finite_pair_sigma_algebra[simp]:
+ shows "P = (| space = space M1 \<times> space M2, sets = Pow (space M1 \<times> space M2) |)"
proof -
- interpret N: finite_measure_space N \<nu> by fact
- have *: "\<And>x. \<nu> (Pair x -` (A1 \<times> A2)) * \<mu> {x} = (if x \<in> A1 then \<nu> A2 * \<mu> {x} else 0)"
- by (auto simp: vimage_Times comp_def)
- have "finite A1"
- using `A1 \<in> sets M` finite_space by (auto simp: sets_eq_Pow intro: finite_subset)
- then have "\<mu> A1 = (\<Sum>x\<in>A1. \<mu> {x})" using `A1 \<in> sets M`
- by (auto intro!: measure_finite_singleton simp: sets_eq_Pow)
- then show ?thesis using `A1 \<in> sets M`
- unfolding prod_measure_def positive_integral_finite_eq_setsum *
- by (auto simp add: sets_eq_Pow setsum_right_distrib[symmetric] mult_commute setsum_cases[OF finite_space])
-qed
-
-lemma (in finite_measure_space) finite_prod_measure_space:
- assumes "finite_measure_space N \<nu>"
- shows "prod_measure_space M N = \<lparr> space = space M \<times> space N, sets = Pow (space M \<times> space N) \<rparr>"
-proof -
- interpret N: finite_measure_space N \<nu> by fact
- show ?thesis using finite_space N.finite_space
- by (simp add: sigma_def prod_measure_space_def sigma_prod_sets_finite sets_eq_Pow N.sets_eq_Pow)
+ show ?thesis using M1.finite_space M2.finite_space
+ by (simp add: sigma_def space_pair_algebra sets_pair_algebra
+ sigma_sets_pair_algebra_finite M1.sets_eq_Pow M2.sets_eq_Pow)
qed
-lemma (in finite_measure_space) finite_measure_space_finite_prod_measure:
- fixes N :: "('c, 'd) algebra_scheme"
- assumes N: "finite_measure_space N \<nu>"
- shows "finite_measure_space (prod_measure_space M N) (prod_measure M \<mu> N \<nu>)"
- unfolding finite_prod_measure_space[OF assms]
-proof (rule finite_measure_spaceI, simp_all)
- interpret N: finite_measure_space N \<nu> by fact
- show "finite (space M \<times> space N)" using finite_space N.finite_space by auto
- show "prod_measure M \<mu> N \<nu> (space M \<times> space N) \<noteq> \<omega>"
- using finite_prod_measure_times[OF N top N.top] by simp
- show "prod_measure M \<mu> N \<nu> {} = 0"
- using finite_prod_measure_times[OF N empty_sets N.empty_sets] by simp
-
- fix A B :: "('a * 'c) set" assume "A \<inter> B = {}" "A \<subseteq> space M \<times> space N" "B \<subseteq> space M \<times> space N"
- then show "prod_measure M \<mu> N \<nu> (A \<union> B) = prod_measure M \<mu> N \<nu> A + prod_measure M \<mu> N \<nu> B"
- apply (auto simp add: sets_eq_Pow prod_measure_def positive_integral_add[symmetric]
- intro!: positive_integral_cong)
- apply (subst N.measure_additive)
- apply (auto intro!: arg_cong[where f=\<mu>] simp: N.sets_eq_Pow sets_eq_Pow)
- done
+lemma (in pair_finite_space) pair_measure_Pair[simp]:
+ assumes "a \<in> space M1" "b \<in> space M2"
+ shows "pair_measure {(a, b)} = \<mu>1 {a} * \<mu>2 {b}"
+proof -
+ have "pair_measure ({a}\<times>{b}) = \<mu>1 {a} * \<mu>2 {b}"
+ using M1.sets_eq_Pow M2.sets_eq_Pow assms
+ by (subst pair_measure_times) auto
+ then show ?thesis by simp
qed
-lemma (in finite_measure_space) finite_measure_space_finite_prod_measure_alterantive:
- assumes N: "finite_measure_space N \<nu>"
- shows "finite_measure_space \<lparr> space = space M \<times> space N, sets = Pow (space M \<times> space N) \<rparr> (prod_measure M \<mu> N \<nu>)"
- (is "finite_measure_space ?M ?m")
- unfolding finite_prod_measure_space[OF N, symmetric]
- using finite_measure_space_finite_prod_measure[OF N] .
+lemma (in pair_finite_space) pair_measure_singleton[simp]:
+ assumes "x \<in> space M1 \<times> space M2"
+ shows "pair_measure {x} = \<mu>1 {fst x} * \<mu>2 {snd x}"
+ using pair_measure_Pair assms by (cases x) auto
-lemma prod_measure_times_finite:
- assumes fms: "finite_measure_space M \<mu>" "finite_measure_space N \<nu>" and a: "a \<in> space M \<times> space N"
- shows "prod_measure M \<mu> N \<nu> {a} = \<mu> {fst a} * \<nu> {snd a}"
-proof (cases a)
- case (Pair b c)
- hence a_eq: "{a} = {b} \<times> {c}" by simp
+sublocale pair_finite_space \<subseteq> finite_measure_space P pair_measure
+ by default auto
- interpret M: finite_measure_space M \<mu> by fact
- interpret N: finite_measure_space N \<nu> by fact
+lemma (in pair_finite_space) finite_measure_space_finite_prod_measure_alterantive:
+ "finite_measure_space \<lparr>space = space M1 \<times> space M2, sets = Pow (space M1 \<times> space M2)\<rparr> pair_measure"
+ unfolding finite_pair_sigma_algebra[symmetric]
+ by default
- from finite_measure_space.finite_prod_measure_times[OF fms, of "{b}" "{c}"] M.sets_eq_Pow N.sets_eq_Pow a Pair
- show ?thesis unfolding a_eq by simp
-qed
-
-end
+end
\ No newline at end of file
--- a/src/HOL/Probability/Radon_Nikodym.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Radon_Nikodym.thy Thu Dec 02 11:18:44 2010 -0800
@@ -2,6 +2,14 @@
imports Lebesgue_Integration
begin
+lemma less_\<omega>_Ex_of_nat: "x < \<omega> \<longleftrightarrow> (\<exists>n. x < of_nat n)"
+proof safe
+ assume "x < \<omega>"
+ then obtain r where "0 \<le> r" "x = Real r" by (cases x) auto
+ moreover obtain n where "r < of_nat n" using ex_less_of_nat by auto
+ ultimately show "\<exists>n. x < of_nat n" by (auto simp: real_eq_of_nat)
+qed auto
+
lemma (in sigma_finite_measure) Ex_finite_integrable_function:
shows "\<exists>h\<in>borel_measurable M. positive_integral h \<noteq> \<omega> \<and> (\<forall>x\<in>space M. 0 < h x \<and> h x < \<omega>)"
proof -
@@ -61,9 +69,26 @@
qed
qed
+subsection "Absolutely continuous"
+
definition (in measure_space)
"absolutely_continuous \<nu> = (\<forall>N\<in>null_sets. \<nu> N = (0 :: pinfreal))"
+lemma (in sigma_finite_measure) absolutely_continuous_AE:
+ assumes "measure_space M \<nu>" "absolutely_continuous \<nu>" "AE x. P x"
+ shows "measure_space.almost_everywhere M \<nu> P"
+proof -
+ interpret \<nu>: measure_space M \<nu> by fact
+ from `AE x. P x` obtain N where N: "N \<in> null_sets" and "{x\<in>space M. \<not> P x} \<subseteq> N"
+ unfolding almost_everywhere_def by auto
+ show "\<nu>.almost_everywhere P"
+ proof (rule \<nu>.AE_I')
+ show "{x\<in>space M. \<not> P x} \<subseteq> N" by fact
+ from `absolutely_continuous \<nu>` show "N \<in> \<nu>.null_sets"
+ using N unfolding absolutely_continuous_def by auto
+ qed
+qed
+
lemma (in finite_measure_space) absolutely_continuousI:
assumes "finite_measure_space M \<nu>"
assumes v: "\<And>x. \<lbrakk> x \<in> space M ; \<mu> {x} = 0 \<rbrakk> \<Longrightarrow> \<nu> {x} = 0"
@@ -88,6 +113,14 @@
finally show "\<nu> N = 0" .
qed
+lemma (in measure_space) density_is_absolutely_continuous:
+ assumes "\<And>A. A \<in> sets M \<Longrightarrow> \<nu> A = positive_integral (\<lambda>x. f x * indicator A x)"
+ shows "absolutely_continuous \<nu>"
+ using assms unfolding absolutely_continuous_def
+ by (simp add: positive_integral_null_set)
+
+subsection "Existence of the Radon-Nikodym derivative"
+
lemma (in finite_measure) Radon_Nikodym_aux_epsilon:
fixes e :: real assumes "0 < e"
assumes "finite_measure M s"
@@ -97,21 +130,17 @@
proof -
let "?d A" = "real (\<mu> A) - real (s A)"
interpret M': finite_measure M s by fact
-
let "?A A" = "if (\<forall>B\<in>sets M. B \<subseteq> space M - A \<longrightarrow> -e < ?d B)
then {}
else (SOME B. B \<in> sets M \<and> B \<subseteq> space M - A \<and> ?d B \<le> -e)"
def A \<equiv> "\<lambda>n. ((\<lambda>B. B \<union> ?A B) ^^ n) {}"
-
have A_simps[simp]:
"A 0 = {}"
"\<And>n. A (Suc n) = (A n \<union> ?A (A n))" unfolding A_def by simp_all
-
{ fix A assume "A \<in> sets M"
have "?A A \<in> sets M"
by (auto intro!: someI2[of _ _ "\<lambda>A. A \<in> sets M"] simp: not_less) }
note A'_in_sets = this
-
{ fix n have "A n \<in> sets M"
proof (induct n)
case (Suc n) thus "A (Suc n) \<in> sets M"
@@ -119,7 +148,6 @@
qed (simp add: A_def) }
note A_in_sets = this
hence "range A \<subseteq> sets M" by auto
-
{ fix n B
assume Ex: "\<exists>B. B \<in> sets M \<and> B \<subseteq> space M - A n \<and> ?d B \<le> -e"
hence False: "\<not> (\<forall>B\<in>sets M. B \<subseteq> space M - A n \<longrightarrow> -e < ?d B)" by (auto simp: not_less)
@@ -133,7 +161,6 @@
finally show "?d (A n \<union> B) \<le> ?d (A n) - e" .
qed }
note dA_epsilon = this
-
{ fix n have "?d (A (Suc n)) \<le> ?d (A n)"
proof (cases "\<exists>B. B\<in>sets M \<and> B \<subseteq> space M - A n \<and> ?d B \<le> - e")
case True from dA_epsilon[OF this] show ?thesis using `0 < e` by simp
@@ -143,7 +170,6 @@
thus ?thesis by simp
qed }
note dA_mono = this
-
show ?thesis
proof (cases "\<exists>n. \<forall>B\<in>sets M. B \<subseteq> space M - A n \<longrightarrow> -e < ?d B")
case True then obtain n where B: "\<And>B. \<lbrakk> B \<in> sets M; B \<subseteq> space M - A n\<rbrakk> \<Longrightarrow> -e < ?d B" by blast
@@ -197,11 +223,8 @@
proof -
let "?d A" = "real (\<mu> A) - real (s A)"
let "?P A B n" = "A \<in> sets M \<and> A \<subseteq> B \<and> ?d B \<le> ?d A \<and> (\<forall>C\<in>sets M. C \<subseteq> A \<longrightarrow> - 1 / real (Suc n) < ?d C)"
-
interpret M': finite_measure M s by fact
-
let "?r S" = "restricted_space S"
-
{ fix S n
assume S: "S \<in> sets M"
hence **: "\<And>X. X \<in> op \<inter> S ` sets M \<longleftrightarrow> X \<in> sets M \<and> X \<subseteq> S" by auto
@@ -219,11 +242,9 @@
qed
hence "\<exists>A. ?P A S n" by auto }
note Ex_P = this
-
def A \<equiv> "nat_rec (space M) (\<lambda>n A. SOME B. ?P B A n)"
have A_Suc: "\<And>n. A (Suc n) = (SOME B. ?P B (A n) n)" by (simp add: A_def)
have A_0[simp]: "A 0 = space M" unfolding A_def by simp
-
{ fix i have "A i \<in> sets M" unfolding A_def
proof (induct i)
case (Suc i)
@@ -231,19 +252,15 @@
by (rule someI2_ex) simp
qed simp }
note A_in_sets = this
-
{ fix n have "?P (A (Suc n)) (A n) n"
using Ex_P[OF A_in_sets] unfolding A_Suc
by (rule someI2_ex) simp }
note P_A = this
-
have "range A \<subseteq> sets M" using A_in_sets by auto
-
have A_mono: "\<And>i. A (Suc i) \<subseteq> A i" using P_A by simp
have mono_dA: "mono (\<lambda>i. ?d (A i))" using P_A by (simp add: mono_iff_le_Suc)
have epsilon: "\<And>C i. \<lbrakk> C \<in> sets M; C \<subseteq> A (Suc i) \<rbrakk> \<Longrightarrow> - 1 / real (Suc i) < ?d C"
using P_A by auto
-
show ?thesis
proof (safe intro!: bexI[of _ "\<Inter>i. A i"])
show "(\<Inter>i. A i) \<in> sets M" using A_in_sets by auto
@@ -275,24 +292,19 @@
shows "\<exists>f \<in> borel_measurable M. \<forall>A\<in>sets M. \<nu> A = positive_integral (\<lambda>x. f x * indicator A x)"
proof -
interpret M': finite_measure M \<nu> using assms(1) .
-
def G \<equiv> "{g \<in> borel_measurable M. \<forall>A\<in>sets M. positive_integral (\<lambda>x. g x * indicator A x) \<le> \<nu> A}"
have "(\<lambda>x. 0) \<in> G" unfolding G_def by auto
hence "G \<noteq> {}" by auto
-
{ fix f g assume f: "f \<in> G" and g: "g \<in> G"
have "(\<lambda>x. max (g x) (f x)) \<in> G" (is "?max \<in> G") unfolding G_def
proof safe
show "?max \<in> borel_measurable M" using f g unfolding G_def by auto
-
let ?A = "{x \<in> space M. f x \<le> g x}"
have "?A \<in> sets M" using f g unfolding G_def by auto
-
fix A assume "A \<in> sets M"
hence sets: "?A \<inter> A \<in> sets M" "(space M - ?A) \<inter> A \<in> sets M" using `?A \<in> sets M` by auto
have union: "((?A \<inter> A) \<union> ((space M - ?A) \<inter> A)) = A"
using sets_into_space[OF `A \<in> sets M`] by auto
-
have "\<And>x. x \<in> space M \<Longrightarrow> max (g x) (f x) * indicator A x =
g x * indicator (?A \<inter> A) x + f x * indicator ((space M - ?A) \<inter> A) x"
by (auto simp: indicator_def max_def)
@@ -308,14 +320,12 @@
finally show "positive_integral (\<lambda>x. max (g x) (f x) * indicator A x) \<le> \<nu> A" .
qed }
note max_in_G = this
-
{ fix f g assume "f \<up> g" and f: "\<And>i. f i \<in> G"
have "g \<in> G" unfolding G_def
proof safe
from `f \<up> g` have [simp]: "g = (SUP i. f i)" unfolding isoton_def by simp
have f_borel: "\<And>i. f i \<in> borel_measurable M" using f unfolding G_def by simp
thus "g \<in> borel_measurable M" by (auto intro!: borel_measurable_SUP)
-
fix A assume "A \<in> sets M"
hence "\<And>i. (\<lambda>x. f i x * indicator A x) \<in> borel_measurable M"
using f_borel by (auto intro!: borel_measurable_indicator)
@@ -327,7 +337,6 @@
using f `A \<in> sets M` unfolding G_def by (auto intro!: SUP_leI)
qed }
note SUP_in_G = this
-
let ?y = "SUP g : G. positive_integral g"
have "?y \<le> \<nu> (space M)" unfolding G_def
proof (safe intro!: SUP_leI)
@@ -362,7 +371,6 @@
hence isoton_g: "?g \<up> f" by (simp add: isoton_def le_fun_def f_def)
from SUP_in_G[OF this g_in_G] have "f \<in> G" .
hence [simp, intro]: "f \<in> borel_measurable M" unfolding G_def by auto
-
have "(\<lambda>i. positive_integral (?g i)) \<up> positive_integral f"
using isoton_g g_in_G by (auto intro!: positive_integral_isoton simp: G_def f_def)
hence "positive_integral f = (SUP i. positive_integral (?g i))"
@@ -375,9 +383,7 @@
by (auto intro!: SUP_mono positive_integral_mono Max_ge)
qed
finally have int_f_eq_y: "positive_integral f = ?y" .
-
let "?t A" = "\<nu> A - positive_integral (\<lambda>x. f x * indicator A x)"
-
have "finite_measure M ?t"
proof
show "?t {} = 0" by simp
@@ -412,9 +418,7 @@
qed
qed
then interpret M: finite_measure M ?t .
-
have ac: "absolutely_continuous ?t" using `absolutely_continuous \<nu>` unfolding absolutely_continuous_def by auto
-
have upper_bound: "\<forall>A\<in>sets M. ?t A \<le> 0"
proof (rule ccontr)
assume "\<not> ?thesis"
@@ -437,7 +441,6 @@
ultimately have b: "b \<noteq> 0" "b \<noteq> \<omega>"
using M'.finite_measure_of_space
by (auto simp: pinfreal_inverse_eq_0 finite_measure_of_space)
-
have "finite_measure M (\<lambda>A. b * \<mu> A)" (is "finite_measure M ?b")
proof
show "?b {} = 0" by simp
@@ -446,7 +449,6 @@
unfolding countably_additive_def psuminf_cmult_right
using measure_countably_additive by auto
qed
-
from M.Radon_Nikodym_aux[OF this]
obtain A0 where "A0 \<in> sets M" and
space_less_A0: "real (?t (space M)) - real (b * \<mu> (space M)) \<le> real (?t A0) - real (b * \<mu> A0)" and
@@ -456,9 +458,7 @@
using M'.finite_measure b finite_measure
by (cases "b * \<mu> B", cases "?t B") (auto simp: field_simps) }
note bM_le_t = this
-
let "?f0 x" = "f x + b * indicator A0 x"
-
{ fix A assume A: "A \<in> sets M"
hence "A \<inter> A0 \<in> sets M" using `A0 \<in> sets M` by auto
have "positive_integral (\<lambda>x. ?f0 x * indicator A x) =
@@ -469,7 +469,6 @@
using `A0 \<in> sets M` `A \<inter> A0 \<in> sets M` A
by (simp add: borel_measurable_indicator positive_integral_add positive_integral_cmult_indicator) }
note f0_eq = this
-
{ fix A assume A: "A \<in> sets M"
hence "A \<inter> A0 \<in> sets M" using `A0 \<in> sets M` by auto
have f_le_v: "positive_integral (\<lambda>x. f x * indicator A x) \<le> \<nu> A"
@@ -488,18 +487,15 @@
finally have "positive_integral (\<lambda>x. ?f0 x * indicator A x) \<le> \<nu> A" . }
hence "?f0 \<in> G" using `A0 \<in> sets M` unfolding G_def
by (auto intro!: borel_measurable_indicator borel_measurable_pinfreal_add borel_measurable_pinfreal_times)
-
have real: "?t (space M) \<noteq> \<omega>" "?t A0 \<noteq> \<omega>"
"b * \<mu> (space M) \<noteq> \<omega>" "b * \<mu> A0 \<noteq> \<omega>"
using `A0 \<in> sets M` b
finite_measure[of A0] M.finite_measure[of A0]
finite_measure_of_space M.finite_measure_of_space
by auto
-
have int_f_finite: "positive_integral f \<noteq> \<omega>"
using M'.finite_measure_of_space pos_t unfolding pinfreal_zero_less_diff_iff
by (auto cong: positive_integral_cong)
-
have "?t (space M) > b * \<mu> (space M)" unfolding b_def
apply (simp add: field_simps)
apply (subst mult_assoc[symmetric])
@@ -516,18 +512,15 @@
hence "0 < \<mu> A0" using ac unfolding absolutely_continuous_def
using `A0 \<in> sets M` by auto
hence "0 < b * \<mu> A0" using b by auto
-
from int_f_finite this
have "?y + 0 < positive_integral f + b * \<mu> A0" unfolding int_f_eq_y
by (rule pinfreal_less_add)
also have "\<dots> = positive_integral ?f0" using f0_eq[OF top] `A0 \<in> sets M` sets_into_space
by (simp cong: positive_integral_cong)
finally have "?y < positive_integral ?f0" by simp
-
moreover from `?f0 \<in> G` have "positive_integral ?f0 \<le> ?y" by (auto intro!: le_SUPI)
ultimately show False by auto
qed
-
show ?thesis
proof (safe intro!: bexI[of _ f])
fix A assume "A\<in>sets M"
@@ -542,18 +535,18 @@
qed simp
qed
-lemma (in finite_measure) Radon_Nikodym_finite_measure_infinite:
+lemma (in finite_measure) split_space_into_finite_sets_and_rest:
assumes "measure_space M \<nu>"
- assumes "absolutely_continuous \<nu>"
- shows "\<exists>f \<in> borel_measurable M. \<forall>A\<in>sets M. \<nu> A = positive_integral (\<lambda>x. f x * indicator A x)"
+ assumes ac: "absolutely_continuous \<nu>"
+ shows "\<exists>\<Omega>0\<in>sets M. \<exists>\<Omega>::nat\<Rightarrow>'a set. disjoint_family \<Omega> \<and> range \<Omega> \<subseteq> sets M \<and> \<Omega>0 = space M - (\<Union>i. \<Omega> i) \<and>
+ (\<forall>A\<in>sets M. A \<subseteq> \<Omega>0 \<longrightarrow> (\<mu> A = 0 \<and> \<nu> A = 0) \<or> (\<mu> A > 0 \<and> \<nu> A = \<omega>)) \<and>
+ (\<forall>i. \<nu> (\<Omega> i) \<noteq> \<omega>)"
proof -
interpret v: measure_space M \<nu> by fact
let ?Q = "{Q\<in>sets M. \<nu> Q \<noteq> \<omega>}"
let ?a = "SUP Q:?Q. \<mu> Q"
-
have "{} \<in> ?Q" using v.empty_measure by auto
then have Q_not_empty: "?Q \<noteq> {}" by blast
-
have "?a \<le> \<mu> (space M)" using sets_into_space
by (auto intro!: SUP_leI measure_mono top)
then have "?a \<noteq> \<omega>" using finite_measure_of_space
@@ -571,9 +564,7 @@
show "range ?O \<subseteq> sets M" using Q' by (auto intro!: finite_UN)
show "\<And>i. ?O i \<subseteq> ?O (Suc i)" by fastsimp
qed
-
have Q'_sets: "\<And>i. Q' i \<in> sets M" using Q' by auto
-
have O_sets: "\<And>i. ?O i \<in> sets M"
using Q' by (auto intro!: finite_UN Un)
then have O_in_G: "\<And>i. ?O i \<in> ?Q"
@@ -586,7 +577,6 @@
finally show "\<nu> (?O i) \<noteq> \<omega>" unfolding pinfreal_less_\<omega> by auto
qed auto
have O_mono: "\<And>n. ?O n \<subseteq> ?O (Suc n)" by fastsimp
-
have a_eq: "?a = \<mu> (\<Union>i. ?O i)" unfolding Union[symmetric]
proof (rule antisym)
show "?a \<le> (SUP i. \<mu> (?O i))" unfolding a_Lim
@@ -600,66 +590,94 @@
using O_in_G[of i] by (auto intro!: exI[of _ "?O i"])
qed
qed
-
let "?O_0" = "(\<Union>i. ?O i)"
have "?O_0 \<in> sets M" using Q' by auto
-
- { fix A assume *: "A \<in> ?Q" "A \<subseteq> space M - ?O_0"
- then have "\<mu> ?O_0 + \<mu> A = \<mu> (?O_0 \<union> A)"
- using Q' by (auto intro!: measure_additive countable_UN)
- also have "\<dots> = (SUP i. \<mu> (?O i \<union> A))"
- proof (rule continuity_from_below[of "\<lambda>i. ?O i \<union> A", symmetric, simplified])
- show "range (\<lambda>i. ?O i \<union> A) \<subseteq> sets M"
- using * O_sets by auto
- qed fastsimp
- also have "\<dots> \<le> ?a"
- proof (safe intro!: SUPR_bound)
- fix i have "?O i \<union> A \<in> ?Q"
- proof (safe del: notI)
- show "?O i \<union> A \<in> sets M" using O_sets * by auto
- from O_in_G[of i]
- moreover have "\<nu> (?O i \<union> A) \<le> \<nu> (?O i) + \<nu> A"
- using v.measure_subadditive[of "?O i" A] * O_sets by auto
- ultimately show "\<nu> (?O i \<union> A) \<noteq> \<omega>"
- using * by auto
- qed
- then show "\<mu> (?O i \<union> A) \<le> ?a" by (rule le_SUPI)
- qed
- finally have "\<mu> A = 0" unfolding a_eq using finite_measure[OF `?O_0 \<in> sets M`]
- by (cases "\<mu> A") (auto simp: pinfreal_noteq_omega_Ex) }
- note stetic = this
-
- def Q \<equiv> "\<lambda>i. case i of 0 \<Rightarrow> ?O 0 | Suc n \<Rightarrow> ?O (Suc n) - ?O n"
-
+ def Q \<equiv> "\<lambda>i. case i of 0 \<Rightarrow> Q' 0 | Suc n \<Rightarrow> ?O (Suc n) - ?O n"
{ fix i have "Q i \<in> sets M" unfolding Q_def using Q'[of 0] by (cases i) (auto intro: O_sets) }
note Q_sets = this
-
- { fix i have "\<nu> (Q i) \<noteq> \<omega>"
- proof (cases i)
- case 0 then show ?thesis
- unfolding Q_def using Q'[of 0] by simp
- next
- case (Suc n)
- then show ?thesis unfolding Q_def
- using `?O n \<in> ?Q` `?O (Suc n) \<in> ?Q` O_mono
- using v.measure_Diff[of "?O n" "?O (Suc n)"] by auto
- qed }
- note Q_omega = this
+ show ?thesis
+ proof (intro bexI exI conjI ballI impI allI)
+ show "disjoint_family Q"
+ by (fastsimp simp: disjoint_family_on_def Q_def
+ split: nat.split_asm)
+ show "range Q \<subseteq> sets M"
+ using Q_sets by auto
+ { fix A assume A: "A \<in> sets M" "A \<subseteq> space M - ?O_0"
+ show "\<mu> A = 0 \<and> \<nu> A = 0 \<or> 0 < \<mu> A \<and> \<nu> A = \<omega>"
+ proof (rule disjCI, simp)
+ assume *: "0 < \<mu> A \<longrightarrow> \<nu> A \<noteq> \<omega>"
+ show "\<mu> A = 0 \<and> \<nu> A = 0"
+ proof cases
+ assume "\<mu> A = 0" moreover with ac A have "\<nu> A = 0"
+ unfolding absolutely_continuous_def by auto
+ ultimately show ?thesis by simp
+ next
+ assume "\<mu> A \<noteq> 0" with * have "\<nu> A \<noteq> \<omega>" by auto
+ with A have "\<mu> ?O_0 + \<mu> A = \<mu> (?O_0 \<union> A)"
+ using Q' by (auto intro!: measure_additive countable_UN)
+ also have "\<dots> = (SUP i. \<mu> (?O i \<union> A))"
+ proof (rule continuity_from_below[of "\<lambda>i. ?O i \<union> A", symmetric, simplified])
+ show "range (\<lambda>i. ?O i \<union> A) \<subseteq> sets M"
+ using `\<nu> A \<noteq> \<omega>` O_sets A by auto
+ qed fastsimp
+ also have "\<dots> \<le> ?a"
+ proof (safe intro!: SUPR_bound)
+ fix i have "?O i \<union> A \<in> ?Q"
+ proof (safe del: notI)
+ show "?O i \<union> A \<in> sets M" using O_sets A by auto
+ from O_in_G[of i]
+ moreover have "\<nu> (?O i \<union> A) \<le> \<nu> (?O i) + \<nu> A"
+ using v.measure_subadditive[of "?O i" A] A O_sets by auto
+ ultimately show "\<nu> (?O i \<union> A) \<noteq> \<omega>"
+ using `\<nu> A \<noteq> \<omega>` by auto
+ qed
+ then show "\<mu> (?O i \<union> A) \<le> ?a" by (rule le_SUPI)
+ qed
+ finally have "\<mu> A = 0" unfolding a_eq using finite_measure[OF `?O_0 \<in> sets M`]
+ by (cases "\<mu> A") (auto simp: pinfreal_noteq_omega_Ex)
+ with `\<mu> A \<noteq> 0` show ?thesis by auto
+ qed
+ qed }
+ { fix i show "\<nu> (Q i) \<noteq> \<omega>"
+ proof (cases i)
+ case 0 then show ?thesis
+ unfolding Q_def using Q'[of 0] by simp
+ next
+ case (Suc n)
+ then show ?thesis unfolding Q_def
+ using `?O n \<in> ?Q` `?O (Suc n) \<in> ?Q` O_mono
+ using v.measure_Diff[of "?O n" "?O (Suc n)"] by auto
+ qed }
+ show "space M - ?O_0 \<in> sets M" using Q'_sets by auto
+ { fix j have "(\<Union>i\<le>j. ?O i) = (\<Union>i\<le>j. Q i)"
+ proof (induct j)
+ case 0 then show ?case by (simp add: Q_def)
+ next
+ case (Suc j)
+ have eq: "\<And>j. (\<Union>i\<le>j. ?O i) = (\<Union>i\<le>j. Q' i)" by fastsimp
+ have "{..j} \<union> {..Suc j} = {..Suc j}" by auto
+ then have "(\<Union>i\<le>Suc j. Q' i) = (\<Union>i\<le>j. Q' i) \<union> Q (Suc j)"
+ by (simp add: UN_Un[symmetric] Q_def del: UN_Un)
+ then show ?case using Suc by (auto simp add: eq atMost_Suc)
+ qed }
+ then have "(\<Union>j. (\<Union>i\<le>j. ?O i)) = (\<Union>j. (\<Union>i\<le>j. Q i))" by simp
+ then show "space M - ?O_0 = space M - (\<Union>i. Q i)" by fastsimp
+ qed
+qed
- { fix j have "(\<Union>i\<le>j. ?O i) = (\<Union>i\<le>j. Q i)"
- proof (induct j)
- case 0 then show ?case by (simp add: Q_def)
- next
- case (Suc j)
- have eq: "\<And>j. (\<Union>i\<le>j. ?O i) = (\<Union>i\<le>j. Q' i)" by fastsimp
- have "{..j} \<union> {..Suc j} = {..Suc j}" by auto
- then have "(\<Union>i\<le>Suc j. Q' i) = (\<Union>i\<le>j. Q' i) \<union> Q (Suc j)"
- by (simp add: UN_Un[symmetric] Q_def del: UN_Un)
- then show ?case using Suc by (auto simp add: eq atMost_Suc)
- qed }
- then have "(\<Union>j. (\<Union>i\<le>j. ?O i)) = (\<Union>j. (\<Union>i\<le>j. Q i))" by simp
- then have O_0_eq_Q: "?O_0 = (\<Union>j. Q j)" by fastsimp
-
+lemma (in finite_measure) Radon_Nikodym_finite_measure_infinite:
+ assumes "measure_space M \<nu>"
+ assumes "absolutely_continuous \<nu>"
+ shows "\<exists>f \<in> borel_measurable M. \<forall>A\<in>sets M. \<nu> A = positive_integral (\<lambda>x. f x * indicator A x)"
+proof -
+ interpret v: measure_space M \<nu> by fact
+ from split_space_into_finite_sets_and_rest[OF assms]
+ obtain Q0 and Q :: "nat \<Rightarrow> 'a set"
+ where Q: "disjoint_family Q" "range Q \<subseteq> sets M"
+ and Q0: "Q0 \<in> sets M" "Q0 = space M - (\<Union>i. Q i)"
+ and in_Q0: "\<And>A. A \<in> sets M \<Longrightarrow> A \<subseteq> Q0 \<Longrightarrow> \<mu> A = 0 \<and> \<nu> A = 0 \<or> 0 < \<mu> A \<and> \<nu> A = \<omega>"
+ and Q_fin: "\<And>i. \<nu> (Q i) \<noteq> \<omega>" by force
+ from Q have Q_sets: "\<And>i. Q i \<in> sets M" by auto
have "\<forall>i. \<exists>f. f\<in>borel_measurable M \<and> (\<forall>A\<in>sets M.
\<nu> (Q i \<inter> A) = positive_integral (\<lambda>x. f x * indicator (Q i \<inter> A) x))"
proof
@@ -667,7 +685,6 @@
have indicator_eq: "\<And>f x A. (f x :: pinfreal) * indicator (Q i \<inter> A) x * indicator (Q i) x
= (f x * indicator (Q i) x) * indicator A x"
unfolding indicator_def by auto
-
have fm: "finite_measure (restricted_space (Q i)) \<mu>"
(is "finite_measure ?R \<mu>") by (rule restricted_finite_measure[OF Q_sets[of i]])
then interpret R: finite_measure ?R .
@@ -677,7 +694,7 @@
show "measure_space ?R \<nu>"
using v.restricted_measure_space Q_sets[of i] by auto
show "\<nu> (space ?R) \<noteq> \<omega>"
- using Q_omega by simp
+ using Q_fin by simp
qed
have "R.absolutely_continuous \<nu>"
using `absolutely_continuous \<nu>` `Q i \<in> sets M`
@@ -697,71 +714,49 @@
\<nu> (Q i \<inter> A) = positive_integral (\<lambda>x. f i x * indicator (Q i \<inter> A) x)"
by auto
let "?f x" =
- "(\<Sum>\<^isub>\<infinity> i. f i x * indicator (Q i) x) + \<omega> * indicator (space M - ?O_0) x"
+ "(\<Sum>\<^isub>\<infinity> i. f i x * indicator (Q i) x) + \<omega> * indicator Q0 x"
show ?thesis
proof (safe intro!: bexI[of _ ?f])
show "?f \<in> borel_measurable M"
by (safe intro!: borel_measurable_psuminf borel_measurable_pinfreal_times
borel_measurable_pinfreal_add borel_measurable_indicator
- borel_measurable_const borel Q_sets O_sets Diff countable_UN)
+ borel_measurable_const borel Q_sets Q0 Diff countable_UN)
fix A assume "A \<in> sets M"
- let ?C = "(space M - (\<Union>i. Q i)) \<inter> A"
- have *:
+ have *:
"\<And>x i. indicator A x * (f i x * indicator (Q i) x) =
f i x * indicator (Q i \<inter> A) x"
- "\<And>x i. (indicator A x * indicator (space M - (\<Union>i. UNION {..i} Q')) x :: pinfreal) =
- indicator ?C x" unfolding O_0_eq_Q by (auto simp: indicator_def)
+ "\<And>x i. (indicator A x * indicator Q0 x :: pinfreal) =
+ indicator (Q0 \<inter> A) x" by (auto simp: indicator_def)
have "positive_integral (\<lambda>x. ?f x * indicator A x) =
- (\<Sum>\<^isub>\<infinity> i. \<nu> (Q i \<inter> A)) + \<omega> * \<mu> ?C"
+ (\<Sum>\<^isub>\<infinity> i. \<nu> (Q i \<inter> A)) + \<omega> * \<mu> (Q0 \<inter> A)"
unfolding f[OF `A \<in> sets M`]
- apply (simp del: pinfreal_times(2) add: field_simps)
+ apply (simp del: pinfreal_times(2) add: field_simps *)
apply (subst positive_integral_add)
- apply (safe intro!: borel_measurable_pinfreal_times Diff borel_measurable_const
- borel_measurable_psuminf borel_measurable_indicator `A \<in> sets M` Q_sets borel countable_UN Q'_sets)
+ apply (fastsimp intro: Q0 `A \<in> sets M`)
+ apply (fastsimp intro: Q_sets `A \<in> sets M` borel_measurable_psuminf borel)
+ apply (subst positive_integral_cmult_indicator)
+ apply (fastsimp intro: Q0 `A \<in> sets M`)
unfolding psuminf_cmult_right[symmetric]
apply (subst positive_integral_psuminf)
- apply (safe intro!: borel_measurable_pinfreal_times Diff borel_measurable_const
- borel_measurable_psuminf borel_measurable_indicator `A \<in> sets M` Q_sets borel countable_UN Q'_sets)
- apply (subst positive_integral_cmult)
- apply (safe intro!: borel_measurable_pinfreal_times Diff borel_measurable_const
- borel_measurable_psuminf borel_measurable_indicator `A \<in> sets M` Q_sets borel countable_UN Q'_sets)
- unfolding *
- apply (subst positive_integral_indicator)
- apply (safe intro!: borel_measurable_pinfreal_times Diff borel_measurable_const Int
- borel_measurable_psuminf borel_measurable_indicator `A \<in> sets M` Q_sets borel countable_UN Q'_sets)
- by simp
+ apply (fastsimp intro: `A \<in> sets M` Q_sets borel)
+ apply (simp add: *)
+ done
moreover have "(\<Sum>\<^isub>\<infinity>i. \<nu> (Q i \<inter> A)) = \<nu> ((\<Union>i. Q i) \<inter> A)"
- proof (rule v.measure_countably_additive[of "\<lambda>i. Q i \<inter> A", unfolded comp_def, simplified])
- show "range (\<lambda>i. Q i \<inter> A) \<subseteq> sets M"
- using Q_sets `A \<in> sets M` by auto
- show "disjoint_family (\<lambda>i. Q i \<inter> A)"
- by (fastsimp simp: disjoint_family_on_def Q_def
- split: nat.split_asm)
+ using Q Q_sets `A \<in> sets M`
+ by (intro v.measure_countably_additive[of "\<lambda>i. Q i \<inter> A", unfolded comp_def, simplified])
+ (auto simp: disjoint_family_on_def)
+ moreover have "\<omega> * \<mu> (Q0 \<inter> A) = \<nu> (Q0 \<inter> A)"
+ proof -
+ have "Q0 \<inter> A \<in> sets M" using Q0(1) `A \<in> sets M` by blast
+ from in_Q0[OF this] show ?thesis by auto
qed
- moreover have "\<omega> * \<mu> ?C = \<nu> ?C"
- proof cases
- assume null: "\<mu> ?C = 0"
- hence "?C \<in> null_sets" using Q_sets `A \<in> sets M` by auto
- with `absolutely_continuous \<nu>` and null
- show ?thesis by (simp add: absolutely_continuous_def)
- next
- assume not_null: "\<mu> ?C \<noteq> 0"
- have "\<nu> ?C = \<omega>"
- proof (rule ccontr)
- assume "\<nu> ?C \<noteq> \<omega>"
- then have "?C \<in> ?Q"
- using Q_sets `A \<in> sets M` by auto
- from stetic[OF this] not_null
- show False unfolding O_0_eq_Q by auto
- qed
- then show ?thesis using not_null by simp
- qed
- moreover have "?C \<in> sets M" "((\<Union>i. Q i) \<inter> A) \<in> sets M"
- using Q_sets `A \<in> sets M` by (auto intro!: countable_UN)
- moreover have "((\<Union>i. Q i) \<inter> A) \<union> ?C = A" "((\<Union>i. Q i) \<inter> A) \<inter> ?C = {}"
- using `A \<in> sets M` sets_into_space by auto
+ moreover have "Q0 \<inter> A \<in> sets M" "((\<Union>i. Q i) \<inter> A) \<in> sets M"
+ using Q_sets `A \<in> sets M` Q0(1) by (auto intro!: countable_UN)
+ moreover have "((\<Union>i. Q i) \<inter> A) \<union> (Q0 \<inter> A) = A" "((\<Union>i. Q i) \<inter> A) \<inter> (Q0 \<inter> A) = {}"
+ using `A \<in> sets M` sets_into_space Q0 by auto
ultimately show "\<nu> A = positive_integral (\<lambda>x. ?f x * indicator A x)"
- using v.measure_additive[simplified, of "(\<Union>i. Q i) \<inter> A" ?C] by auto
+ using v.measure_additive[simplified, of "(\<Union>i. Q i) \<inter> A" "Q0 \<inter> A"]
+ by simp
qed
qed
@@ -801,12 +796,274 @@
qed
qed
-section "Radon Nikodym derivative"
+section "Uniqueness of densities"
+
+lemma (in measure_space) finite_density_unique:
+ assumes borel: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
+ and fin: "positive_integral f < \<omega>"
+ shows "(\<forall>A\<in>sets M. positive_integral (\<lambda>x. f x * indicator A x) = positive_integral (\<lambda>x. g x * indicator A x))
+ \<longleftrightarrow> (AE x. f x = g x)"
+ (is "(\<forall>A\<in>sets M. ?P f A = ?P g A) \<longleftrightarrow> _")
+proof (intro iffI ballI)
+ fix A assume eq: "AE x. f x = g x"
+ show "?P f A = ?P g A"
+ by (rule positive_integral_cong_AE[OF AE_mp[OF eq]]) simp
+next
+ assume eq: "\<forall>A\<in>sets M. ?P f A = ?P g A"
+ from this[THEN bspec, OF top] fin
+ have g_fin: "positive_integral g < \<omega>" by (simp cong: positive_integral_cong)
+ { fix f g assume borel: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
+ and g_fin: "positive_integral g < \<omega>" and eq: "\<forall>A\<in>sets M. ?P f A = ?P g A"
+ let ?N = "{x\<in>space M. g x < f x}"
+ have N: "?N \<in> sets M" using borel by simp
+ have "?P (\<lambda>x. (f x - g x)) ?N = positive_integral (\<lambda>x. f x * indicator ?N x - g x * indicator ?N x)"
+ by (auto intro!: positive_integral_cong simp: indicator_def)
+ also have "\<dots> = ?P f ?N - ?P g ?N"
+ proof (rule positive_integral_diff)
+ show "(\<lambda>x. f x * indicator ?N x) \<in> borel_measurable M" "(\<lambda>x. g x * indicator ?N x) \<in> borel_measurable M"
+ using borel N by auto
+ have "?P g ?N \<le> positive_integral g"
+ by (auto intro!: positive_integral_mono simp: indicator_def)
+ then show "?P g ?N \<noteq> \<omega>" using g_fin by auto
+ fix x assume "x \<in> space M"
+ show "g x * indicator ?N x \<le> f x * indicator ?N x"
+ by (auto simp: indicator_def)
+ qed
+ also have "\<dots> = 0"
+ using eq[THEN bspec, OF N] by simp
+ finally have "\<mu> {x\<in>space M. (f x - g x) * indicator ?N x \<noteq> 0} = 0"
+ using borel N by (subst (asm) positive_integral_0_iff) auto
+ moreover have "{x\<in>space M. (f x - g x) * indicator ?N x \<noteq> 0} = ?N"
+ by (auto simp: pinfreal_zero_le_diff)
+ ultimately have "?N \<in> null_sets" using N by simp }
+ from this[OF borel g_fin eq] this[OF borel(2,1) fin]
+ have "{x\<in>space M. g x < f x} \<union> {x\<in>space M. f x < g x} \<in> null_sets"
+ using eq by (intro null_sets_Un) auto
+ also have "{x\<in>space M. g x < f x} \<union> {x\<in>space M. f x < g x} = {x\<in>space M. f x \<noteq> g x}"
+ by auto
+ finally show "AE x. f x = g x"
+ unfolding almost_everywhere_def by auto
+qed
+
+lemma (in finite_measure) density_unique_finite_measure:
+ assumes borel: "f \<in> borel_measurable M" "f' \<in> borel_measurable M"
+ assumes f: "\<And>A. A \<in> sets M \<Longrightarrow> positive_integral (\<lambda>x. f x * indicator A x) = positive_integral (\<lambda>x. f' x * indicator A x)"
+ (is "\<And>A. A \<in> sets M \<Longrightarrow> ?P f A = ?P f' A")
+ shows "AE x. f x = f' x"
+proof -
+ let "?\<nu> A" = "?P f A" and "?\<nu>' A" = "?P f' A"
+ let "?f A x" = "f x * indicator A x" and "?f' A x" = "f' x * indicator A x"
+ interpret M: measure_space M ?\<nu>
+ using borel(1) by (rule measure_space_density)
+ have ac: "absolutely_continuous ?\<nu>"
+ using f by (rule density_is_absolutely_continuous)
+ from split_space_into_finite_sets_and_rest[OF `measure_space M ?\<nu>` ac]
+ obtain Q0 and Q :: "nat \<Rightarrow> 'a set"
+ where Q: "disjoint_family Q" "range Q \<subseteq> sets M"
+ and Q0: "Q0 \<in> sets M" "Q0 = space M - (\<Union>i. Q i)"
+ and in_Q0: "\<And>A. A \<in> sets M \<Longrightarrow> A \<subseteq> Q0 \<Longrightarrow> \<mu> A = 0 \<and> ?\<nu> A = 0 \<or> 0 < \<mu> A \<and> ?\<nu> A = \<omega>"
+ and Q_fin: "\<And>i. ?\<nu> (Q i) \<noteq> \<omega>" by force
+ from Q have Q_sets: "\<And>i. Q i \<in> sets M" by auto
+ let ?N = "{x\<in>space M. f x \<noteq> f' x}"
+ have "?N \<in> sets M" using borel by auto
+ have *: "\<And>i x A. \<And>y::pinfreal. y * indicator (Q i) x * indicator A x = y * indicator (Q i \<inter> A) x"
+ unfolding indicator_def by auto
+ have 1: "\<forall>i. AE x. ?f (Q i) x = ?f' (Q i) x"
+ using borel Q_fin Q
+ by (intro finite_density_unique[THEN iffD1] allI)
+ (auto intro!: borel_measurable_pinfreal_times f Int simp: *)
+ have 2: "AE x. ?f Q0 x = ?f' Q0 x"
+ proof (rule AE_I')
+ { fix f :: "'a \<Rightarrow> pinfreal" assume borel: "f \<in> borel_measurable M"
+ and eq: "\<And>A. A \<in> sets M \<Longrightarrow> ?\<nu> A = positive_integral (\<lambda>x. f x * indicator A x)"
+ let "?A i" = "Q0 \<inter> {x \<in> space M. f x < of_nat i}"
+ have "(\<Union>i. ?A i) \<in> null_sets"
+ proof (rule null_sets_UN)
+ fix i have "?A i \<in> sets M"
+ using borel Q0(1) by auto
+ have "?\<nu> (?A i) \<le> positive_integral (\<lambda>x. of_nat i * indicator (?A i) x)"
+ unfolding eq[OF `?A i \<in> sets M`]
+ by (auto intro!: positive_integral_mono simp: indicator_def)
+ also have "\<dots> = of_nat i * \<mu> (?A i)"
+ using `?A i \<in> sets M` by (auto intro!: positive_integral_cmult_indicator)
+ also have "\<dots> < \<omega>"
+ using `?A i \<in> sets M`[THEN finite_measure] by auto
+ finally have "?\<nu> (?A i) \<noteq> \<omega>" by simp
+ then show "?A i \<in> null_sets" using in_Q0[OF `?A i \<in> sets M`] `?A i \<in> sets M` by auto
+ qed
+ also have "(\<Union>i. ?A i) = Q0 \<inter> {x\<in>space M. f x < \<omega>}"
+ by (auto simp: less_\<omega>_Ex_of_nat)
+ finally have "Q0 \<inter> {x\<in>space M. f x \<noteq> \<omega>} \<in> null_sets" by (simp add: pinfreal_less_\<omega>) }
+ from this[OF borel(1) refl] this[OF borel(2) f]
+ have "Q0 \<inter> {x\<in>space M. f x \<noteq> \<omega>} \<in> null_sets" "Q0 \<inter> {x\<in>space M. f' x \<noteq> \<omega>} \<in> null_sets" by simp_all
+ then show "(Q0 \<inter> {x\<in>space M. f x \<noteq> \<omega>}) \<union> (Q0 \<inter> {x\<in>space M. f' x \<noteq> \<omega>}) \<in> null_sets" by (rule null_sets_Un)
+ show "{x \<in> space M. ?f Q0 x \<noteq> ?f' Q0 x} \<subseteq>
+ (Q0 \<inter> {x\<in>space M. f x \<noteq> \<omega>}) \<union> (Q0 \<inter> {x\<in>space M. f' x \<noteq> \<omega>})" by (auto simp: indicator_def)
+ qed
+ have **: "\<And>x. (?f Q0 x = ?f' Q0 x) \<longrightarrow> (\<forall>i. ?f (Q i) x = ?f' (Q i) x) \<longrightarrow>
+ ?f (space M) x = ?f' (space M) x"
+ by (auto simp: indicator_def Q0)
+ have 3: "AE x. ?f (space M) x = ?f' (space M) x"
+ by (rule AE_mp[OF 1[unfolded all_AE_countable] AE_mp[OF 2]]) (simp add: **)
+ then show "AE x. f x = f' x"
+ by (rule AE_mp) (auto intro!: AE_cong simp: indicator_def)
+qed
+
+lemma (in sigma_finite_measure) density_unique:
+ assumes borel: "f \<in> borel_measurable M" "f' \<in> borel_measurable M"
+ assumes f: "\<And>A. A \<in> sets M \<Longrightarrow> positive_integral (\<lambda>x. f x * indicator A x) = positive_integral (\<lambda>x. f' x * indicator A x)"
+ (is "\<And>A. A \<in> sets M \<Longrightarrow> ?P f A = ?P f' A")
+ shows "AE x. f x = f' x"
+proof -
+ obtain h where h_borel: "h \<in> borel_measurable M"
+ and fin: "positive_integral h \<noteq> \<omega>" and pos: "\<And>x. x \<in> space M \<Longrightarrow> 0 < h x \<and> h x < \<omega>"
+ using Ex_finite_integrable_function by auto
+ interpret h: measure_space M "\<lambda>A. positive_integral (\<lambda>x. h x * indicator A x)"
+ using h_borel by (rule measure_space_density)
+ interpret h: finite_measure M "\<lambda>A. positive_integral (\<lambda>x. h x * indicator A x)"
+ by default (simp cong: positive_integral_cong add: fin)
+ interpret f: measure_space M "\<lambda>A. positive_integral (\<lambda>x. f x * indicator A x)"
+ using borel(1) by (rule measure_space_density)
+ interpret f': measure_space M "\<lambda>A. positive_integral (\<lambda>x. f' x * indicator A x)"
+ using borel(2) by (rule measure_space_density)
+ { fix A assume "A \<in> sets M"
+ then have " {x \<in> space M. h x \<noteq> 0 \<and> indicator A x \<noteq> (0::pinfreal)} = A"
+ using pos sets_into_space by (force simp: indicator_def)
+ then have "positive_integral (\<lambda>xa. h xa * indicator A xa) = 0 \<longleftrightarrow> A \<in> null_sets"
+ using h_borel `A \<in> sets M` by (simp add: positive_integral_0_iff) }
+ note h_null_sets = this
+ { fix A assume "A \<in> sets M"
+ have "positive_integral (\<lambda>x. h x * (f x * indicator A x)) =
+ f.positive_integral (\<lambda>x. h x * indicator A x)"
+ using `A \<in> sets M` h_borel borel
+ by (simp add: positive_integral_translated_density ac_simps cong: positive_integral_cong)
+ also have "\<dots> = f'.positive_integral (\<lambda>x. h x * indicator A x)"
+ by (rule f'.positive_integral_cong_measure) (rule f)
+ also have "\<dots> = positive_integral (\<lambda>x. h x * (f' x * indicator A x))"
+ using `A \<in> sets M` h_borel borel
+ by (simp add: positive_integral_translated_density ac_simps cong: positive_integral_cong)
+ finally have "positive_integral (\<lambda>x. h x * (f x * indicator A x)) = positive_integral (\<lambda>x. h x * (f' x * indicator A x))" . }
+ then have "h.almost_everywhere (\<lambda>x. f x = f' x)"
+ using h_borel borel
+ by (intro h.density_unique_finite_measure[OF borel])
+ (simp add: positive_integral_translated_density)
+ then show "AE x. f x = f' x"
+ unfolding h.almost_everywhere_def almost_everywhere_def
+ by (auto simp add: h_null_sets)
+qed
+
+lemma (in sigma_finite_measure) sigma_finite_iff_density_finite:
+ assumes \<nu>: "measure_space M \<nu>" and f: "f \<in> borel_measurable M"
+ and eq: "\<And>A. A \<in> sets M \<Longrightarrow> \<nu> A = positive_integral (\<lambda>x. f x * indicator A x)"
+ shows "sigma_finite_measure M \<nu> \<longleftrightarrow> (AE x. f x \<noteq> \<omega>)"
+proof
+ assume "sigma_finite_measure M \<nu>"
+ then interpret \<nu>: sigma_finite_measure M \<nu> .
+ from \<nu>.Ex_finite_integrable_function obtain h where
+ h: "h \<in> borel_measurable M" "\<nu>.positive_integral h \<noteq> \<omega>"
+ and fin: "\<And>x. x \<in> space M \<Longrightarrow> 0 < h x \<and> h x < \<omega>" by auto
+ have "AE x. f x * h x \<noteq> \<omega>"
+ proof (rule AE_I')
+ have "\<nu>.positive_integral h = positive_integral (\<lambda>x. f x * h x)"
+ by (simp add: \<nu>.positive_integral_cong_measure[symmetric, OF eq[symmetric]])
+ (intro positive_integral_translated_density f h)
+ then have "positive_integral (\<lambda>x. f x * h x) \<noteq> \<omega>"
+ using h(2) by simp
+ then show "(\<lambda>x. f x * h x) -` {\<omega>} \<inter> space M \<in> null_sets"
+ using f h(1) by (auto intro!: positive_integral_omega borel_measurable_vimage)
+ qed auto
+ then show "AE x. f x \<noteq> \<omega>"
+ proof (rule AE_mp, intro AE_cong)
+ fix x assume "x \<in> space M" from this[THEN fin]
+ show "f x * h x \<noteq> \<omega> \<longrightarrow> f x \<noteq> \<omega>" by auto
+ qed
+next
+ assume AE: "AE x. f x \<noteq> \<omega>"
+ from sigma_finite guess Q .. note Q = this
+ interpret \<nu>: measure_space M \<nu> by fact
+ def A \<equiv> "\<lambda>i. f -` (case i of 0 \<Rightarrow> {\<omega>} | Suc n \<Rightarrow> {.. of_nat (Suc n)}) \<inter> space M"
+ { fix i j have "A i \<inter> Q j \<in> sets M"
+ unfolding A_def using f Q
+ apply (rule_tac Int)
+ by (cases i) (auto intro: measurable_sets[OF f]) }
+ note A_in_sets = this
+ let "?A n" = "case prod_decode n of (i,j) \<Rightarrow> A i \<inter> Q j"
+ show "sigma_finite_measure M \<nu>"
+ proof (default, intro exI conjI subsetI allI)
+ fix x assume "x \<in> range ?A"
+ then obtain n where n: "x = ?A n" by auto
+ then show "x \<in> sets M" using A_in_sets by (cases "prod_decode n") auto
+ next
+ have "(\<Union>i. ?A i) = (\<Union>i j. A i \<inter> Q j)"
+ proof safe
+ fix x i j assume "x \<in> A i" "x \<in> Q j"
+ then show "x \<in> (\<Union>i. case prod_decode i of (i, j) \<Rightarrow> A i \<inter> Q j)"
+ by (intro UN_I[of "prod_encode (i,j)"]) auto
+ qed auto
+ also have "\<dots> = (\<Union>i. A i) \<inter> space M" using Q by auto
+ also have "(\<Union>i. A i) = space M"
+ proof safe
+ fix x assume x: "x \<in> space M"
+ show "x \<in> (\<Union>i. A i)"
+ proof (cases "f x")
+ case infinite then show ?thesis using x unfolding A_def by (auto intro: exI[of _ 0])
+ next
+ case (preal r)
+ with less_\<omega>_Ex_of_nat[of "f x"] obtain n where "f x < of_nat n" by auto
+ then show ?thesis using x preal unfolding A_def by (auto intro!: exI[of _ "Suc n"])
+ qed
+ qed (auto simp: A_def)
+ finally show "(\<Union>i. ?A i) = space M" by simp
+ next
+ fix n obtain i j where
+ [simp]: "prod_decode n = (i, j)" by (cases "prod_decode n") auto
+ have "positive_integral (\<lambda>x. f x * indicator (A i \<inter> Q j) x) \<noteq> \<omega>"
+ proof (cases i)
+ case 0
+ have "AE x. f x * indicator (A i \<inter> Q j) x = 0"
+ using AE by (rule AE_mp) (auto intro!: AE_cong simp: A_def `i = 0`)
+ then have "positive_integral (\<lambda>x. f x * indicator (A i \<inter> Q j) x) = 0"
+ using A_in_sets f
+ apply (subst positive_integral_0_iff)
+ apply fast
+ apply (subst (asm) AE_iff_null_set)
+ apply (intro borel_measurable_pinfreal_neq_const)
+ apply fast
+ by simp
+ then show ?thesis by simp
+ next
+ case (Suc n)
+ then have "positive_integral (\<lambda>x. f x * indicator (A i \<inter> Q j) x) \<le>
+ positive_integral (\<lambda>x. of_nat (Suc n) * indicator (Q j) x)"
+ by (auto intro!: positive_integral_mono simp: indicator_def A_def)
+ also have "\<dots> = of_nat (Suc n) * \<mu> (Q j)"
+ using Q by (auto intro!: positive_integral_cmult_indicator)
+ also have "\<dots> < \<omega>"
+ using Q by auto
+ finally show ?thesis by simp
+ qed
+ then show "\<nu> (?A n) \<noteq> \<omega>"
+ using A_in_sets Q eq by auto
+ qed
+qed
+
+section "Radon-Nikodym derivative"
definition (in sigma_finite_measure)
"RN_deriv \<nu> \<equiv> SOME f. f \<in> borel_measurable M \<and>
(\<forall>A \<in> sets M. \<nu> A = positive_integral (\<lambda>x. f x * indicator A x))"
+lemma (in sigma_finite_measure) RN_deriv_cong:
+ assumes cong: "\<And>A. A \<in> sets M \<Longrightarrow> \<mu>' A = \<mu> A" "\<And>A. A \<in> sets M \<Longrightarrow> \<nu>' A = \<nu> A"
+ shows "sigma_finite_measure.RN_deriv M \<mu>' \<nu>' x = RN_deriv \<nu> x"
+proof -
+ interpret \<mu>': sigma_finite_measure M \<mu>'
+ using cong(1) by (rule sigma_finite_measure_cong)
+ show ?thesis
+ unfolding RN_deriv_def \<mu>'.RN_deriv_def
+ by (simp add: cong positive_integral_cong_measure[OF cong(1)])
+qed
+
lemma (in sigma_finite_measure) RN_deriv:
assumes "measure_space M \<nu>"
assumes "absolutely_continuous \<nu>"
@@ -821,6 +1078,107 @@
by (rule someI2_ex) (simp add: `A \<in> sets M`)
qed
+lemma (in sigma_finite_measure) RN_deriv_positive_integral:
+ assumes \<nu>: "measure_space M \<nu>" "absolutely_continuous \<nu>"
+ and f: "f \<in> borel_measurable M"
+ shows "measure_space.positive_integral M \<nu> f = positive_integral (\<lambda>x. RN_deriv \<nu> x * f x)"
+proof -
+ interpret \<nu>: measure_space M \<nu> by fact
+ have "\<nu>.positive_integral f =
+ measure_space.positive_integral M (\<lambda>A. positive_integral (\<lambda>x. RN_deriv \<nu> x * indicator A x)) f"
+ by (intro \<nu>.positive_integral_cong_measure[symmetric] RN_deriv(2)[OF \<nu>, symmetric])
+ also have "\<dots> = positive_integral (\<lambda>x. RN_deriv \<nu> x * f x)"
+ by (intro positive_integral_translated_density RN_deriv[OF \<nu>] f)
+ finally show ?thesis .
+qed
+
+lemma (in sigma_finite_measure) RN_deriv_unique:
+ assumes \<nu>: "measure_space M \<nu>" "absolutely_continuous \<nu>"
+ and f: "f \<in> borel_measurable M"
+ and eq: "\<And>A. A \<in> sets M \<Longrightarrow> \<nu> A = positive_integral (\<lambda>x. f x * indicator A x)"
+ shows "AE x. f x = RN_deriv \<nu> x"
+proof (rule density_unique[OF f RN_deriv(1)[OF \<nu>]])
+ fix A assume A: "A \<in> sets M"
+ show "positive_integral (\<lambda>x. f x * indicator A x) = positive_integral (\<lambda>x. RN_deriv \<nu> x * indicator A x)"
+ unfolding eq[OF A, symmetric] RN_deriv(2)[OF \<nu> A, symmetric] ..
+qed
+
+lemma the_inv_into_in:
+ assumes "inj_on f A" and x: "x \<in> f`A"
+ shows "the_inv_into A f x \<in> A"
+ using assms by (auto simp: the_inv_into_f_f)
+
+lemma (in sigma_finite_measure) RN_deriv_vimage:
+ fixes f :: "'b \<Rightarrow> 'a"
+ assumes f: "bij_betw f S (space M)"
+ assumes \<nu>: "measure_space M \<nu>" "absolutely_continuous \<nu>"
+ shows "AE x.
+ sigma_finite_measure.RN_deriv (vimage_algebra S f) (\<lambda>A. \<mu> (f ` A)) (\<lambda>A. \<nu> (f ` A)) (the_inv_into S f x) = RN_deriv \<nu> x"
+proof (rule RN_deriv_unique[OF \<nu>])
+ interpret sf: sigma_finite_measure "vimage_algebra S f" "\<lambda>A. \<mu> (f ` A)"
+ using f by (rule sigma_finite_measure_isomorphic)
+ interpret \<nu>: measure_space M \<nu> using \<nu>(1) .
+ have \<nu>': "measure_space (vimage_algebra S f) (\<lambda>A. \<nu> (f ` A))"
+ using f by (rule \<nu>.measure_space_isomorphic)
+ { fix A assume "A \<in> sets M" then have "f ` (f -` A \<inter> S) = A"
+ using sets_into_space f[unfolded bij_betw_def]
+ by (intro image_vimage_inter_eq[where T="space M"]) auto }
+ note A_f = this
+ then have ac: "sf.absolutely_continuous (\<lambda>A. \<nu> (f ` A))"
+ using \<nu>(2) by (auto simp: sf.absolutely_continuous_def absolutely_continuous_def)
+ show "(\<lambda>x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) (the_inv_into S f x)) \<in> borel_measurable M"
+ using sf.RN_deriv(1)[OF \<nu>' ac]
+ unfolding measurable_vimage_iff_inv[OF f] comp_def .
+ fix A assume "A \<in> sets M"
+ then have *: "\<And>x. x \<in> space M \<Longrightarrow> indicator (f -` A \<inter> S) (the_inv_into S f x) = (indicator A x :: pinfreal)"
+ using f[unfolded bij_betw_def]
+ unfolding indicator_def by (auto simp: f_the_inv_into_f the_inv_into_in)
+ have "\<nu> (f ` (f -` A \<inter> S)) = sf.positive_integral (\<lambda>x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) x * indicator (f -` A \<inter> S) x)"
+ using `A \<in> sets M` by (force intro!: sf.RN_deriv(2)[OF \<nu>' ac])
+ also have "\<dots> = positive_integral (\<lambda>x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) (the_inv_into S f x) * indicator A x)"
+ unfolding positive_integral_vimage_inv[OF f]
+ by (simp add: * cong: positive_integral_cong)
+ finally show "\<nu> A = positive_integral (\<lambda>x. sf.RN_deriv (\<lambda>A. \<nu> (f ` A)) (the_inv_into S f x) * indicator A x)"
+ unfolding A_f[OF `A \<in> sets M`] .
+qed
+
+lemma (in sigma_finite_measure) RN_deriv_finite:
+ assumes sfm: "sigma_finite_measure M \<nu>" and ac: "absolutely_continuous \<nu>"
+ shows "AE x. RN_deriv \<nu> x \<noteq> \<omega>"
+proof -
+ interpret \<nu>: sigma_finite_measure M \<nu> by fact
+ have \<nu>: "measure_space M \<nu>" by default
+ from sfm show ?thesis
+ using sigma_finite_iff_density_finite[OF \<nu> RN_deriv[OF \<nu> ac]] by simp
+qed
+
+lemma (in sigma_finite_measure)
+ assumes \<nu>: "sigma_finite_measure M \<nu>" "absolutely_continuous \<nu>"
+ and f: "f \<in> borel_measurable M"
+ shows RN_deriv_integral: "measure_space.integral M \<nu> f = integral (\<lambda>x. real (RN_deriv \<nu> x) * f x)" (is ?integral)
+ and RN_deriv_integrable: "measure_space.integrable M \<nu> f \<longleftrightarrow> integrable (\<lambda>x. real (RN_deriv \<nu> x) * f x)" (is ?integrable)
+proof -
+ interpret \<nu>: sigma_finite_measure M \<nu> by fact
+ have ms: "measure_space M \<nu>" by default
+ have minus_cong: "\<And>A B A' B'::pinfreal. A = A' \<Longrightarrow> B = B' \<Longrightarrow> real A - real B = real A' - real B'" by simp
+ have f': "(\<lambda>x. - f x) \<in> borel_measurable M" using f by auto
+ { fix f :: "'a \<Rightarrow> real" assume "f \<in> borel_measurable M"
+ { fix x assume *: "RN_deriv \<nu> x \<noteq> \<omega>"
+ have "Real (real (RN_deriv \<nu> x)) * Real (f x) = Real (real (RN_deriv \<nu> x) * f x)"
+ by (simp add: mult_le_0_iff)
+ then have "RN_deriv \<nu> x * Real (f x) = Real (real (RN_deriv \<nu> x) * f x)"
+ using * by (simp add: Real_real) }
+ note * = this
+ have "positive_integral (\<lambda>x. RN_deriv \<nu> x * Real (f x)) = positive_integral (\<lambda>x. Real (real (RN_deriv \<nu> x) * f x))"
+ apply (rule positive_integral_cong_AE)
+ apply (rule AE_mp[OF RN_deriv_finite[OF \<nu>]])
+ by (auto intro!: AE_cong simp: *) }
+ with this[OF f] this[OF f'] f f'
+ show ?integral ?integrable
+ unfolding \<nu>.integral_def integral_def \<nu>.integrable_def integrable_def
+ by (auto intro!: RN_deriv(1)[OF ms \<nu>(2)] minus_cong simp: RN_deriv_positive_integral[OF ms \<nu>(2)])
+qed
+
lemma (in sigma_finite_measure) RN_deriv_singleton:
assumes "measure_space M \<nu>"
and ac: "absolutely_continuous \<nu>"
--- a/src/HOL/Probability/Sigma_Algebra.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/Sigma_Algebra.thy Thu Dec 02 11:18:44 2010 -0800
@@ -23,7 +23,7 @@
sets :: "'a set set"
locale algebra =
- fixes M
+ fixes M :: "'a algebra"
assumes space_closed: "sets M \<subseteq> Pow (space M)"
and empty_sets [iff]: "{} \<in> sets M"
and compl_sets [intro]: "!!a. a \<in> sets M \<Longrightarrow> space M - a \<in> sets M"
@@ -110,13 +110,6 @@
assumes countable_nat_UN [intro]:
"!!A. range A \<subseteq> sets M \<Longrightarrow> (\<Union>i::nat. A i) \<in> sets M"
-lemma sigma_algebra_cong:
- fixes M :: "('a, 'b) algebra_scheme" and M' :: "('a, 'c) algebra_scheme"
- assumes *: "sigma_algebra M"
- and cong: "space M = space M'" "sets M = sets M'"
- shows "sigma_algebra M'"
-using * unfolding sigma_algebra_def algebra_def sigma_algebra_axioms_def unfolding cong .
-
lemma countable_UN_eq:
fixes A :: "'i::countable \<Rightarrow> 'a set"
shows "(range A \<subseteq> sets M \<longrightarrow> (\<Union>i. A i) \<in> sets M) \<longleftrightarrow>
@@ -222,15 +215,13 @@
| Compl: "a \<in> sigma_sets sp A \<Longrightarrow> sp - a \<in> sigma_sets sp A"
| Union: "(\<And>i::nat. a i \<in> sigma_sets sp A) \<Longrightarrow> (\<Union>i. a i) \<in> sigma_sets sp A"
+definition
+ "sigma M = (| space = space M, sets = sigma_sets (space M) (sets M) |)"
-definition
- sigma where
- "sigma sp A = (| space = sp, sets = sigma_sets sp A |)"
-
-lemma sets_sigma: "sets (sigma A B) = sigma_sets A B"
+lemma sets_sigma: "sets (sigma M) = sigma_sets (space M) (sets M)"
unfolding sigma_def by simp
-lemma space_sigma [simp]: "space (sigma X B) = X"
+lemma space_sigma [simp]: "space (sigma M) = space M"
by (simp add: sigma_def)
lemma sigma_sets_top: "sp \<in> sigma_sets sp A"
@@ -242,7 +233,7 @@
lemma sigma_sets_Un:
"a \<in> sigma_sets sp A \<Longrightarrow> b \<in> sigma_sets sp A \<Longrightarrow> a \<union> b \<in> sigma_sets sp A"
apply (simp add: Un_range_binary range_binary_eq)
-apply (rule Union, simp add: binary_def fun_upd_apply)
+apply (rule Union, simp add: binary_def)
done
lemma sigma_sets_Inter:
@@ -306,15 +297,34 @@
done
lemma sigma_algebra_sigma:
- "a \<subseteq> Pow X \<Longrightarrow> sigma_algebra (sigma X a)"
+ "sets M \<subseteq> Pow (space M) \<Longrightarrow> sigma_algebra (sigma M)"
apply (rule sigma_algebra_sigma_sets)
apply (auto simp add: sigma_def)
done
lemma (in sigma_algebra) sigma_subset:
- "a \<subseteq> sets M ==> sets (sigma (space M) a) \<subseteq> (sets M)"
+ "sets N \<subseteq> sets M \<Longrightarrow> space N = space M \<Longrightarrow> sets (sigma N) \<subseteq> (sets M)"
by (simp add: sigma_def sigma_sets_subset)
+lemma sigma_sets_least_sigma_algebra:
+ assumes "A \<subseteq> Pow S"
+ shows "sigma_sets S A = \<Inter>{B. A \<subseteq> B \<and> sigma_algebra \<lparr>space = S, sets = B\<rparr>}"
+proof safe
+ fix B X assume "A \<subseteq> B" and sa: "sigma_algebra \<lparr> space = S, sets = B \<rparr>"
+ and X: "X \<in> sigma_sets S A"
+ from sigma_algebra.sigma_sets_subset[OF sa, simplified, OF `A \<subseteq> B`] X
+ show "X \<in> B" by auto
+next
+ fix X assume "X \<in> \<Inter>{B. A \<subseteq> B \<and> sigma_algebra \<lparr>space = S, sets = B\<rparr>}"
+ then have [intro!]: "\<And>B. A \<subseteq> B \<Longrightarrow> sigma_algebra \<lparr>space = S, sets = B\<rparr> \<Longrightarrow> X \<in> B"
+ by simp
+ have "A \<subseteq> sigma_sets S A" using assms
+ by (auto intro!: sigma_sets.Basic)
+ moreover have "sigma_algebra \<lparr>space = S, sets = sigma_sets S A\<rparr>"
+ using assms by (intro sigma_algebra_sigma_sets[of A]) auto
+ ultimately show "X \<in> sigma_sets S A" by auto
+qed
+
lemma (in sigma_algebra) restriction_in_sets:
fixes A :: "nat \<Rightarrow> 'a set"
assumes "S \<in> sets M"
@@ -340,22 +350,81 @@
show "(\<Union>i. A i) \<in> sets (restricted_space S)" by simp
qed
+lemma sigma_sets_Int:
+ assumes "A \<in> sigma_sets sp st"
+ shows "op \<inter> A ` sigma_sets sp st = sigma_sets (A \<inter> sp) (op \<inter> A ` st)"
+proof (intro equalityI subsetI)
+ fix x assume "x \<in> op \<inter> A ` sigma_sets sp st"
+ then obtain y where "y \<in> sigma_sets sp st" "x = y \<inter> A" by auto
+ then show "x \<in> sigma_sets (A \<inter> sp) (op \<inter> A ` st)"
+ proof (induct arbitrary: x)
+ case (Compl a)
+ then show ?case
+ by (force intro!: sigma_sets.Compl simp: Diff_Int_distrib ac_simps)
+ next
+ case (Union a)
+ then show ?case
+ by (auto intro!: sigma_sets.Union
+ simp add: UN_extend_simps simp del: UN_simps)
+ qed (auto intro!: sigma_sets.intros)
+next
+ fix x assume "x \<in> sigma_sets (A \<inter> sp) (op \<inter> A ` st)"
+ then show "x \<in> op \<inter> A ` sigma_sets sp st"
+ proof induct
+ case (Compl a)
+ then obtain x where "a = A \<inter> x" "x \<in> sigma_sets sp st" by auto
+ then show ?case
+ by (force simp add: image_iff intro!: bexI[of _ "sp - x"] sigma_sets.Compl)
+ next
+ case (Union a)
+ then have "\<forall>i. \<exists>x. x \<in> sigma_sets sp st \<and> a i = A \<inter> x"
+ by (auto simp: image_iff Bex_def)
+ from choice[OF this] guess f ..
+ then show ?case
+ by (auto intro!: bexI[of _ "(\<Union>x. f x)"] sigma_sets.Union
+ simp add: image_iff)
+ qed (auto intro!: sigma_sets.intros)
+qed
+
+lemma sigma_sets_single[simp]: "sigma_sets {X} {{X}} = {{}, {X}}"
+proof (intro set_eqI iffI)
+ fix x assume "x \<in> sigma_sets {X} {{X}}"
+ from sigma_sets_into_sp[OF _ this]
+ show "x \<in> {{}, {X}}" by auto
+next
+ fix x assume "x \<in> {{}, {X}}"
+ then show "x \<in> sigma_sets {X} {{X}}"
+ by (auto intro: sigma_sets.Empty sigma_sets_top)
+qed
+
+lemma (in sigma_algebra) sets_sigma_subset:
+ assumes "space N = space M"
+ assumes "sets N \<subseteq> sets M"
+ shows "sets (sigma N) \<subseteq> sets M"
+ by (unfold assms sets_sigma, rule sigma_sets_subset, rule assms)
+
+lemma in_sigma[intro, simp]: "A \<in> sets M \<Longrightarrow> A \<in> sets (sigma M)"
+ unfolding sigma_def by (auto intro!: sigma_sets.Basic)
+
+lemma (in sigma_algebra) sigma_eq[simp]: "sigma M = M"
+ unfolding sigma_def sigma_sets_eq by simp
+
section {* Measurable functions *}
definition
"measurable A B = {f \<in> space A -> space B. \<forall>y \<in> sets B. f -` y \<inter> space A \<in> sets A}"
lemma (in sigma_algebra) measurable_sigma:
- assumes B: "B \<subseteq> Pow X"
- and f: "f \<in> space M -> X"
- and ba: "\<And>y. y \<in> B \<Longrightarrow> (f -` y) \<inter> space M \<in> sets M"
- shows "f \<in> measurable M (sigma X B)"
+ assumes B: "sets N \<subseteq> Pow (space N)"
+ and f: "f \<in> space M -> space N"
+ and ba: "\<And>y. y \<in> sets N \<Longrightarrow> (f -` y) \<inter> space M \<in> sets M"
+ shows "f \<in> measurable M (sigma N)"
proof -
- have "sigma_sets X B \<subseteq> {y . (f -` y) \<inter> space M \<in> sets M & y \<subseteq> X}"
+ have "sigma_sets (space N) (sets N) \<subseteq> {y . (f -` y) \<inter> space M \<in> sets M & y \<subseteq> space N}"
proof clarify
fix x
- assume "x \<in> sigma_sets X B"
- thus "f -` x \<inter> space M \<in> sets M \<and> x \<subseteq> X"
+ assume "x \<in> sigma_sets (space N) (sets N)"
+ thus "f -` x \<inter> space M \<in> sets M \<and> x \<subseteq> space N"
proof induct
case (Basic a)
thus ?case
@@ -366,15 +435,14 @@
by auto
next
case (Compl a)
- have [simp]: "f -` X \<inter> space M = space M"
+ have [simp]: "f -` space N \<inter> space M = space M"
by (auto simp add: funcset_mem [OF f])
thus ?case
by (auto simp add: vimage_Diff Diff_Int_distrib2 compl_sets Compl)
next
case (Union a)
thus ?case
- by (simp add: vimage_UN, simp only: UN_extend_simps(4))
- (blast intro: countable_UN)
+ by (simp add: vimage_UN, simp only: UN_extend_simps(4)) blast
qed
qed
thus ?thesis
@@ -397,7 +465,7 @@
unfolding measurable_def by auto
lemma (in sigma_algebra) measurable_subset:
- "(\<And>S. S \<in> sets A \<Longrightarrow> S \<subseteq> space A) \<Longrightarrow> measurable M A \<subseteq> measurable M (sigma (space A) (sets A))"
+ "(\<And>S. S \<in> sets A \<Longrightarrow> S \<subseteq> space A) \<Longrightarrow> measurable M A \<subseteq> measurable M (sigma A)"
by (auto intro: measurable_sigma measurable_sets measurable_space)
lemma measurable_eqI:
@@ -477,7 +545,7 @@
by (auto simp add: measurable_def)
lemma measurable_up_sigma:
- "measurable A M \<subseteq> measurable (sigma (space A) (sets A)) M"
+ "measurable A M \<subseteq> measurable (sigma A) M"
unfolding measurable_def
by (auto simp: sigma_def intro: sigma_sets.Basic)
@@ -495,32 +563,11 @@
\<Longrightarrow> f \<in> measurable M \<lparr>space = f ` space M, sets = Pow (f ` space M)\<rparr>"
by (simp add: measurable_def sigma_algebra_Pow) intro_locales
-lemma (in sigma_algebra) sigma_algebra_preimages:
- fixes f :: "'x \<Rightarrow> 'a"
- assumes "f \<in> A \<rightarrow> space M"
- shows "sigma_algebra \<lparr> space = A, sets = (\<lambda>M. f -` M \<inter> A) ` sets M \<rparr>"
- (is "sigma_algebra \<lparr> space = _, sets = ?F ` sets M \<rparr>")
-proof (simp add: sigma_algebra_iff2, safe)
- show "{} \<in> ?F ` sets M" by blast
-next
- fix S assume "S \<in> sets M"
- moreover have "A - ?F S = ?F (space M - S)"
- using assms by auto
- ultimately show "A - ?F S \<in> ?F ` sets M"
- by blast
-next
- fix S :: "nat \<Rightarrow> 'x set" assume *: "range S \<subseteq> ?F ` sets M"
- have "\<forall>i. \<exists>b. b \<in> sets M \<and> S i = ?F b"
- proof safe
- fix i
- have "S i \<in> ?F ` sets M" using * by auto
- then show "\<exists>b. b \<in> sets M \<and> S i = ?F b" by auto
- qed
- from choice[OF this] obtain b where b: "range b \<subseteq> sets M" "\<And>i. S i = ?F (b i)"
- by auto
- then have "(\<Union>i. S i) = ?F (\<Union>i. b i)" by auto
- then show "(\<Union>i. S i) \<in> ?F ` sets M" using b(1) by blast
-qed
+lemma (in sigma_algebra) measurable_iff_sigma:
+ assumes "sets E \<subseteq> Pow (space E)" and "f \<in> space M \<rightarrow> space E"
+ shows "f \<in> measurable M (sigma E) \<longleftrightarrow> (\<forall>A\<in>sets E. f -` A \<inter> space M \<in> sets M)"
+ using measurable_sigma[OF assms]
+ by (fastsimp simp: measurable_def sets_sigma intro: sigma_sets.intros)
section "Disjoint families"
@@ -544,6 +591,12 @@
"disjoint_family A \<Longrightarrow> (!!x. B x \<subseteq> A x) \<Longrightarrow> disjoint_family B"
by (force simp add: disjoint_family_on_def)
+lemma disjoint_family_on_bisimulation:
+ assumes "disjoint_family_on f S"
+ and "\<And>n m. n \<in> S \<Longrightarrow> m \<in> S \<Longrightarrow> n \<noteq> m \<Longrightarrow> f n \<inter> f m = {} \<Longrightarrow> g n \<inter> g m = {}"
+ shows "disjoint_family_on g S"
+ using assms unfolding disjoint_family_on_def by auto
+
lemma disjoint_family_on_mono:
"A \<subseteq> B \<Longrightarrow> disjoint_family_on f B \<Longrightarrow> disjoint_family_on f A"
unfolding disjoint_family_on_def by auto
@@ -661,38 +714,179 @@
"space (vimage_algebra S f) = S"
by (simp add: vimage_algebra_def)
+lemma (in sigma_algebra) sigma_algebra_preimages:
+ fixes f :: "'x \<Rightarrow> 'a"
+ assumes "f \<in> A \<rightarrow> space M"
+ shows "sigma_algebra \<lparr> space = A, sets = (\<lambda>M. f -` M \<inter> A) ` sets M \<rparr>"
+ (is "sigma_algebra \<lparr> space = _, sets = ?F ` sets M \<rparr>")
+proof (simp add: sigma_algebra_iff2, safe)
+ show "{} \<in> ?F ` sets M" by blast
+next
+ fix S assume "S \<in> sets M"
+ moreover have "A - ?F S = ?F (space M - S)"
+ using assms by auto
+ ultimately show "A - ?F S \<in> ?F ` sets M"
+ by blast
+next
+ fix S :: "nat \<Rightarrow> 'x set" assume *: "range S \<subseteq> ?F ` sets M"
+ have "\<forall>i. \<exists>b. b \<in> sets M \<and> S i = ?F b"
+ proof safe
+ fix i
+ have "S i \<in> ?F ` sets M" using * by auto
+ then show "\<exists>b. b \<in> sets M \<and> S i = ?F b" by auto
+ qed
+ from choice[OF this] obtain b where b: "range b \<subseteq> sets M" "\<And>i. S i = ?F (b i)"
+ by auto
+ then have "(\<Union>i. S i) = ?F (\<Union>i. b i)" by auto
+ then show "(\<Union>i. S i) \<in> ?F ` sets M" using b(1) by blast
+qed
+
lemma (in sigma_algebra) sigma_algebra_vimage:
fixes S :: "'c set" assumes "f \<in> S \<rightarrow> space M"
shows "sigma_algebra (vimage_algebra S f)"
-proof
- fix A assume "A \<in> sets (vimage_algebra S f)"
- then guess B unfolding in_vimage_algebra ..
- then show "space (vimage_algebra S f) - A \<in> sets (vimage_algebra S f)"
- using sets_into_space assms
- by (auto intro!: bexI[of _ "space M - B"])
-next
- fix A assume "A \<in> sets (vimage_algebra S f)"
- then guess A' unfolding in_vimage_algebra .. note A' = this
- fix B assume "B \<in> sets (vimage_algebra S f)"
- then guess B' unfolding in_vimage_algebra .. note B' = this
- then show "A \<union> B \<in> sets (vimage_algebra S f)"
- using sets_into_space assms A' B'
- by (auto intro!: bexI[of _ "A' \<union> B'"])
-next
- fix A::"nat \<Rightarrow> 'c set" assume "range A \<subseteq> sets (vimage_algebra S f)"
- then have "\<forall>i. \<exists>B. A i = f -` B \<inter> S \<and> B \<in> sets M"
- by (simp add: subset_eq) blast
- from this[THEN choice] obtain B
- where B: "\<And>i. A i = f -` B i \<inter> S" "range B \<subseteq> sets M" by auto
- show "(\<Union>i. A i) \<in> sets (vimage_algebra S f)"
- using B by (auto intro!: bexI[of _ "\<Union>i. B i"])
-qed auto
+proof -
+ from sigma_algebra_preimages[OF assms]
+ show ?thesis unfolding vimage_algebra_def by (auto simp: sigma_algebra_iff2)
+qed
lemma (in sigma_algebra) measurable_vimage_algebra:
fixes S :: "'c set" assumes "f \<in> S \<rightarrow> space M"
shows "f \<in> measurable (vimage_algebra S f) M"
unfolding measurable_def using assms by force
+lemma (in sigma_algebra) measurable_vimage:
+ fixes g :: "'a \<Rightarrow> 'c" and f :: "'d \<Rightarrow> 'a"
+ assumes "g \<in> measurable M M2" "f \<in> S \<rightarrow> space M"
+ shows "(\<lambda>x. g (f x)) \<in> measurable (vimage_algebra 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 (in sigma_algebra) vimage_vimage_inv:
+ assumes f: "bij_betw f S (space M)"
+ assumes [simp]: "\<And>x. x \<in> space M \<Longrightarrow> f (g x) = x" and g: "g \<in> space M \<rightarrow> S"
+ shows "sigma_algebra.vimage_algebra (vimage_algebra S f) (space M) g = M"
+proof -
+ interpret T: sigma_algebra "vimage_algebra S f"
+ using f by (safe intro!: sigma_algebra_vimage bij_betw_imp_funcset)
+
+ have inj: "inj_on f S" and [simp]: "f`S = space M"
+ using f unfolding bij_betw_def by auto
+
+ { fix A assume A: "A \<in> sets M"
+ have "g -` f -` A \<inter> g -` S \<inter> space M = (f \<circ> g) -` A \<inter> space M"
+ using g by auto
+ also have "\<dots> = A"
+ using `A \<in> sets M`[THEN sets_into_space] by auto
+ finally have "g -` f -` A \<inter> g -` S \<inter> space M = A" . }
+ note X = this
+ show ?thesis
+ unfolding T.vimage_algebra_def unfolding vimage_algebra_def
+ by (simp add: image_compose[symmetric] comp_def X cong: image_cong)
+qed
+
+lemma (in sigma_algebra) measurable_vimage_iff:
+ fixes f :: "'b \<Rightarrow> 'a" assumes f: "bij_betw f S (space M)"
+ shows "g \<in> measurable M M' \<longleftrightarrow> (g \<circ> f) \<in> measurable (vimage_algebra S f) M'"
+proof
+ assume "g \<in> measurable M M'"
+ from measurable_vimage[OF this f[THEN bij_betw_imp_funcset]]
+ show "(g \<circ> f) \<in> measurable (vimage_algebra S f) M'" unfolding comp_def .
+next
+ interpret v: sigma_algebra "vimage_algebra S f"
+ using f[THEN bij_betw_imp_funcset] by (rule sigma_algebra_vimage)
+ note f' = f[THEN bij_betw_the_inv_into]
+ assume "g \<circ> f \<in> measurable (vimage_algebra S f) M'"
+ from v.measurable_vimage[OF this, unfolded space_vimage_algebra, OF f'[THEN bij_betw_imp_funcset]]
+ show "g \<in> measurable M M'"
+ using f f'[THEN bij_betw_imp_funcset] f[unfolded bij_betw_def]
+ by (subst (asm) vimage_vimage_inv)
+ (simp_all add: f_the_inv_into_f cong: measurable_cong)
+qed
+
+lemma (in sigma_algebra) measurable_vimage_iff_inv:
+ fixes f :: "'b \<Rightarrow> 'a" assumes f: "bij_betw f S (space M)"
+ shows "g \<in> measurable (vimage_algebra S f) M' \<longleftrightarrow> (g \<circ> the_inv_into S f) \<in> measurable M M'"
+ unfolding measurable_vimage_iff[OF f]
+ using f[unfolded bij_betw_def]
+ by (auto intro!: measurable_cong simp add: the_inv_into_f_f)
+
+lemma sigma_sets_vimage:
+ assumes "f \<in> S' \<rightarrow> S" and "A \<subseteq> Pow S"
+ shows "sigma_sets S' ((\<lambda>X. f -` X \<inter> S') ` A) = (\<lambda>X. f -` X \<inter> S') ` sigma_sets S A"
+proof (intro set_eqI iffI)
+ let ?F = "\<lambda>X. f -` X \<inter> S'"
+ fix X assume "X \<in> sigma_sets S' (?F ` A)"
+ then show "X \<in> ?F ` sigma_sets S A"
+ proof induct
+ case (Basic X) then obtain X' where "X = ?F X'" "X' \<in> A"
+ by auto
+ then show ?case by (auto intro!: sigma_sets.Basic)
+ 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' \<in> sigma_sets S A"
+ by auto
+ then have "S - X' \<in> 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 "\<forall>i. \<exists>F'. F' \<in> sigma_sets S A \<and> F i = f -` F' \<inter> S'"
+ by (auto simp: image_iff Bex_def)
+ from choice[OF this] obtain F' where
+ "\<And>i. F' i \<in> sigma_sets S A" and "\<And>i. F i = f -` F' i \<inter> S'"
+ by auto
+ then show ?case
+ by (auto intro!: sigma_sets.Union image_eqI[where x="\<Union>i. F' i"])
+ qed
+next
+ let ?F = "\<lambda>X. f -` X \<inter> S'"
+ fix X assume "X \<in> ?F ` sigma_sets S A"
+ then obtain X' where "X' \<in> sigma_sets S A" "X = ?F X'" by auto
+ then show "X \<in> sigma_sets S' (?F ` A)"
+ proof (induct arbitrary: X)
+ case (Basic X') then show ?case by (auto intro: sigma_sets.Basic)
+ next
+ case Empty then show ?case by (auto intro: sigma_sets.Empty)
+ next
+ case (Compl X')
+ have "S' - (S' - X) \<in> 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 "(\<Union>i. f -` F i \<inter> S') \<in> sigma_sets S' (?F ` A)"
+ by (intro sigma_sets.Union Union.hyps) simp
+ also have "(\<Union>i. f -` F i \<inter> S') = X"
+ using assms Union by auto
+ finally show ?case .
+ qed
+qed
+
+lemma vimage_algebra_sigma:
+ assumes E: "sets E \<subseteq> Pow (space E)"
+ and f: "f \<in> space F \<rightarrow> space E"
+ and "\<And>A. A \<in> sets F \<Longrightarrow> A \<in> (\<lambda>X. f -` X \<inter> space F) ` sets E"
+ and "\<And>A. A \<in> sets E \<Longrightarrow> f -` A \<inter> space F \<in> sets F"
+ shows "sigma_algebra.vimage_algebra (sigma E) (space F) f = sigma F"
+proof -
+ interpret sigma_algebra "sigma E"
+ using assms by (intro sigma_algebra_sigma) auto
+ have eq: "sets F = (\<lambda>X. f -` X \<inter> space F) ` sets E"
+ using assms by auto
+ show "vimage_algebra (space F) f = sigma F"
+ unfolding vimage_algebra_def using assms
+ by (simp add: sigma_def eq sigma_sets_vimage)
+qed
+
section {* Conditional space *}
definition (in algebra)
@@ -981,4 +1175,267 @@
by blast
qed
+section {* Dynkin systems *}
+
+locale dynkin_system =
+ fixes M :: "'a algebra"
+ assumes space_closed: "sets M \<subseteq> Pow (space M)"
+ and space: "space M \<in> sets M"
+ and compl[intro!]: "\<And>A. A \<in> sets M \<Longrightarrow> space M - A \<in> sets M"
+ and UN[intro!]: "\<And>A. disjoint_family A \<Longrightarrow> range A \<subseteq> sets M
+ \<Longrightarrow> (\<Union>i::nat. A i) \<in> sets M"
+
+lemma (in dynkin_system) sets_into_space: "\<And> A. A \<in> sets M \<Longrightarrow> A \<subseteq> space M"
+ using space_closed by auto
+
+lemma (in dynkin_system) empty[intro, simp]: "{} \<in> sets M"
+ using space compl[of "space M"] by simp
+
+lemma (in dynkin_system) diff:
+ assumes sets: "D \<in> sets M" "E \<in> sets M" and "D \<subseteq> E"
+ shows "E - D \<in> sets M"
+proof -
+ let ?f = "\<lambda>x. if x = 0 then D else if x = Suc 0 then space M - E else {}"
+ have "range ?f = {D, space M - E, {}}"
+ by (auto simp: image_iff)
+ moreover have "D \<union> (space M - E) = (\<Union>i. ?f i)"
+ by (auto simp: image_iff split: split_if_asm)
+ moreover
+ then have "disjoint_family ?f" unfolding disjoint_family_on_def
+ using `D \<in> sets M`[THEN sets_into_space] `D \<subseteq> E` by auto
+ ultimately have "space M - (D \<union> (space M - E)) \<in> sets M"
+ using sets by auto
+ also have "space M - (D \<union> (space M - E)) = E - D"
+ using assms sets_into_space by auto
+ finally show ?thesis .
+qed
+
+lemma dynkin_systemI:
+ assumes "\<And> A. A \<in> sets M \<Longrightarrow> A \<subseteq> space M" "space M \<in> sets M"
+ assumes "\<And> A. A \<in> sets M \<Longrightarrow> space M - A \<in> sets M"
+ assumes "\<And> A. disjoint_family A \<Longrightarrow> range A \<subseteq> sets M
+ \<Longrightarrow> (\<Union>i::nat. A i) \<in> sets M"
+ shows "dynkin_system M"
+ using assms by (auto simp: dynkin_system_def)
+
+lemma dynkin_system_trivial:
+ shows "dynkin_system \<lparr> space = A, sets = Pow A \<rparr>"
+ by (rule dynkin_systemI) auto
+
+lemma sigma_algebra_imp_dynkin_system:
+ assumes "sigma_algebra M" shows "dynkin_system M"
+proof -
+ interpret sigma_algebra M by fact
+ show ?thesis using sets_into_space by (fastsimp intro!: dynkin_systemI)
+qed
+
+subsection "Intersection stable algebras"
+
+definition "Int_stable M \<longleftrightarrow> (\<forall> a \<in> sets M. \<forall> b \<in> sets M. a \<inter> b \<in> sets M)"
+
+lemma (in algebra) Int_stable: "Int_stable M"
+ unfolding Int_stable_def by auto
+
+lemma (in dynkin_system) sigma_algebra_eq_Int_stable:
+ "sigma_algebra M \<longleftrightarrow> Int_stable M"
+proof
+ assume "sigma_algebra M" then show "Int_stable M"
+ unfolding sigma_algebra_def using algebra.Int_stable by auto
+next
+ assume "Int_stable M"
+ show "sigma_algebra M"
+ unfolding sigma_algebra_disjoint_iff algebra_def
+ proof (intro conjI ballI allI impI)
+ show "sets M \<subseteq> Pow (space M)" using sets_into_space by auto
+ next
+ fix A B assume "A \<in> sets M" "B \<in> sets M"
+ then have "A \<union> B = space M - ((space M - A) \<inter> (space M - B))"
+ "space M - A \<in> sets M" "space M - B \<in> sets M"
+ using sets_into_space by auto
+ then show "A \<union> B \<in> sets M"
+ using `Int_stable M` unfolding Int_stable_def by auto
+ qed auto
+qed
+
+subsection "Smallest Dynkin systems"
+
+definition dynkin :: "'a algebra \<Rightarrow> 'a algebra" where
+ "dynkin M = \<lparr> space = space M,
+ sets = \<Inter>{D. dynkin_system \<lparr> space = space M, sets = D\<rparr> \<and> sets M \<subseteq> D}\<rparr>"
+
+lemma dynkin_system_dynkin:
+ fixes M :: "'a algebra"
+ assumes "sets M \<subseteq> Pow (space M)"
+ shows "dynkin_system (dynkin M)"
+proof (rule dynkin_systemI)
+ fix A assume "A \<in> sets (dynkin M)"
+ moreover
+ { fix D assume "A \<in> D" and d: "dynkin_system \<lparr> space = space M, sets = D \<rparr>"
+ from dynkin_system.sets_into_space[OF d] `A \<in> D`
+ have "A \<subseteq> space M" by auto }
+ moreover have "{D. dynkin_system \<lparr> space = space M, sets = D\<rparr> \<and> sets M \<subseteq> D} \<noteq> {}"
+ using assms dynkin_system_trivial by fastsimp
+ ultimately show "A \<subseteq> space (dynkin M)"
+ unfolding dynkin_def using assms
+ by simp (metis dynkin_system.sets_into_space in_mono mem_def)
+next
+ show "space (dynkin M) \<in> sets (dynkin M)"
+ unfolding dynkin_def using dynkin_system.space by fastsimp
+next
+ fix A assume "A \<in> sets (dynkin M)"
+ then show "space (dynkin M) - A \<in> sets (dynkin M)"
+ unfolding dynkin_def using dynkin_system.compl by force
+next
+ fix A :: "nat \<Rightarrow> 'a set"
+ assume A: "disjoint_family A" "range A \<subseteq> sets (dynkin M)"
+ show "(\<Union>i. A i) \<in> sets (dynkin M)" unfolding dynkin_def
+ proof (simp, safe)
+ fix D assume "dynkin_system \<lparr>space = space M, sets = D\<rparr>" "sets M \<subseteq> D"
+ with A have "(\<Union>i. A i) \<in> sets \<lparr>space = space M, sets = D\<rparr>"
+ by (intro dynkin_system.UN) (auto simp: dynkin_def)
+ then show "(\<Union>i. A i) \<in> D" by auto
+ qed
+qed
+
+lemma dynkin_Basic[intro]:
+ "A \<in> sets M \<Longrightarrow> A \<in> sets (dynkin M)"
+ unfolding dynkin_def by auto
+
+lemma dynkin_space[simp]:
+ "space (dynkin M) = space M"
+ unfolding dynkin_def by auto
+
+lemma (in dynkin_system) restricted_dynkin_system:
+ assumes "D \<in> sets M"
+ shows "dynkin_system \<lparr> space = space M,
+ sets = {Q. Q \<subseteq> space M \<and> Q \<inter> D \<in> sets M} \<rparr>"
+proof (rule dynkin_systemI, simp_all)
+ have "space M \<inter> D = D"
+ using `D \<in> sets M` sets_into_space by auto
+ then show "space M \<inter> D \<in> sets M"
+ using `D \<in> sets M` by auto
+next
+ fix A assume "A \<subseteq> space M \<and> A \<inter> D \<in> sets M"
+ moreover have "(space M - A) \<inter> D = (space M - (A \<inter> D)) - (space M - D)"
+ by auto
+ ultimately show "space M - A \<subseteq> space M \<and> (space M - A) \<inter> D \<in> sets M"
+ using `D \<in> sets M` by (auto intro: diff)
+next
+ fix A :: "nat \<Rightarrow> 'a set"
+ assume "disjoint_family A" "range A \<subseteq> {Q. Q \<subseteq> space M \<and> Q \<inter> D \<in> sets M}"
+ then have "\<And>i. A i \<subseteq> space M" "disjoint_family (\<lambda>i. A i \<inter> D)"
+ "range (\<lambda>i. A i \<inter> D) \<subseteq> sets M" "(\<Union>x. A x) \<inter> D = (\<Union>x. A x \<inter> D)"
+ by ((fastsimp simp: disjoint_family_on_def)+)
+ then show "(\<Union>x. A x) \<subseteq> space M \<and> (\<Union>x. A x) \<inter> D \<in> sets M"
+ by (auto simp del: UN_simps)
+qed
+
+lemma (in dynkin_system) dynkin_subset:
+ fixes N :: "'a algebra"
+ assumes "sets N \<subseteq> sets M"
+ assumes "space N = space M"
+ shows "sets (dynkin N) \<subseteq> sets M"
+proof -
+ have *: "\<lparr>space = space N, sets = sets M\<rparr> = M"
+ unfolding `space N = space M` by simp
+ have "dynkin_system M" by default
+ then have "dynkin_system \<lparr>space = space N, sets = sets M\<rparr>"
+ using assms unfolding * by simp
+ with `sets N \<subseteq> sets M` show ?thesis by (auto simp add: dynkin_def)
+qed
+
+lemma sigma_eq_dynkin:
+ fixes M :: "'a algebra"
+ assumes sets: "sets M \<subseteq> Pow (space M)"
+ assumes "Int_stable M"
+ shows "sigma M = dynkin M"
+proof -
+ have "sets (dynkin M) \<subseteq> sigma_sets (space M) (sets M)"
+ using sigma_algebra_imp_dynkin_system
+ unfolding dynkin_def sigma_def sigma_sets_least_sigma_algebra[OF sets] by auto
+ moreover
+ interpret dynkin_system "dynkin M"
+ using dynkin_system_dynkin[OF sets] .
+ have "sigma_algebra (dynkin M)"
+ unfolding sigma_algebra_eq_Int_stable Int_stable_def
+ proof (intro ballI)
+ fix A B assume "A \<in> sets (dynkin M)" "B \<in> sets (dynkin M)"
+ let "?D E" = "\<lparr> space = space M,
+ sets = {Q. Q \<subseteq> space M \<and> Q \<inter> E \<in> sets (dynkin M)} \<rparr>"
+ have "sets M \<subseteq> sets (?D B)"
+ proof
+ fix E assume "E \<in> sets M"
+ then have "sets M \<subseteq> sets (?D E)" "E \<in> sets (dynkin M)"
+ using sets_into_space `Int_stable M` by (auto simp: Int_stable_def)
+ then have "sets (dynkin M) \<subseteq> sets (?D E)"
+ using restricted_dynkin_system `E \<in> sets (dynkin M)`
+ by (intro dynkin_system.dynkin_subset) simp_all
+ then have "B \<in> sets (?D E)"
+ using `B \<in> sets (dynkin M)` by auto
+ then have "E \<inter> B \<in> sets (dynkin M)"
+ by (subst Int_commute) simp
+ then show "E \<in> sets (?D B)"
+ using sets `E \<in> sets M` by auto
+ qed
+ then have "sets (dynkin M) \<subseteq> sets (?D B)"
+ using restricted_dynkin_system `B \<in> sets (dynkin M)`
+ by (intro dynkin_system.dynkin_subset) simp_all
+ then show "A \<inter> B \<in> sets (dynkin M)"
+ using `A \<in> sets (dynkin M)` sets_into_space by auto
+ qed
+ from sigma_algebra.sigma_sets_subset[OF this, of "sets M"]
+ have "sigma_sets (space M) (sets M) \<subseteq> sets (dynkin M)" by auto
+ ultimately have "sigma_sets (space M) (sets M) = sets (dynkin M)" by auto
+ then show ?thesis
+ by (intro algebra.equality) (simp_all add: sigma_def)
+qed
+
+lemma (in dynkin_system) dynkin_idem:
+ "dynkin M = M"
+proof -
+ have "sets (dynkin M) = sets M"
+ proof
+ show "sets M \<subseteq> sets (dynkin M)"
+ using dynkin_Basic by auto
+ show "sets (dynkin M) \<subseteq> sets M"
+ by (intro dynkin_subset) auto
+ qed
+ then show ?thesis
+ by (auto intro!: algebra.equality)
+qed
+
+lemma (in dynkin_system) dynkin_lemma:
+ fixes E :: "'a algebra"
+ assumes "Int_stable E" and E: "sets E \<subseteq> sets M" "space E = space M"
+ and "sets M \<subseteq> sets (sigma E)"
+ shows "sigma E = M"
+proof -
+ have "sets E \<subseteq> Pow (space E)"
+ using E sets_into_space by auto
+ then have "sigma E = dynkin E"
+ using `Int_stable E` by (rule sigma_eq_dynkin)
+ moreover then have "sets (dynkin E) = sets M"
+ using assms dynkin_subset[OF E] by simp
+ ultimately show ?thesis
+ using E by simp
+qed
+
+locale finite_sigma_algebra = sigma_algebra +
+ assumes finite_space: "finite (space M)"
+ and sets_eq_Pow[simp]: "sets M = Pow (space M)"
+
+lemma (in finite_sigma_algebra) sets_image_space_eq_Pow:
+ "sets (image_space X) = Pow (space (image_space X))"
+proof safe
+ fix x S assume "S \<in> sets (image_space X)" "x \<in> S"
+ then show "x \<in> space (image_space X)"
+ using sets_into_space by (auto intro!: imageI simp: image_space_def)
+next
+ fix S assume "S \<subseteq> space (image_space X)"
+ then obtain S' where "S = X`S'" "S'\<in>sets M"
+ by (auto simp: subset_image_iff sets_eq_Pow image_space_def)
+ then show "S \<in> sets (image_space X)"
+ by (auto simp: image_space_def)
+qed
+
end
--- a/src/HOL/Probability/ex/Dining_Cryptographers.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Probability/ex/Dining_Cryptographers.thy Thu Dec 02 11:18:44 2010 -0800
@@ -2,12 +2,6 @@
imports Information
begin
-lemma finite_information_spaceI:
- "\<lbrakk> finite_measure_space M \<mu> ; \<mu> (space M) = 1 ; 1 < b \<rbrakk> \<Longrightarrow> finite_information_space M \<mu> b"
- unfolding finite_information_space_def finite_measure_space_def finite_measure_space_axioms_def
- finite_prob_space_def prob_space_def prob_space_axioms_def finite_information_space_axioms_def
- by auto
-
locale finite_space =
fixes S :: "'a set"
assumes finite[simp]: "finite S"
@@ -21,19 +15,17 @@
and sets_M[simp]: "sets M = Pow S"
by (simp_all add: M_def)
-sublocale finite_space \<subseteq> finite_information_space M \<mu> 2
-proof (rule finite_information_spaceI)
- let ?measure = "\<lambda>s::'a set. real (card s) / real (card S)"
+sublocale finite_space \<subseteq> finite_measure_space M \<mu>
+proof (rule finite_measure_spaceI)
+ fix A B :: "'a set" assume "A \<inter> B = {}" "A \<subseteq> space M" "B \<subseteq> space M"
+ then show "\<mu> (A \<union> B) = \<mu> A + \<mu> B"
+ by (simp add: inverse_eq_divide field_simps Real_real
+ divide_le_0_iff zero_le_divide_iff
+ card_Un_disjoint finite_subset[OF _ finite])
+qed auto
- show "finite_measure_space M \<mu>"
- proof (rule finite_measure_spaceI)
- fix A B :: "'a set" assume "A \<inter> B = {}" "A \<subseteq> space M" "B \<subseteq> space M"
- then show "\<mu> (A \<union> B) = \<mu> A + \<mu> B"
- by (simp add: inverse_eq_divide field_simps Real_real
- divide_le_0_iff zero_le_divide_iff
- card_Un_disjoint finite_subset[OF _ finite])
- qed auto
-qed simp_all
+sublocale finite_space \<subseteq> information_space M \<mu> 2
+ by default simp_all
lemma set_of_list_extend:
"{xs. length xs = Suc n \<and> (\<forall>x\<in>set xs. x \<in> A)} =
@@ -477,21 +469,19 @@
qed
notation (in dining_cryptographers_space)
- finite_mutual_information ("\<I>'( _ ; _ ')")
+ mutual_information_Pow ("\<I>'( _ ; _ ')")
notation (in dining_cryptographers_space)
- finite_entropy ("\<H>'( _ ')")
+ entropy_Pow ("\<H>'( _ ')")
notation (in dining_cryptographers_space)
- finite_conditional_entropy ("\<H>'( _ | _ ')")
+ conditional_entropy_Pow ("\<H>'( _ | _ ')")
theorem (in dining_cryptographers_space)
"\<I>( inversion ; payer ) = 0"
proof -
have n: "0 < n" using n_gt_3 by auto
-
have lists: "{xs. length xs = n} \<noteq> {}" using Ex_list_of_length by auto
-
have card_image_inversion:
"real (card (inversion ` dc_crypto)) = 2^n / 2"
unfolding card_image_inversion using `0 < n` by (cases n) auto
@@ -502,7 +492,7 @@
{ have "\<H>(inversion|payer) =
- (\<Sum>x\<in>inversion`dc_crypto. (\<Sum>z\<in>Some ` {0..<n}. real (?dIP {(x, z)}) * log 2 (real (?dIP {(x, z)}) / real (?dP {z}))))"
- unfolding conditional_entropy_eq
+ unfolding conditional_entropy_eq[OF simple_function_finite simple_function_finite]
by (simp add: image_payer_dc_crypto setsum_Sigma)
also have "... =
- (\<Sum>x\<in>inversion`dc_crypto. (\<Sum>z\<in>Some ` {0..<n}. 2 / (real n * 2^n) * (1 - real n)))"
@@ -538,7 +528,7 @@
finally have "\<H>(inversion|payer) = real n - 1" . }
moreover
{ have "\<H>(inversion) = - (\<Sum>x \<in> inversion`dc_crypto. real (?dI {x}) * log 2 (real (?dI {x})))"
- unfolding entropy_eq by simp
+ unfolding entropy_eq[OF simple_function_finite] by simp
also have "... = - (\<Sum>x \<in> inversion`dc_crypto. 2 * (1 - real n) / 2^n)"
unfolding neg_equal_iff_equal
proof (rule setsum_cong[OF refl])
@@ -556,7 +546,7 @@
finally have "\<H>(inversion) = real n - 1" .
}
ultimately show ?thesis
- unfolding mutual_information_eq_entropy_conditional_entropy
+ unfolding mutual_information_eq_entropy_conditional_entropy[OF simple_function_finite simple_function_finite]
by simp
qed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Probability/ex/Koepf_Duermuth_Countermeasure.thy Thu Dec 02 11:18:44 2010 -0800
@@ -0,0 +1,540 @@
+(* Author: Johannes Hoelzl, TU Muenchen *)
+
+header {* Formalization of a Countermeasure by Koepf & Duermuth 2009 *}
+
+theory Koepf_Duermuth_Countermeasure
+ imports Information Permutation
+begin
+
+lemma
+ fixes p u :: "'a \<Rightarrow> real"
+ assumes "1 < b"
+ assumes sum: "(\<Sum>i\<in>S. p i) = (\<Sum>i\<in>S. u i)"
+ and pos: "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> p i" "\<And>i. i \<in> S \<Longrightarrow> 0 \<le> u i"
+ and cont: "\<And>i. i \<in> S \<Longrightarrow> 0 < p i \<Longrightarrow> 0 < u i"
+ shows "(\<Sum>i\<in>S. p i * log b (u i)) \<le> (\<Sum>i\<in>S. p i * log b (p i))"
+proof -
+ have "(\<Sum>i\<in>S. p i * ln (u i) - p i * ln (p i)) \<le> (\<Sum>i\<in>S. u i - p i)"
+ proof (intro setsum_mono)
+ fix i assume [intro, simp]: "i \<in> S"
+ show "p i * ln (u i) - p i * ln (p i) \<le> u i - p i"
+ proof cases
+ assume "p i = 0" with pos[of i] show ?thesis by simp
+ next
+ assume "p i \<noteq> 0"
+ then have "0 < p i" "0 < u i" using pos[of i] cont[of i] by auto
+ then have *: "0 < u i / p i" by (blast intro: divide_pos_pos cont)
+ from `0 < p i` `0 < u i`
+ have "p i * ln (u i) - p i * ln (p i) = p i * ln (u i / p i)"
+ by (simp add: ln_div field_simps)
+ also have "\<dots> \<le> p i * (u i / p i - 1)"
+ using exp_ge_add_one_self[of "ln (u i / p i)"] pos[of i] exp_ln[OF *]
+ by (auto intro!: mult_left_mono)
+ also have "\<dots> = u i - p i"
+ using `p i \<noteq> 0` by (simp add: field_simps)
+ finally show ?thesis by simp
+ qed
+ qed
+ also have "\<dots> = 0" using sum by (simp add: setsum_subtractf)
+ finally show ?thesis using `1 < b` unfolding log_def setsum_subtractf
+ by (auto intro!: divide_right_mono
+ simp: times_divide_eq_right setsum_divide_distrib[symmetric])
+qed
+
+definition (in prob_space)
+ "ordered_variable_partition X = (SOME f. bij_betw f {0..<card (X`space M)} (X`space M) \<and>
+ (\<forall>i<card (X`space M). \<forall>j<card (X`space M). i \<le> j \<longrightarrow> distribution X {f i} \<le> distribution X {f j}))"
+
+lemma ex_ordered_bij_betw_nat_finite:
+ fixes order :: "nat \<Rightarrow> 'a\<Colon>linorder"
+ assumes "finite S"
+ shows "\<exists>f. bij_betw f {0..<card S} S \<and> (\<forall>i<card S. \<forall>j<card S. i \<le> j \<longrightarrow> order (f i) \<le> order (f j))"
+proof -
+ from ex_bij_betw_nat_finite [OF `finite S`] guess f .. note f = this
+ let ?xs = "sort_key order (map f [0 ..< card S])"
+
+ have "?xs <~~> map f [0 ..< card S]"
+ unfolding multiset_of_eq_perm[symmetric] by (rule multiset_of_sort)
+ from permutation_Ex_bij [OF this]
+ obtain g where g: "bij_betw g {0..<card S} {0..<card S}" and
+ map: "\<And>i. i<card S \<Longrightarrow> ?xs ! i = map f [0 ..< card S] ! g i"
+ by (auto simp: atLeast0LessThan)
+
+ { fix i assume "i < card S"
+ then have "g i < card S" using g by (auto simp: bij_betw_def)
+ with map [OF `i < card S`] have "f (g i) = ?xs ! i" by simp }
+ note this[simp]
+
+ show ?thesis
+ proof (intro exI allI conjI impI)
+ show "bij_betw (f\<circ>g) {0..<card S} S"
+ using g f by (rule bij_betw_trans)
+ fix i j assume [simp]: "i < card S" "j < card S" "i \<le> j"
+ from sorted_nth_mono[of "map order ?xs" i j]
+ show "order ((f\<circ>g) i) \<le> order ((f\<circ>g) j)" by simp
+ qed
+qed
+
+lemma (in prob_space)
+ assumes "finite (X`space M)"
+ shows "bij_betw (ordered_variable_partition X) {0..<card (X`space M)} (X`space M)"
+ and "\<And>i j. \<lbrakk> i < card (X`space M) ; j < card (X`space M) ; i \<le> j \<rbrakk> \<Longrightarrow>
+ distribution X {ordered_variable_partition X i} \<le> distribution X {ordered_variable_partition X j}"
+proof -
+
+qed
+
+definition (in prob_space)
+ "order_distribution X i = real (distribution X {ordered_variable_partition X i})"
+
+definition (in prob_space)
+ "guessing_entropy b X = (\<Sum>i<card(X`space M). real i * log b (order_distribution X i))"
+
+abbreviation (in finite_information_space)
+ finite_guessing_entropy ("\<G>'(_')") where
+ "\<G>(X) \<equiv> guessing_entropy b X"
+
+
+
+lemma zero_notin_Suc_image[simp]: "0 \<notin> Suc ` A"
+ by auto
+
+definition extensional :: "'b \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'b) set" where
+ "extensional d A = {f. \<forall>x. x \<notin> A \<longrightarrow> f x = d}"
+
+lemma extensional_empty[simp]: "extensional d {} = {\<lambda>x. d}"
+ unfolding extensional_def by (simp add: expand_set_eq expand_fun_eq)
+
+lemma funset_eq_UN_fun_upd_I:
+ assumes *: "\<And>f. f \<in> F (insert a A) \<Longrightarrow> f(a := d) \<in> F A"
+ and **: "\<And>f. f \<in> F (insert a A) \<Longrightarrow> f a \<in> G (f(a:=d))"
+ and ***: "\<And>f x. \<lbrakk> f \<in> F A ; x \<in> G f \<rbrakk> \<Longrightarrow> f(a:=x) \<in> F (insert a A)"
+ shows "F (insert a A) = (\<Union>f\<in>F A. fun_upd f a ` (G f))"
+proof safe
+ fix f assume f: "f \<in> F (insert a A)"
+ show "f \<in> (\<Union>f\<in>F A. fun_upd f a ` G f)"
+ proof (rule UN_I[of "f(a := d)"])
+ show "f(a := d) \<in> F A" using *[OF f] .
+ show "f \<in> fun_upd (f(a:=d)) a ` G (f(a:=d))"
+ proof (rule image_eqI[of _ _ "f a"])
+ show "f a \<in> G (f(a := d))" using **[OF f] .
+ qed simp
+ qed
+next
+ fix f x assume "f \<in> F A" "x \<in> G f"
+ from ***[OF this] show "f(a := x) \<in> F (insert a A)" .
+qed
+
+lemma extensional_insert[simp]:
+ assumes "a \<notin> A"
+ shows "extensional d (insert a A) \<inter> (insert a A \<rightarrow> B) = (\<Union>f \<in> extensional d A \<inter> (A \<rightarrow> B). (\<lambda>b. f(a := b)) ` B)"
+ apply (rule funset_eq_UN_fun_upd_I)
+ using assms
+ by (auto intro!: inj_onI dest: inj_onD split: split_if_asm simp: extensional_def)
+
+lemma finite_extensional_funcset[simp, intro]:
+ assumes "finite A" "finite B"
+ shows "finite (extensional d A \<inter> (A \<rightarrow> B))"
+ using assms by induct auto
+
+lemma fun_upd_eq_iff: "f(a := b) = g(a := b') \<longleftrightarrow> b = b' \<and> f(a := d) = g(a := d)"
+ by (auto simp: expand_fun_eq)
+
+lemma card_funcset:
+ assumes "finite A" "finite B"
+ shows "card (extensional d A \<inter> (A \<rightarrow> B)) = card B ^ card A"
+using `finite A` proof induct
+ case (insert a A) thus ?case unfolding extensional_insert[OF `a \<notin> A`]
+ proof (subst card_UN_disjoint, safe, simp_all)
+ show "finite (extensional d A \<inter> (A \<rightarrow> B))" "\<And>f. finite (fun_upd f a ` B)"
+ using `finite B` `finite A` by simp_all
+ next
+ fix f g b b' assume "f \<noteq> g" and eq: "f(a := b) = g(a := b')" and
+ ext: "f \<in> extensional d A" "g \<in> extensional d A"
+ have "f a = d" "g a = d"
+ using ext `a \<notin> A` by (auto simp add: extensional_def)
+ with `f \<noteq> g` eq show False unfolding fun_upd_eq_iff[of _ _ b _ _ d]
+ by (auto simp: fun_upd_idem fun_upd_eq_iff)
+ next
+ { fix f assume "f \<in> extensional d A \<inter> (A \<rightarrow> B)"
+ have "card (fun_upd f a ` B) = card B"
+ proof (auto intro!: card_image inj_onI)
+ fix b b' assume "f(a := b) = f(a := b')"
+ from fun_upd_eq_iff[THEN iffD1, OF this] show "b = b'" by simp
+ qed }
+ then show "(\<Sum>i\<in>extensional d A \<inter> (A \<rightarrow> B). card (fun_upd i a ` B)) = card B * card B ^ card A"
+ using insert by simp
+ qed
+qed simp
+
+lemma set_of_list_extend:
+ "{xs. length xs = Suc n \<and> (\<forall>x\<in>set xs. x \<in> A)} =
+ (\<lambda>(xs, n). n#xs) ` ({xs. length xs = n \<and> (\<forall>x\<in>set xs. x \<in> A)} \<times> A)"
+ by (auto simp: length_Suc_conv)
+
+lemma
+ assumes "finite A"
+ shows finite_lists:
+ "finite {xs. length xs = n \<and> (\<forall>x\<in>set xs. x \<in> A)}" (is "finite (?lists n)")
+ and card_list_length:
+ "card {xs. length xs = n \<and> (\<forall>x\<in>set xs. x \<in> A)} = (card A)^n"
+proof -
+ from `finite A`
+ have "(card {xs. length xs = n \<and> (\<forall>x\<in>set xs. x \<in> A)} = (card A)^n) \<and>
+ finite {xs. length xs = n \<and> (\<forall>x\<in>set xs. x \<in> A)}"
+ proof (induct n)
+ case (Suc n)
+ moreover note set_of_list_extend[of n A]
+ moreover have "inj_on (\<lambda>(xs, n). n#xs) (?lists n \<times> A)"
+ by (auto intro!: inj_onI)
+ ultimately show ?case using assms by (auto simp: card_image)
+ qed (simp cong: conj_cong)
+ then show "finite (?lists n)" "card (?lists n) = card A ^ n"
+ by auto
+qed
+
+locale finite_information =
+ fixes \<Omega> :: "'a set"
+ and p :: "'a \<Rightarrow> real"
+ and b :: real
+ assumes finite_space[simp, intro]: "finite \<Omega>"
+ and p_sums_1[simp]: "(\<Sum>\<omega>\<in>\<Omega>. p \<omega>) = 1"
+ and positive_p[simp, intro]: "\<And>x. 0 \<le> p x"
+ and b_gt_1[simp, intro]: "1 < b"
+
+lemma (in finite_information) positive_p_sum[simp]: "0 \<le> setsum p X"
+ by (auto intro!: setsum_nonneg)
+
+sublocale finite_information \<subseteq> finite_information_space "\<lparr> space = \<Omega>, sets = Pow \<Omega> \<rparr>" "\<lambda>S. Real (setsum p S)" b
+proof -
+ show "finite_information_space \<lparr> space = \<Omega>, sets = Pow \<Omega> \<rparr> (\<lambda>S. Real (setsum p S)) b"
+ unfolding finite_information_space_def finite_information_space_axioms_def
+ unfolding finite_prob_space_def prob_space_def prob_space_axioms_def
+ unfolding finite_measure_space_def finite_measure_space_axioms_def
+ by (force intro!: sigma_algebra.finite_additivity_sufficient
+ simp: additive_def sigma_algebra_Pow positive_def Real_eq_Real
+ setsum.union_disjoint finite_subset)
+qed
+
+lemma (in prob_space) prob_space_subalgebra:
+ assumes "N \<subseteq> sets M" "sigma_algebra (M\<lparr> sets := N \<rparr>)"
+ shows "prob_space (M\<lparr> sets := N \<rparr>) \<mu>" sorry
+
+lemma (in measure_space) measure_space_subalgebra:
+ assumes "N \<subseteq> sets M" "sigma_algebra (M\<lparr> sets := N \<rparr>)"
+ shows "measure_space (M\<lparr> sets := N \<rparr>) \<mu>" sorry
+
+locale koepf_duermuth = K: finite_information keys K b + M: finite_information messages M b
+ for b :: real
+ and keys :: "'key set" and K :: "'key \<Rightarrow> real"
+ and messages :: "'message set" and M :: "'message \<Rightarrow> real" +
+ fixes observe :: "'key \<Rightarrow> 'message \<Rightarrow> 'observation"
+ and n :: nat
+begin
+
+definition msgs :: "('key \<times> 'message list) set" where
+ "msgs = keys \<times> {ms. length ms = n \<and> (\<forall>M\<in>set ms. M \<in> messages)}"
+
+definition P :: "('key \<times> 'message list) \<Rightarrow> real" where
+ "P = (\<lambda>(k, ms). K k * (\<Prod>i<length ms. M (ms ! i)))"
+
+end
+
+sublocale koepf_duermuth \<subseteq> finite_information msgs P b
+proof default
+ show "finite msgs" unfolding msgs_def
+ using finite_lists[OF M.finite_space, of n]
+ by auto
+
+ have [simp]: "\<And>A. inj_on (\<lambda>(xs, n). n # xs) A" by (force intro!: inj_onI)
+
+ note setsum_right_distrib[symmetric, simp]
+ note setsum_left_distrib[symmetric, simp]
+ note setsum_cartesian_product'[simp]
+
+ have "(\<Sum>ms | length ms = n \<and> (\<forall>M\<in>set ms. M \<in> messages). \<Prod>x<length ms. M (ms ! x)) = 1"
+ proof (induct n)
+ case 0 then show ?case by (simp cong: conj_cong)
+ next
+ case (Suc n)
+ then show ?case
+ by (simp add: comp_def set_of_list_extend
+ lessThan_eq_Suc_image setsum_reindex setprod_reindex)
+ qed
+ then show "setsum P msgs = 1"
+ unfolding msgs_def P_def by simp
+
+ fix x
+ have "\<And> A f. 0 \<le> (\<Prod>x\<in>A. M (f x))" by (auto simp: setprod_nonneg)
+ then show "0 \<le> P x"
+ unfolding P_def by (auto split: prod.split simp: zero_le_mult_iff)
+qed auto
+
+lemma SIGMA_image_vimage:
+ "snd ` (SIGMA x:f`X. f -` {x} \<inter> X) = X"
+ by (auto simp: image_iff)
+
+lemma zero_le_eq_True: "0 \<le> (x::pinfreal) \<longleftrightarrow> True" by simp
+
+lemma Real_setprod:
+ assumes"\<And>i. i\<in>X \<Longrightarrow> 0 \<le> f i"
+ shows "(\<Prod>i\<in>X. Real (f i)) = Real (\<Prod>i\<in>X. f i)"
+proof cases
+ assume "finite X"
+ from this assms show ?thesis by induct (auto simp: mult_le_0_iff)
+qed simp
+
+lemma inj_Cons[simp]: "\<And>X. inj_on (\<lambda>(xs, x). x#xs) X" by (auto intro!: inj_onI)
+
+lemma setprod_setsum_distrib_lists:
+ fixes P and S :: "'a set" and f :: "'a \<Rightarrow> _::semiring_0" assumes "finite S"
+ shows "(\<Sum>ms\<in>{ms. length ms = n \<and> set ms \<subseteq> S \<and> (\<forall>i<n. P i (ms!i))}. \<Prod>x<n. f (ms ! x)) =
+ (\<Prod>i<n. \<Sum>m\<in>{m\<in>S. P i m}. f m)"
+proof (induct n arbitrary: P)
+ case 0 then show ?case by (simp cong: conj_cong)
+next
+ case (Suc n)
+ have *: "{ms. length ms = Suc n \<and> set ms \<subseteq> S \<and> (\<forall>i<Suc n. P i (ms ! i))} =
+ (\<lambda>(xs, x). x#xs) ` ({ms. length ms = n \<and> set ms \<subseteq> S \<and> (\<forall>i<n. P (Suc i) (ms ! i))} \<times> {m\<in>S. P 0 m})"
+ apply (auto simp: image_iff length_Suc_conv)
+ apply force+
+ apply (case_tac i)
+ by force+
+ show ?case unfolding *
+ using Suc[of "\<lambda>i. P (Suc i)"]
+ by (simp add: setsum_reindex split_conv setsum_cartesian_product'
+ lessThan_eq_Suc_image setprod_reindex setsum_left_distrib[symmetric] setsum_right_distrib[symmetric])
+qed
+
+context koepf_duermuth
+begin
+
+definition observations :: "'observation set" where
+ "observations = (\<Union>f\<in>observe ` keys. f ` messages)"
+
+lemma finite_observations[simp, intro]: "finite observations"
+ unfolding observations_def by auto
+
+definition OB :: "'key \<times> 'message list \<Rightarrow> 'observation list" where
+ "OB = (\<lambda>(k, ms). map (observe k) ms)"
+
+definition t :: "'observation list \<Rightarrow> 'observation \<Rightarrow> nat" where
+ "t seq obs = length (filter (op = obs) seq)"
+
+lemma card_T_bound: "card ((t\<circ>OB)`msgs) \<le> (n+1)^card observations"
+proof -
+ have "(t\<circ>OB)`msgs \<subseteq> extensional 0 observations \<inter> (observations \<rightarrow> {.. n})"
+ unfolding observations_def extensional_def OB_def msgs_def
+ by (auto simp add: t_def comp_def image_iff)
+ with finite_extensional_funcset
+ have "card ((t\<circ>OB)`msgs) \<le> card (extensional 0 observations \<inter> (observations \<rightarrow> {.. n}))"
+ by (rule card_mono) auto
+ also have "\<dots> = (n + 1) ^ card observations"
+ by (subst card_funcset) auto
+ finally show ?thesis .
+qed
+
+abbreviation
+ "p A \<equiv> setsum P A"
+
+abbreviation probability ("\<P>'(_') _") where
+ "\<P>(X) x \<equiv> real (distribution X x)"
+
+abbreviation joint_probability ("\<P>'(_, _') _") where
+ "\<P>(X, Y) x \<equiv> real (joint_distribution X Y x)"
+
+abbreviation conditional_probability ("\<P>'(_|_') _") where
+ "\<P>(X|Y) x \<equiv> \<P>(X, Y) x / \<P>(Y) (snd`x)"
+
+notation
+ finite_entropy ("\<H>'( _ ')")
+
+notation
+ finite_conditional_entropy ("\<H>'( _ | _ ')")
+
+notation
+ finite_mutual_information ("\<I>'( _ ; _ ')")
+
+lemma t_eq_imp_bij_func:
+ assumes "t xs = t ys"
+ shows "\<exists>f. bij_betw f {..<length xs} {..<length ys} \<and> (\<forall>i<length xs. xs ! i = ys ! (f i))"
+proof -
+ have "count (multiset_of xs) = count (multiset_of ys)"
+ using assms by (simp add: expand_fun_eq count_multiset_of t_def)
+ then have "xs <~~> ys" unfolding multiset_of_eq_perm count_inject .
+ then show ?thesis by (rule permutation_Ex_func)
+qed
+
+lemma \<P>_k: assumes "k \<in> keys" shows "\<P>(fst) {k} = K k"
+proof -
+ from assms have *:
+ "fst -` {k} \<inter> msgs = {k}\<times>{ms. length ms = n \<and> (\<forall>M\<in>set ms. M \<in> messages)}"
+ unfolding msgs_def by auto
+ show "\<P>(fst) {k} = K k" unfolding distribution_def
+ apply (simp add: *) unfolding P_def
+ apply (simp add: setsum_cartesian_product')
+ using setprod_setsum_distrib_lists[OF M.finite_space, of M n "\<lambda>x x. True"]
+ by (simp add: setsum_right_distrib[symmetric] subset_eq setprod_1)
+qed
+
+lemma fst_image_msgs[simp]: "fst`msgs = keys"
+proof -
+ from M.not_empty obtain m where "m \<in> messages" by auto
+ then have *: "{m. length m = n \<and> (\<forall>x\<in>set m. x\<in>messages)} \<noteq> {}"
+ by (auto intro!: exI[of _ "replicate n m"])
+ then show ?thesis
+ unfolding msgs_def fst_image_times if_not_P[OF *] by simp
+qed
+
+lemma ce_OB_eq_ce_t: "\<H>(fst | OB) = \<H>(fst | t\<circ>OB)"
+proof -
+ txt {* Lemma 2 *}
+
+ { fix k obs obs'
+ assume "k \<in> keys" "K k \<noteq> 0" and obs': "obs' \<in> OB ` msgs" and obs: "obs \<in> OB ` msgs"
+ assume "t obs = t obs'"
+ from t_eq_imp_bij_func[OF this]
+ obtain t_f where "bij_betw t_f {..<n} {..<n}" and
+ obs_t_f: "\<And>i. i<n \<Longrightarrow> obs!i = obs' ! t_f i"
+ using obs obs' unfolding OB_def msgs_def by auto
+ then have t_f: "inj_on t_f {..<n}" "{..<n} = t_f`{..<n}" unfolding bij_betw_def by auto
+
+ { fix obs assume "obs \<in> OB`msgs"
+ then have **: "\<And>ms. length ms = n \<Longrightarrow> OB (k, ms) = obs \<longleftrightarrow> (\<forall>i<n. observe k (ms!i) = obs ! i)"
+ unfolding OB_def msgs_def by (simp add: image_iff list_eq_iff_nth_eq)
+
+ have "\<P>(OB, fst) {(obs, k)} / K k =
+ p ({k}\<times>{ms. (k,ms) \<in> msgs \<and> OB (k,ms) = obs}) / K k"
+ unfolding distribution_def by (auto intro!: arg_cong[where f=p])
+ also have "\<dots> =
+ (\<Prod>i<n. \<Sum>m\<in>{m\<in>messages. observe k m = obs ! i}. M m)"
+ unfolding P_def using `K k \<noteq> 0` `k \<in> keys`
+ apply (simp add: setsum_cartesian_product' setsum_divide_distrib msgs_def ** cong: conj_cong)
+ apply (subst setprod_setsum_distrib_lists[OF M.finite_space, unfolded subset_eq]) ..
+ finally have "\<P>(OB, fst) {(obs, k)} / K k =
+ (\<Prod>i<n. \<Sum>m\<in>{m\<in>messages. observe k m = obs ! i}. M m)" . }
+ note * = this
+
+ have "\<P>(OB, fst) {(obs, k)} / K k = \<P>(OB, fst) {(obs', k)} / K k"
+ unfolding *[OF obs] *[OF obs']
+ using t_f(1) obs_t_f by (subst (2) t_f(2)) (simp add: setprod_reindex)
+ then have "\<P>(OB, fst) {(obs, k)} = \<P>(OB, fst) {(obs', k)}"
+ using `K k \<noteq> 0` by auto }
+ note t_eq_imp = this
+
+ let "?S obs" = "t -`{t obs} \<inter> OB`msgs"
+ { fix k obs assume "k \<in> keys" "K k \<noteq> 0" and obs: "obs \<in> OB`msgs"
+ have *: "((\<lambda>x. (t (OB x), fst x)) -` {(t obs, k)} \<inter> msgs) =
+ (\<Union>obs'\<in>?S obs. ((\<lambda>x. (OB x, fst x)) -` {(obs', k)} \<inter> msgs))" by auto
+ have df: "disjoint_family_on (\<lambda>obs'. (\<lambda>x. (OB x, fst x)) -` {(obs', k)} \<inter> msgs) (?S obs)"
+ unfolding disjoint_family_on_def by auto
+ have "\<P>(t\<circ>OB, fst) {(t obs, k)} = (\<Sum>obs'\<in>?S obs. \<P>(OB, fst) {(obs', k)})"
+ unfolding distribution_def comp_def
+ using real_finite_measure_finite_Union[OF _ df]
+ by (force simp add: * intro!: setsum_nonneg)
+ also have "(\<Sum>obs'\<in>?S obs. \<P>(OB, fst) {(obs', k)}) = real (card (?S obs)) * \<P>(OB, fst) {(obs, k)}"
+ by (simp add: t_eq_imp[OF `k \<in> keys` `K k \<noteq> 0` obs] real_eq_of_nat)
+ finally have "\<P>(t\<circ>OB, fst) {(t obs, k)} = real (card (?S obs)) * \<P>(OB, fst) {(obs, k)}" .}
+ note P_t_eq_P_OB = this
+
+ { fix k obs assume "k \<in> keys" and obs: "obs \<in> OB`msgs"
+ have "\<P>(t\<circ>OB | fst) {(t obs, k)} =
+ real (card (t -` {t obs} \<inter> OB ` msgs)) * \<P>(OB | fst) {(obs, k)}"
+ using \<P>_k[OF `k \<in> keys`] P_t_eq_P_OB[OF `k \<in> keys` _ obs] by auto }
+ note CP_t_K = this
+
+ { fix k obs assume "k \<in> keys" and obs: "obs \<in> OB`msgs"
+ then have "t -`{t obs} \<inter> OB`msgs \<noteq> {}" (is "?S \<noteq> {}") by auto
+ then have "real (card ?S) \<noteq> 0" by auto
+
+ have "\<P>(fst | t\<circ>OB) {(k, t obs)} = \<P>(t\<circ>OB | fst) {(t obs, k)} * \<P>(fst) {k} / \<P>(t\<circ>OB) {t obs}"
+ using real_distribution_order'[of fst k "t\<circ>OB" "t obs"]
+ by (subst joint_distribution_commute) auto
+ also have "\<P>(t\<circ>OB) {t obs} = (\<Sum>k'\<in>keys. \<P>(t\<circ>OB|fst) {(t obs, k')} * \<P>(fst) {k'})"
+ using setsum_real_distribution(2)[of "t\<circ>OB" fst "t obs", symmetric]
+ using real_distribution_order'[of fst _ "t\<circ>OB" "t obs"] by (auto intro!: setsum_cong)
+ also have "\<P>(t\<circ>OB | fst) {(t obs, k)} * \<P>(fst) {k} / (\<Sum>k'\<in>keys. \<P>(t\<circ>OB|fst) {(t obs, k')} * \<P>(fst) {k'}) =
+ \<P>(OB | fst) {(obs, k)} * \<P>(fst) {k} / (\<Sum>k'\<in>keys. \<P>(OB|fst) {(obs, k')} * \<P>(fst) {k'})"
+ using CP_t_K[OF `k\<in>keys` obs] CP_t_K[OF _ obs] `real (card ?S) \<noteq> 0`
+ by (simp only: setsum_right_distrib[symmetric] ac_simps
+ mult_divide_mult_cancel_left[OF `real (card ?S) \<noteq> 0`]
+ cong: setsum_cong)
+ also have "(\<Sum>k'\<in>keys. \<P>(OB|fst) {(obs, k')} * \<P>(fst) {k'}) = \<P>(OB) {obs}"
+ using setsum_real_distribution(2)[of OB fst obs, symmetric]
+ using real_distribution_order'[of fst _ OB obs] by (auto intro!: setsum_cong)
+ also have "\<P>(OB | fst) {(obs, k)} * \<P>(fst) {k} / \<P>(OB) {obs} = \<P>(fst | OB) {(k, obs)}"
+ using real_distribution_order'[of fst k OB obs]
+ by (subst joint_distribution_commute) auto
+ finally have "\<P>(fst | t\<circ>OB) {(k, t obs)} = \<P>(fst | OB) {(k, obs)}" . }
+ note CP_T_eq_CP_O = this
+
+ let "?H obs" = "(\<Sum>k\<in>keys. \<P>(fst|OB) {(k, obs)} * log b (\<P>(fst|OB) {(k, obs)})) :: real"
+ let "?Ht obs" = "(\<Sum>k\<in>keys. \<P>(fst|t\<circ>OB) {(k, obs)} * log b (\<P>(fst|t\<circ>OB) {(k, obs)})) :: real"
+
+ note [[simproc del: finite_information_space.mult_log]]
+
+ { fix obs assume obs: "obs \<in> OB`msgs"
+ have "?H obs = (\<Sum>k\<in>keys. \<P>(fst|t\<circ>OB) {(k, t obs)} * log b (\<P>(fst|t\<circ>OB) {(k, t obs)}))"
+ using CP_T_eq_CP_O[OF _ obs]
+ by simp
+ then have "?H obs = ?Ht (t obs)" . }
+ note * = this
+
+ have **: "\<And>x f A. (\<Sum>y\<in>t-`{x}\<inter>A. f y (t y)) = (\<Sum>y\<in>t-`{x}\<inter>A. f y x)" by auto
+
+ { fix x
+ have *: "(\<lambda>x. t (OB x)) -` {t (OB x)} \<inter> msgs =
+ (\<Union>obs\<in>?S (OB x). OB -` {obs} \<inter> msgs)" by auto
+ have df: "disjoint_family_on (\<lambda>obs. OB -` {obs} \<inter> msgs) (?S (OB x))"
+ unfolding disjoint_family_on_def by auto
+ have "\<P>(t\<circ>OB) {t (OB x)} = (\<Sum>obs\<in>?S (OB x). \<P>(OB) {obs})"
+ unfolding distribution_def comp_def
+ using real_finite_measure_finite_Union[OF _ df]
+ by (force simp add: * intro!: setsum_nonneg) }
+ note P_t_sum_P_O = this
+
+ txt {* Lemma 3 *}
+ have "\<H>(fst | OB) = -(\<Sum>obs\<in>OB`msgs. \<P>(OB) {obs} * ?Ht (t obs))"
+ unfolding conditional_entropy_eq_ce_with_hypothesis using * by simp
+ also have "\<dots> = -(\<Sum>obs\<in>t`OB`msgs. \<P>(t\<circ>OB) {obs} * ?Ht obs)"
+ apply (subst SIGMA_image_vimage[symmetric, of "OB`msgs" t])
+ apply (subst setsum_reindex)
+ apply (fastsimp intro!: inj_onI)
+ apply simp
+ apply (subst setsum_Sigma[symmetric, unfolded split_def])
+ using finite_space apply fastsimp
+ using finite_space apply fastsimp
+ apply (safe intro!: setsum_cong)
+ using P_t_sum_P_O
+ by (simp add: setsum_divide_distrib[symmetric] field_simps **
+ setsum_right_distrib[symmetric] setsum_left_distrib[symmetric])
+ also have "\<dots> = \<H>(fst | t\<circ>OB)"
+ unfolding conditional_entropy_eq_ce_with_hypothesis
+ by (simp add: comp_def image_image[symmetric])
+ finally show ?thesis .
+qed
+
+theorem "\<I>(fst ; OB) \<le> real (card observations) * log b (real n + 1)"
+proof -
+ have "\<I>(fst ; OB) = \<H>(fst) - \<H>(fst | OB)"
+ using mutual_information_eq_entropy_conditional_entropy .
+ also have "\<dots> = \<H>(fst) - \<H>(fst | t\<circ>OB)"
+ unfolding ce_OB_eq_ce_t ..
+ also have "\<dots> = \<H>(t\<circ>OB) - \<H>(t\<circ>OB | fst)"
+ unfolding entropy_chain_rule[symmetric] sign_simps
+ by (subst entropy_commute) simp
+ also have "\<dots> \<le> \<H>(t\<circ>OB)"
+ using conditional_entropy_positive[of "t\<circ>OB" fst] by simp
+ also have "\<dots> \<le> log b (real (card ((t\<circ>OB)`msgs)))"
+ using entropy_le_card[of "t\<circ>OB"] by simp
+ also have "\<dots> \<le> log b (real (n + 1)^card observations)"
+ using card_T_bound not_empty
+ by (auto intro!: log_le simp: card_gt_0_iff power_real_of_nat simp del: real_of_nat_power)
+ also have "\<dots> = real (card observations) * log b (real n + 1)"
+ by (simp add: log_nat_power real_of_nat_Suc)
+ finally show ?thesis .
+qed
+
+end
+
+end
\ No newline at end of file
--- a/src/HOL/RealDef.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/RealDef.thy Thu Dec 02 11:18:44 2010 -0800
@@ -9,6 +9,7 @@
theory RealDef
imports Rat
+uses "~~/src/Tools/subtyping.ML"
begin
text {*
@@ -1109,6 +1110,11 @@
real_of_nat_def [code_unfold]: "real == real_of_nat"
real_of_int_def [code_unfold]: "real == real_of_int"
+setup Subtyping.setup
+
+declare [[coercion "real::nat\<Rightarrow>real"]]
+declare [[coercion "real::int\<Rightarrow>real"]]
+
lemma real_eq_of_nat: "real = of_nat"
unfolding real_of_nat_def ..
--- a/src/HOL/Set.thy Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Set.thy Thu Dec 02 11:18:44 2010 -0800
@@ -882,7 +882,6 @@
lemma rangeE [elim?]: "b \<in> range (\<lambda>x. f x) ==> (!!x. b = f x ==> P) ==> P"
by blast
-
subsubsection {* Some rules with @{text "if"} *}
text{* Elimination of @{text"{x. \<dots> & x=t & \<dots>}"}. *}
--- a/src/HOL/Tools/Metis/metis_reconstruct.ML Wed Dec 01 20:52:16 2010 -0800
+++ b/src/HOL/Tools/Metis/metis_reconstruct.ML Thu Dec 02 11:18:44 2010 -0800
@@ -554,22 +554,32 @@
fun count p xs = fold (fn x => if p x then Integer.add 1 else I) xs 0
fun replay_one_inference ctxt mode skolem_params (fol_th, inf) thpairs =
- let
- val _ = trace_msg ctxt (fn () => "=============================================")
- val _ = trace_msg ctxt (fn () => "METIS THM: " ^ Metis_Thm.toString fol_th)
- val _ = trace_msg ctxt (fn () => "INFERENCE: " ^ Metis_Proof.inferenceToString inf)
- val th = step ctxt mode skolem_params thpairs (fol_th, inf)
- |> flexflex_first_order
- val _ = trace_msg ctxt (fn () => "ISABELLE THM: " ^ Display.string_of_thm ctxt th)
- val _ = trace_msg ctxt (fn () => "=============================================")
- val num_metis_lits =
- fol_th |> Metis_Thm.clause |> Metis_LiteralSet.toList
- |> count is_metis_literal_genuine
- val num_isabelle_lits =
- th |> prems_of |> count is_isabelle_literal_genuine
- val _ = if num_metis_lits = num_isabelle_lits then ()
- else error "Cannot replay Metis proof in Isabelle: Out of sync."
- in (fol_th, th) :: thpairs end
+ if not (null thpairs) andalso prop_of (snd (hd thpairs)) aconv @{prop False} then
+ (* Isabelle sometimes identifies literals (premises) that are distinct in
+ Metis (e.g., because of type variables). We give the Isabelle proof the
+ benefice of the doubt. *)
+ thpairs
+ else
+ let
+ val _ = trace_msg ctxt
+ (fn () => "=============================================")
+ val _ = trace_msg ctxt
+ (fn () => "METIS THM: " ^ Metis_Thm.toString fol_th)
+ val _ = trace_msg ctxt
+ (fn () => "INFERENCE: " ^ Metis_Proof.inferenceToString inf)
+ val th = step ctxt mode skolem_params thpairs (fol_th, inf)
+ |> flexflex_first_order
+ val _ = trace_msg ctxt
+ (fn () => "ISABELLE THM: " ^ Display.string_of_thm ctxt th)
+ val _ = trace_msg ctxt
+ (fn () => "=============================================")
+ val num_metis_lits =
+ count is_metis_literal_genuine
+ (Metis_LiteralSet.toList (Metis_Thm.clause fol_th))
+ val num_isabelle_lits = count is_isabelle_literal_genuine (prems_of th)
+ val _ = if num_metis_lits >= num_isabelle_lits then ()
+ else error "Cannot replay Metis proof in Isabelle: Out of sync."
+ in (fol_th, th) :: thpairs end
fun term_instantiate thy = cterm_instantiate o map (pairself (cterm_of thy))
--- a/src/HOL/Tools/functorial_mappers.ML Wed Dec 01 20:52:16 2010 -0800
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,215 +0,0 @@
-(* Title: HOL/Tools/functorial_mappers.ML
- Author: Florian Haftmann, TU Muenchen
-
-Functorial mappers on types.
-*)
-
-signature FUNCTORIAL_MAPPERS =
-sig
- val find_atomic: theory -> typ -> (typ * (bool * bool)) list
- val construct_mapper: theory -> (string * bool -> term)
- -> bool -> typ -> typ -> term
- val type_mapper: term -> theory -> Proof.state
- type entry
- val entries: theory -> entry Symtab.table
-end;
-
-structure Functorial_Mappers : FUNCTORIAL_MAPPERS =
-struct
-
-val compositionalityN = "compositionality";
-val identityN = "identity";
-
-(** functorial mappers and their properties **)
-
-(* bookkeeping *)
-
-type entry = { mapper: string, variances: (sort * (bool * bool)) list,
- compositionality: thm, identity: thm };
-
-structure Data = Theory_Data(
- type T = entry Symtab.table
- val empty = Symtab.empty
- fun merge (xy : T * T) = Symtab.merge (K true) xy
- val extend = I
-);
-
-val entries = Data.get;
-
-
-(* type analysis *)
-
-fun find_atomic thy T =
- let
- val variances_of = Option.map #variances o Symtab.lookup (Data.get thy);
- fun add_variance is_contra T =
- AList.map_default (op =) (T, (false, false))
- ((if is_contra then apsnd else apfst) (K true));
- fun analyze' is_contra (_, (co, contra)) T =
- (if co then analyze is_contra T else I)
- #> (if contra then analyze (not is_contra) T else I)
- and analyze is_contra (T as Type (tyco, Ts)) = (case variances_of tyco
- of NONE => add_variance is_contra T
- | SOME variances => fold2 (analyze' is_contra) variances Ts)
- | analyze is_contra T = add_variance is_contra T;
- in analyze false T [] end;
-
-fun construct_mapper thy atomic =
- let
- val lookup = the o Symtab.lookup (Data.get thy);
- fun constructs is_contra (_, (co, contra)) T T' =
- (if co then [construct is_contra T T'] else [])
- @ (if contra then [construct (not is_contra) T T'] else [])
- and construct is_contra (T as Type (tyco, Ts)) (T' as Type (_, Ts')) =
- let
- val { mapper, variances, ... } = lookup tyco;
- val args = maps (fn (arg_pattern, (T, T')) =>
- constructs is_contra arg_pattern T T')
- (variances ~~ (Ts ~~ Ts'));
- val (U, U') = if is_contra then (T', T) else (T, T');
- in list_comb (Const (mapper, map fastype_of args ---> U --> U'), args) end
- | construct is_contra (TFree (v, _)) (TFree _) = atomic (v, is_contra);
- in construct end;
-
-
-(* mapper properties *)
-
-fun make_compositionality_prop variances (tyco, mapper) =
- let
- fun invents n k nctxt =
- let
- val names = Name.invents nctxt n k;
- in (names, fold Name.declare names nctxt) end;
- val (((vs1, vs2), vs3), _) = Name.context
- |> invents Name.aT (length variances)
- ||>> invents Name.aT (length variances)
- ||>> invents Name.aT (length variances);
- fun mk_Ts vs = map2 (fn v => fn (sort, _) => TFree (v, sort))
- vs variances;
- val (Ts1, Ts2, Ts3) = (mk_Ts vs1, mk_Ts vs2, mk_Ts vs3);
- fun mk_argT ((T, T'), (_, (co, contra))) =
- (if co then [(T --> T')] else [])
- @ (if contra then [(T' --> T)] else []);
- val contras = maps (fn (_, (co, contra)) =>
- (if co then [false] else []) @ (if contra then [true] else [])) variances;
- val Ts21 = maps mk_argT ((Ts2 ~~ Ts1) ~~ variances);
- val Ts32 = maps mk_argT ((Ts3 ~~ Ts2) ~~ variances);
- val ((names21, names32), nctxt) = Name.context
- |> invents "f" (length Ts21)
- ||>> invents "f" (length Ts32);
- val T1 = Type (tyco, Ts1);
- val T2 = Type (tyco, Ts2);
- val T3 = Type (tyco, Ts3);
- val x = Free (the_single (Name.invents nctxt "a" 1), T3);
- val (args21, args32) = (names21 ~~ Ts21, names32 ~~ Ts32);
- val args31 = map2 (fn is_contra => fn ((f21, T21), (f32, T32)) =>
- if not is_contra then
- Abs ("x", domain_type T32, Free (f21, T21) $ (Free (f32, T32) $ Bound 0))
- else
- Abs ("x", domain_type T21, Free (f32, T32) $ (Free (f21, T21) $ Bound 0))
- ) contras (args21 ~~ args32)
- fun mk_mapper T T' args = list_comb (Const (mapper,
- map fastype_of args ---> T --> T'), args);
- val lhs = mk_mapper T2 T1 (map Free args21) $
- (mk_mapper T3 T2 (map Free args32) $ x);
- val rhs = mk_mapper T3 T1 args31 $ x;
- in (map Free (args21 @ args32) @ [x], (HOLogic.mk_Trueprop o HOLogic.mk_eq) (lhs, rhs)) end;
-
-fun make_identity_prop variances (tyco, mapper) =
- let
- val vs = Name.invents Name.context Name.aT (length variances);
- val Ts = map2 (fn v => fn (sort, _) => TFree (v, sort)) vs variances;
- fun bool_num b = if b then 1 else 0;
- fun mk_argT (T, (_, (co, contra))) =
- replicate (bool_num co + bool_num contra) (T --> T)
- val Ts' = maps mk_argT (Ts ~~ variances)
- val T = Type (tyco, Ts);
- val x = Free ("a", T);
- val lhs = list_comb (Const (mapper, Ts' ---> T --> T),
- map (fn T => Abs ("x", domain_type T, Bound 0)) Ts') $ x;
- in (x, (HOLogic.mk_Trueprop o HOLogic.mk_eq) (lhs, x)) end;
-
-
-(* analyzing and registering mappers *)
-
-fun consume eq x [] = (false, [])
- | consume eq x (ys as z :: zs) = if eq (x, z) then (true, zs) else (false, ys);
-
-fun split_mapper_typ "fun" T =
- let
- val (Ts', T') = strip_type T;
- val (Ts'', T'') = split_last Ts';
- val (Ts''', T''') = split_last Ts'';
- in (Ts''', T''', T'' --> T') end
- | split_mapper_typ tyco T =
- let
- val (Ts', T') = strip_type T;
- val (Ts'', T'') = split_last Ts';
- in (Ts'', T'', T') end;
-
-fun analyze_variances thy tyco T =
- let
- fun bad_typ () = error ("Bad mapper type: " ^ Syntax.string_of_typ_global thy T);
- val (Ts, T1, T2) = split_mapper_typ tyco T
- handle List.Empty => bad_typ ();
- val _ = pairself
- ((fn tyco' => if tyco' = tyco then () else bad_typ ()) o fst o dest_Type) (T1, T2)
- val (vs1, vs2) = pairself (map dest_TFree o snd o dest_Type) (T1, T2)
- handle TYPE _ => bad_typ ();
- val _ = if has_duplicates (eq_fst (op =)) (vs1 @ vs2)
- then bad_typ () else ();
- fun check_variance_pair (var1 as (v1, sort1), var2 as (v2, sort2)) =
- let
- val coT = TFree var1 --> TFree var2;
- val contraT = TFree var2 --> TFree var1;
- val sort = Sign.inter_sort thy (sort1, sort2);
- in
- consume (op =) coT
- ##>> consume (op =) contraT
- #>> pair sort
- end;
- val (variances, left_variances) = fold_map check_variance_pair (vs1 ~~ vs2) Ts;
- val _ = if null left_variances then () else bad_typ ();
- in variances end;
-
-fun gen_type_mapper prep_term raw_t thy =
- let
- val (mapper, T) = case prep_term thy raw_t
- of Const cT => cT
- | t => error ("No constant: " ^ Syntax.string_of_term_global thy t);
- val _ = Type.no_tvars T;
- fun add_tycos (Type (tyco, Ts)) = insert (op =) tyco #> fold add_tycos Ts
- | add_tycos _ = I;
- val tycos = add_tycos T [];
- val tyco = if tycos = ["fun"] then "fun"
- else case remove (op =) "fun" tycos
- of [tyco] => tyco
- | _ => error ("Bad number of type constructors: " ^ Syntax.string_of_typ_global thy T);
- val variances = analyze_variances thy tyco T;
- val compositionality_prop = uncurry (fold_rev Logic.all)
- (make_compositionality_prop variances (tyco, mapper));
- val identity_prop = uncurry Logic.all
- (make_identity_prop variances (tyco, mapper));
- val qualify = Binding.qualify true (Long_Name.base_name mapper) o Binding.name;
- fun after_qed [single_compositionality, single_identity] lthy =
- lthy
- |> Local_Theory.note ((qualify compositionalityN, []), single_compositionality)
- ||>> Local_Theory.note ((qualify identityN, []), single_identity)
- |-> (fn ((_, [compositionality]), (_, [identity])) =>
- (Local_Theory.background_theory o Data.map)
- (Symtab.update (tyco, { mapper = mapper, variances = variances,
- compositionality = compositionality, identity = identity })));
- in
- thy
- |> Named_Target.theory_init
- |> Proof.theorem NONE after_qed (map (fn t => [(t, [])]) [compositionality_prop, identity_prop])
- end
-
-val type_mapper = gen_type_mapper Sign.cert_term;
-val type_mapper_cmd = gen_type_mapper Syntax.read_term_global;
-
-val _ =
- Outer_Syntax.command "type_mapper" "register functorial mapper for type with its properties" Keyword.thy_goal
- (Parse.term >> (fn t => Toplevel.print o (Toplevel.theory_to_proof (type_mapper_cmd t))));
-
-end;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Tools/type_mapper.ML Thu Dec 02 11:18:44 2010 -0800
@@ -0,0 +1,217 @@
+(* Title: HOL/Tools/type_mapper.ML
+ Author: Florian Haftmann, TU Muenchen
+
+Functorial mappers on types.
+*)
+
+signature TYPE_MAPPER =
+sig
+ val find_atomic: theory -> typ -> (typ * (bool * bool)) list
+ val construct_mapper: theory -> (string * bool -> term)
+ -> bool -> typ -> typ -> term
+ val type_mapper: string option -> term -> theory -> Proof.state
+ type entry
+ val entries: theory -> entry Symtab.table
+end;
+
+structure Type_Mapper : TYPE_MAPPER =
+struct
+
+val compositionalityN = "compositionality";
+val identityN = "identity";
+
+(** functorial mappers and their properties **)
+
+(* bookkeeping *)
+
+type entry = { mapper: string, variances: (sort * (bool * bool)) list,
+ compositionality: thm, identity: thm };
+
+structure Data = Theory_Data(
+ type T = entry Symtab.table
+ val empty = Symtab.empty
+ fun merge (xy : T * T) = Symtab.merge (K true) xy
+ val extend = I
+);
+
+val entries = Data.get;
+
+
+(* type analysis *)
+
+fun find_atomic thy T =
+ let
+ val variances_of = Option.map #variances o Symtab.lookup (Data.get thy);
+ fun add_variance is_contra T =
+ AList.map_default (op =) (T, (false, false))
+ ((if is_contra then apsnd else apfst) (K true));
+ fun analyze' is_contra (_, (co, contra)) T =
+ (if co then analyze is_contra T else I)
+ #> (if contra then analyze (not is_contra) T else I)
+ and analyze is_contra (T as Type (tyco, Ts)) = (case variances_of tyco
+ of NONE => add_variance is_contra T
+ | SOME variances => fold2 (analyze' is_contra) variances Ts)
+ | analyze is_contra T = add_variance is_contra T;
+ in analyze false T [] end;
+
+fun construct_mapper thy atomic =
+ let
+ val lookup = the o Symtab.lookup (Data.get thy);
+ fun constructs is_contra (_, (co, contra)) T T' =
+ (if co then [construct is_contra T T'] else [])
+ @ (if contra then [construct (not is_contra) T T'] else [])
+ and construct is_contra (T as Type (tyco, Ts)) (T' as Type (_, Ts')) =
+ let
+ val { mapper, variances, ... } = lookup tyco;
+ val args = maps (fn (arg_pattern, (T, T')) =>
+ constructs is_contra arg_pattern T T')
+ (variances ~~ (Ts ~~ Ts'));
+ val (U, U') = if is_contra then (T', T) else (T, T');
+ in list_comb (Const (mapper, map fastype_of args ---> U --> U'), args) end
+ | construct is_contra (TFree (v, _)) (TFree _) = atomic (v, is_contra);
+ in construct end;
+
+
+(* mapper properties *)
+
+fun make_compositionality_prop variances (tyco, mapper) =
+ let
+ fun invents n k nctxt =
+ let
+ val names = Name.invents nctxt n k;
+ in (names, fold Name.declare names nctxt) end;
+ val (((vs1, vs2), vs3), _) = Name.context
+ |> invents Name.aT (length variances)
+ ||>> invents Name.aT (length variances)
+ ||>> invents Name.aT (length variances);
+ fun mk_Ts vs = map2 (fn v => fn (sort, _) => TFree (v, sort))
+ vs variances;
+ val (Ts1, Ts2, Ts3) = (mk_Ts vs1, mk_Ts vs2, mk_Ts vs3);
+ fun mk_argT ((T, T'), (_, (co, contra))) =
+ (if co then [(T --> T')] else [])
+ @ (if contra then [(T' --> T)] else []);
+ val contras = maps (fn (_, (co, contra)) =>
+ (if co then [false] else []) @ (if contra then [true] else [])) variances;
+ val Ts21 = maps mk_argT ((Ts2 ~~ Ts1) ~~ variances);
+ val Ts32 = maps mk_argT ((Ts3 ~~ Ts2) ~~ variances);
+ val ((names21, names32), nctxt) = Name.context
+ |> invents "f" (length Ts21)
+ ||>> invents "f" (length Ts32);
+ val T1 = Type (tyco, Ts1);
+ val T2 = Type (tyco, Ts2);
+ val T3 = Type (tyco, Ts3);
+ val x = Free (the_single (Name.invents nctxt (Long_Name.base_name tyco) 1), T3);
+ val (args21, args32) = (names21 ~~ Ts21, names32 ~~ Ts32);
+ val args31 = map2 (fn is_contra => fn ((f21, T21), (f32, T32)) =>
+ if not is_contra then
+ Abs ("x", domain_type T32, Free (f21, T21) $ (Free (f32, T32) $ Bound 0))
+ else
+ Abs ("x", domain_type T21, Free (f32, T32) $ (Free (f21, T21) $ Bound 0))
+ ) contras (args21 ~~ args32)
+ fun mk_mapper T T' args = list_comb (Const (mapper,
+ map fastype_of args ---> T --> T'), args);
+ val lhs = mk_mapper T2 T1 (map Free args21) $
+ (mk_mapper T3 T2 (map Free args32) $ x);
+ val rhs = mk_mapper T3 T1 args31 $ x;
+ in (map Free (args21 @ args32) @ [x], (HOLogic.mk_Trueprop o HOLogic.mk_eq) (lhs, rhs)) end;
+
+fun make_identity_prop variances (tyco, mapper) =
+ let
+ val vs = Name.invents Name.context Name.aT (length variances);
+ val Ts = map2 (fn v => fn (sort, _) => TFree (v, sort)) vs variances;
+ fun bool_num b = if b then 1 else 0;
+ fun mk_argT (T, (_, (co, contra))) =
+ replicate (bool_num co + bool_num contra) (T --> T)
+ val Ts' = maps mk_argT (Ts ~~ variances)
+ val T = Type (tyco, Ts);
+ val x = Free (Long_Name.base_name tyco, T);
+ val lhs = list_comb (Const (mapper, Ts' ---> T --> T),
+ map (fn T => Abs ("x", domain_type T, Bound 0)) Ts') $ x;
+ in (x, (HOLogic.mk_Trueprop o HOLogic.mk_eq) (lhs, x)) end;
+
+
+(* analyzing and registering mappers *)
+
+fun consume eq x [] = (false, [])
+ | consume eq x (ys as z :: zs) = if eq (x, z) then (true, zs) else (false, ys);
+
+fun split_mapper_typ "fun" T =
+ let
+ val (Ts', T') = strip_type T;
+ val (Ts'', T'') = split_last Ts';
+ val (Ts''', T''') = split_last Ts'';
+ in (Ts''', T''', T'' --> T') end
+ | split_mapper_typ tyco T =
+ let
+ val (Ts', T') = strip_type T;
+ val (Ts'', T'') = split_last Ts';
+ in (Ts'', T'', T') end;
+
+fun analyze_variances thy tyco T =
+ let
+ fun bad_typ () = error ("Bad mapper type: " ^ Syntax.string_of_typ_global thy T);
+ val (Ts, T1, T2) = split_mapper_typ tyco T
+ handle List.Empty => bad_typ ();
+ val _ = pairself
+ ((fn tyco' => if tyco' = tyco then () else bad_typ ()) o fst o dest_Type) (T1, T2)
+ val (vs1, vs2) = pairself (map dest_TFree o snd o dest_Type) (T1, T2)
+ handle TYPE _ => bad_typ ();
+ val _ = if has_duplicates (eq_fst (op =)) (vs1 @ vs2)
+ then bad_typ () else ();
+ fun check_variance_pair (var1 as (v1, sort1), var2 as (v2, sort2)) =
+ let
+ val coT = TFree var1 --> TFree var2;
+ val contraT = TFree var2 --> TFree var1;
+ val sort = Sign.inter_sort thy (sort1, sort2);
+ in
+ consume (op =) coT
+ ##>> consume (op =) contraT
+ #>> pair sort
+ end;
+ val (variances, left_variances) = fold_map check_variance_pair (vs1 ~~ vs2) Ts;
+ val _ = if null left_variances then () else bad_typ ();
+ in variances end;
+
+fun gen_type_mapper prep_term some_prfx raw_t thy =
+ let
+ val (mapper, T) = case prep_term thy raw_t
+ of Const cT => cT
+ | t => error ("No constant: " ^ Syntax.string_of_term_global thy t);
+ val prfx = the_default (Long_Name.base_name mapper) some_prfx;
+ val _ = Type.no_tvars T;
+ fun add_tycos (Type (tyco, Ts)) = insert (op =) tyco #> fold add_tycos Ts
+ | add_tycos _ = I;
+ val tycos = add_tycos T [];
+ val tyco = if tycos = ["fun"] then "fun"
+ else case remove (op =) "fun" tycos
+ of [tyco] => tyco
+ | _ => error ("Bad number of type constructors: " ^ Syntax.string_of_typ_global thy T);
+ val variances = analyze_variances thy tyco T;
+ val compositionality_prop = uncurry (fold_rev Logic.all)
+ (make_compositionality_prop variances (tyco, mapper));
+ val identity_prop = uncurry Logic.all
+ (make_identity_prop variances (tyco, mapper));
+ val qualify = Binding.qualify true prfx o Binding.name;
+ fun after_qed [single_compositionality, single_identity] lthy =
+ lthy
+ |> Local_Theory.note ((qualify compositionalityN, []), single_compositionality)
+ ||>> Local_Theory.note ((qualify identityN, []), single_identity)
+ |-> (fn ((_, [compositionality]), (_, [identity])) =>
+ (Local_Theory.background_theory o Data.map)
+ (Symtab.update (tyco, { mapper = mapper, variances = variances,
+ compositionality = compositionality, identity = identity })));
+ in
+ thy
+ |> Named_Target.theory_init
+ |> Proof.theorem NONE after_qed (map (fn t => [(t, [])]) [compositionality_prop, identity_prop])
+ end
+
+val type_mapper = gen_type_mapper Sign.cert_term;
+val type_mapper_cmd = gen_type_mapper Syntax.read_term_global;
+
+val _ =
+ Outer_Syntax.command "type_mapper" "register functorial mapper for type with its properties" Keyword.thy_goal
+ (Scan.option (Parse.name --| Parse.$$$ ":") -- Parse.term
+ >> (fn (prfx, t) => Toplevel.print o (Toplevel.theory_to_proof (type_mapper_cmd prfx t))));
+
+end;
--- a/src/Pure/General/markup.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Pure/General/markup.scala Thu Dec 02 11:18:44 2010 -0800
@@ -227,15 +227,14 @@
{
def apply(timing: isabelle.Timing): Markup =
Markup(TIMING, List(
- (ELAPSED, Double(timing.elapsed)),
- (CPU, Double(timing.cpu)),
- (GC, Double(timing.gc))))
+ (ELAPSED, Double(timing.elapsed.seconds)),
+ (CPU, Double(timing.cpu.seconds)),
+ (GC, Double(timing.gc.seconds))))
def unapply(markup: Markup): Option[isabelle.Timing] =
markup match {
case Markup(TIMING, List(
- (ELAPSED, Double(elapsed)),
- (CPU, Double(cpu)),
- (GC, Double(gc)))) => Some(isabelle.Timing(elapsed, cpu, gc))
+ (ELAPSED, Double(elapsed)), (CPU, Double(cpu)), (GC, Double(gc)))) =>
+ Some(new isabelle.Timing(Time.seconds(elapsed), Time.seconds(cpu), Time.seconds(gc)))
case _ => None
}
}
--- a/src/Pure/General/timing.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Pure/General/timing.scala Thu Dec 02 11:18:44 2010 -0800
@@ -6,15 +6,27 @@
package isabelle
-
-sealed case class Timing(val elapsed: Double, cpu: Double, gc: Double)
+object Time
{
- private def print_time(seconds: Double): String =
- String.format(java.util.Locale.ROOT, "%.3f", seconds.asInstanceOf[AnyRef])
-
- def message: String =
- print_time(elapsed) + "s elapsed time, " +
- print_time(cpu) + "s cpu time, " +
- print_time(gc) + "s GC time"
+ def seconds(s: Double): Time = new Time((s * 1000.0) round)
}
+class Time(val ms: Long)
+{
+ def seconds: Double = ms / 1000.0
+
+ def min(t: Time): Time = if (ms < t.ms) this else t
+ def max(t: Time): Time = if (ms > t.ms) this else t
+
+ override def toString =
+ String.format(java.util.Locale.ROOT, "%.3f", seconds.asInstanceOf[AnyRef])
+ def message: String = toString + "s"
+}
+
+class Timing(val elapsed: Time, val cpu: Time, val gc: Time)
+{
+ def message: String =
+ elapsed.message + " elapsed time, " + cpu.message + " cpu time, " + gc.message + " GC time"
+ override def toString = message
+}
+
--- a/src/Pure/System/isabelle_process.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Pure/System/isabelle_process.scala Thu Dec 02 11:18:44 2010 -0800
@@ -61,7 +61,7 @@
}
-class Isabelle_Process(system: Isabelle_System, timeout: Int, receiver: Actor, args: String*)
+class Isabelle_Process(system: Isabelle_System, timeout: Time, receiver: Actor, args: String*)
{
import Isabelle_Process._
@@ -69,7 +69,7 @@
/* demo constructor */
def this(args: String*) =
- this(new Isabelle_System, 10000,
+ this(new Isabelle_System, Time.seconds(10),
actor { loop { react { case res => Console.println(res) } } }, args: _*)
@@ -141,7 +141,7 @@
{
val (startup_failed, startup_output) =
{
- val expired = System.currentTimeMillis() + timeout
+ val expired = System.currentTimeMillis() + timeout.ms
val result = new StringBuilder(100)
var finished: Option[Boolean] = None
--- a/src/Pure/System/session.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Pure/System/session.scala Thu Dec 02 11:18:44 2010 -0800
@@ -36,13 +36,13 @@
/* real time parameters */ // FIXME properties or settings (!?)
// user input (e.g. text edits, cursor movement)
- val input_delay = 300
+ val input_delay = Time.seconds(0.3)
// prover output (markup, common messages)
- val output_delay = 100
+ val output_delay = Time.seconds(0.1)
// GUI layout updates
- val update_delay = 500
+ val update_delay = Time.seconds(0.5)
/* pervasive event buses */
@@ -74,15 +74,13 @@
Simple_Thread.actor("command_change_buffer", daemon = true)
//{{{
{
- import scala.compat.Platform.currentTime
-
var changed: Set[Command] = Set()
var flush_time: Option[Long] = None
def flush_timeout: Long =
flush_time match {
case None => 5000L
- case Some(time) => (time - currentTime) max 0
+ case Some(time) => (time - System.currentTimeMillis()) max 0
}
def flush()
@@ -94,9 +92,9 @@
def invoke()
{
- val now = currentTime
+ val now = System.currentTimeMillis()
flush_time match {
- case None => flush_time = Some(now + output_delay)
+ case None => flush_time = Some(now + output_delay.ms)
case Some(time) => if (now >= time) flush()
}
}
@@ -136,7 +134,7 @@
private case object Interrupt_Prover
private case class Edit_Version(edits: List[Document.Edit_Text])
- private case class Start(timeout: Int, args: List[String])
+ private case class Start(timeout: Time, args: List[String])
private val (_, session_actor) = Simple_Thread.actor("session_actor", daemon = true)
{
@@ -288,7 +286,7 @@
/** main methods **/
- def start(timeout: Int, args: List[String]) { session_actor ! Start(timeout, args) }
+ def start(timeout: Time, args: List[String]) { session_actor ! Start(timeout, args) }
def stop() { command_change_buffer !? Stop; session_actor !? Stop }
--- a/src/Pure/System/swing_thread.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Pure/System/swing_thread.scala Thu Dec 02 11:18:44 2010 -0800
@@ -44,12 +44,12 @@
/* delayed actions */
- private def delayed_action(first: Boolean)(time_span: Int)(action: => Unit): () => Unit =
+ private def delayed_action(first: Boolean)(time: Time)(action: => Unit): () => Unit =
{
val listener = new ActionListener {
override def actionPerformed(e: ActionEvent) { Swing_Thread.assert(); action }
}
- val timer = new Timer(time_span, listener)
+ val timer = new Timer(time.ms.toInt, listener)
timer.setRepeats(false)
def invoke() { if (first) timer.start() else timer.restart() }
--- a/src/Pure/library.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Pure/library.scala Thu Dec 02 11:18:44 2010 -0800
@@ -137,12 +137,12 @@
def timeit[A](message: String)(e: => A) =
{
- val start = System.nanoTime()
+ val start = System.currentTimeMillis()
val result = Exn.capture(e)
- val stop = System.nanoTime()
+ val stop = System.currentTimeMillis()
System.err.println(
(if (message == null || message.isEmpty) "" else message + ": ") +
- ((stop - start).toDouble / 1000000) + "ms elapsed time")
+ new Time(stop - start).message + " elapsed time")
Exn.release(result)
}
}
--- a/src/Tools/jEdit/plugin/Isabelle.props Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Tools/jEdit/plugin/Isabelle.props Thu Dec 02 11:18:44 2010 -0800
@@ -32,8 +32,8 @@
options.isabelle.tooltip-margin.title=Tooltip Margin
options.isabelle.tooltip-margin=40
options.isabelle.tooltip-dismiss-delay.title=Tooltip Dismiss Delay (global)
-options.isabelle.tooltip-dismiss-delay=8000
-options.isabelle.startup-timeout=10000
+options.isabelle.tooltip-dismiss-delay=8.0
+options.isabelle.startup-timeout=10.0
options.isabelle.auto-start.title=Auto Start
options.isabelle.auto-start=true
--- a/src/Tools/jEdit/src/jedit/document_model.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Tools/jEdit/src/jedit/document_model.scala Thu Dec 02 11:18:44 2010 -0800
@@ -63,7 +63,7 @@
extends TokenMarker.LineContext(dummy_rules, prev)
{
override def hashCode: Int = line
- override def equals(that: Any) =
+ override def equals(that: Any): Boolean =
that match {
case other: Line_Context => line == other.line
case _ => false
--- a/src/Tools/jEdit/src/jedit/isabelle_options.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Tools/jEdit/src/jedit/isabelle_options.scala Thu Dec 02 11:18:44 2010 -0800
@@ -7,6 +7,8 @@
package isabelle.jedit
+import isabelle._
+
import javax.swing.JSpinner
import scala.swing.CheckBox
@@ -39,7 +41,8 @@
tooltip_margin.setValue(Isabelle.Int_Property("tooltip-margin", 40))
addComponent(Isabelle.Property("tooltip-margin.title"), tooltip_margin)
- tooltip_dismiss_delay.setValue(Isabelle.Int_Property("tooltip-dismiss-delay", 8000))
+ tooltip_dismiss_delay.setValue(
+ Isabelle.Time_Property("tooltip-dismiss-delay", Time.seconds(8.0)).ms.toInt)
addComponent(Isabelle.Property("tooltip-dismiss-delay.title"), tooltip_dismiss_delay)
}
@@ -58,7 +61,7 @@
Isabelle.Int_Property("tooltip-margin") =
tooltip_margin.getValue().asInstanceOf[Int]
- Isabelle.Int_Property("tooltip-dismiss-delay") =
- tooltip_dismiss_delay.getValue().asInstanceOf[Int]
+ Isabelle.Time_Property("tooltip-dismiss-delay") =
+ Time.seconds(tooltip_dismiss_delay.getValue().asInstanceOf[Int])
}
}
--- a/src/Tools/jEdit/src/jedit/plugin.scala Wed Dec 01 20:52:16 2010 -0800
+++ b/src/Tools/jEdit/src/jedit/plugin.scala Thu Dec 02 11:18:44 2010 -0800
@@ -70,6 +70,26 @@
jEdit.setIntegerProperty(OPTION_PREFIX + name, value)
}
+ object Double_Property
+ {
+ def apply(name: String): Double =
+ jEdit.getDoubleProperty(OPTION_PREFIX + name, 0.0)
+ def apply(name: String, default: Double): Double =
+ jEdit.getDoubleProperty(OPTION_PREFIX + name, default)
+ def update(name: String, value: Double) =
+ jEdit.setDoubleProperty(OPTION_PREFIX + name, value)
+ }
+
+ object Time_Property
+ {
+ def apply(name: String): Time =
+ Time.seconds(Double_Property(name))
+ def apply(name: String, default: Time): Time =
+ Time.seconds(Double_Property(name, default.seconds))
+ def update(name: String, value: Time) =
+ Double_Property.update(name, value.seconds)
+ }
+
/* font */
@@ -100,14 +120,14 @@
Int_Property("tooltip-font-size", 10).toString + "px; \">" + // FIXME proper scaling (!?)
HTML.encode(text) + "</pre></html>"
- def tooltip_dismiss_delay(): Int =
- Int_Property("tooltip-dismiss-delay", 8000) max 500
+ def tooltip_dismiss_delay(): Time =
+ Time_Property("tooltip-dismiss-delay", Time.seconds(8.0)) max Time.seconds(0.5)
def setup_tooltips()
{
Swing_Thread.now {
val manager = javax.swing.ToolTipManager.sharedInstance
- manager.setDismissDelay(tooltip_dismiss_delay())
+ manager.setDismissDelay(tooltip_dismiss_delay().ms.toInt)
}
}
@@ -210,7 +230,7 @@
def start_session()
{
- val timeout = Int_Property("startup-timeout") max 1000
+ val timeout = Time_Property("startup-timeout", Time.seconds(10)) max Time.seconds(5)
val modes = system.getenv("JEDIT_PRINT_MODE").split(",").toList.map("-m" + _)
val logic = {
val logic = Property("logic")