merged
authorhuffman
Thu, 02 Dec 2010 11:18:44 -0800
changeset 40890 29a45797e269
parent 40889 0317c902dbfa (current diff)
parent 40887 ee8d0548c148 (diff)
child 40891 74877f1f3c68
merged
src/HOL/Probability/Borel.thy
src/HOL/Probability/Euclidean_Lebesgue.thy
src/HOL/Tools/functorial_mappers.ML
--- 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 \<