Rewrite the Probability theory.
authorhoelzl
Mon, 23 Aug 2010 19:35:57 +0200
changeset 38656 d5d342611edb
parent 38655 5001ed24e129
child 38657 2e0ebdaac59b
child 38666 12096ea0cc1c
child 38705 aaee86c0e237
Rewrite the Probability theory. 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.
CONTRIBUTORS
NEWS
src/HOL/IsaMakefile
src/HOL/Library/FuncSet.thy
src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy
src/HOL/Multivariate_Analysis/Euclidean_Space.thy
src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy
src/HOL/Multivariate_Analysis/Gauge_Measure.thy
src/HOL/Multivariate_Analysis/Integration.thy
src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy
src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy
src/HOL/Probability/Borel.thy
src/HOL/Probability/Caratheodory.thy
src/HOL/Probability/Euclidean_Lebesgue.thy
src/HOL/Probability/Information.thy
src/HOL/Probability/Lebesgue.thy
src/HOL/Probability/Lebesgue_Integration.thy
src/HOL/Probability/Lebesgue_Measure.thy
src/HOL/Probability/Measure.thy
src/HOL/Probability/Positive_Infinite_Real.thy
src/HOL/Probability/Probability_Space.thy
src/HOL/Probability/Product_Measure.thy
src/HOL/Probability/Radon_Nikodym.thy
src/HOL/Probability/SeriesPlus.thy
src/HOL/Probability/Sigma_Algebra.thy
src/HOL/Probability/document/root.tex
src/HOL/Probability/ex/Dining_Cryptographers.thy
--- a/CONTRIBUTORS	Mon Aug 23 17:46:13 2010 +0200
+++ b/CONTRIBUTORS	Mon Aug 23 19:35:57 2010 +0200
@@ -6,6 +6,9 @@
 Contributions to this Isabelle version
 --------------------------------------
 
+* August 2010: Johannes Hoelzl, Armin Heller, and Robert Himmelmann, TUM
+  Rewriting the Probability theory.
+
 * July 2010: Florian Haftmann, TUM
   Reworking and extension of the Isabelle/HOL framework.
 
--- a/NEWS	Mon Aug 23 17:46:13 2010 +0200
+++ b/NEWS	Mon Aug 23 19:35:57 2010 +0200
@@ -155,6 +155,13 @@
 
 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.
+
 * Inductive package: offers new command "inductive_simps" to automatically
 derive instantiated and simplified equations for inductive predicates,
 similar to inductive_cases.
--- a/src/HOL/IsaMakefile	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/IsaMakefile	Mon Aug 23 19:35:57 2010 +0200
@@ -1104,6 +1104,7 @@
   Multivariate_Analysis/Finite_Cartesian_Product.thy			\
   Multivariate_Analysis/Integration.certs				\
   Multivariate_Analysis/Integration.thy					\
+  Multivariate_Analysis/Gauge_Measure.thy					\
   Multivariate_Analysis/L2_Norm.thy					\
   Multivariate_Analysis/Multivariate_Analysis.thy			\
   Multivariate_Analysis/Operator_Norm.thy				\
@@ -1121,20 +1122,19 @@
 
 ## HOL-Probability
 
-HOL-Probability: HOL $(OUT)/HOL-Probability
+HOL-Probability: HOL-Multivariate_Analysis $(OUT)/HOL-Probability
 
-$(OUT)/HOL-Probability: $(OUT)/HOL Probability/ROOT.ML			\
+$(OUT)/HOL-Probability: $(OUT)/HOL-Multivariate_Analysis Probability/ROOT.ML	\
   Probability/Probability.thy Probability/Sigma_Algebra.thy		\
-  Probability/SeriesPlus.thy Probability/Caratheodory.thy		\
+  Probability/Caratheodory.thy		\
   Probability/Borel.thy Probability/Measure.thy				\
-  Probability/Lebesgue.thy Probability/Product_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		\
-  Library/Convex.thy Library/Product_Vector.thy 			\
-  Library/Product_plus.thy Library/Inner_Product.thy			\
-  Library/Nat_Bijection.thy
-	@cd Probability; $(ISABELLE_TOOL) usedir -b -g true $(OUT)/HOL HOL-Probability
-
+  Probability/Lebesgue_Measure.thy \
+  Library/Nat_Bijection.thy Library/Countable.thy
+	@cd Probability; $(ISABELLE_TOOL) usedir -b -g true $(OUT)/HOL-Multivariate_Analysis HOL-Probability
 
 ## HOL-Nominal
 
--- a/src/HOL/Library/FuncSet.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Library/FuncSet.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -67,6 +67,10 @@
   "f : Pi A B ==> (f x : B x ==> Q) ==> (x ~: A ==> Q) ==> Q"
 by(auto simp: Pi_def)
 
+lemma Pi_cong:
+  "(\<And> w. w \<in> A \<Longrightarrow> f w = g w) \<Longrightarrow> f \<in> Pi A B \<longleftrightarrow> g \<in> Pi A B"
+  by (auto simp: Pi_def)
+
 lemma funcset_id [simp]: "(\<lambda>x. x) \<in> A \<rightarrow> A"
   by (auto intro: Pi_I)
 
--- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -5,149 +5,6 @@
 imports Finite_Cartesian_Product Integration
 begin
 
-instantiation prod :: (real_basis, real_basis) real_basis
-begin
-
-definition "basis i = (if i < DIM('a) then (basis i, 0) else (0, basis (i - DIM('a))))"
-
-instance
-proof
-  let ?b = "basis :: nat \<Rightarrow> 'a \<times> 'b"
-  let ?b_a = "basis :: nat \<Rightarrow> 'a"
-  let ?b_b = "basis :: nat \<Rightarrow> 'b"
-
-  note image_range =
-    image_add_atLeastLessThan[symmetric, of 0 "DIM('a)" "DIM('b)", simplified]
-
-  have split_range:
-    "{..<DIM('b) + DIM('a)} = {..<DIM('a)} \<union> {DIM('a)..<DIM('b) + DIM('a)}"
-    by auto
-  have *: "?b ` {DIM('a)..<DIM('b) + DIM('a)} = {0} \<times> (?b_b ` {..<DIM('b)})"
-    "?b ` {..<DIM('a)} = (?b_a ` {..<DIM('a)}) \<times> {0}"
-    unfolding image_range image_image basis_prod_def_raw range_basis
-    by (auto simp: zero_prod_def basis_eq_0_iff)
-  hence b_split:
-    "?b ` {..<DIM('b) + DIM('a)} = (?b_a ` {..<DIM('a)}) \<times> {0} \<union> {0} \<times> (?b_b ` {..<DIM('b)})" (is "_ = ?prod")
-    by (subst split_range) (simp add: image_Un)
-
-  have b_0: "?b ` {DIM('b) + DIM('a)..} = {0}" unfolding basis_prod_def_raw
-    by (auto simp: zero_prod_def image_iff basis_eq_0_iff elim!: ballE[of _ _ "DIM('a) + DIM('b)"])
-
-  have split_UNIV:
-    "UNIV = {..<DIM('b) + DIM('a)} \<union> {DIM('b)+DIM('a)..}"
-    by auto
-
-  have range_b: "range ?b = ?prod \<union> {0}"
-    by (subst split_UNIV) (simp add: image_Un b_split b_0)
-
-  have prod: "\<And>f A B. setsum f (A \<times> B) = (\<Sum>a\<in>A. \<Sum>b\<in>B. f (a, b))"
-    by (simp add: setsum_cartesian_product)
-
-  show "span (range ?b) = UNIV"
-    unfolding span_explicit range_b
-  proof safe
-    fix a::'a and b::'b
-    from in_span_basis[of a] in_span_basis[of b]
-    obtain Sa ua Sb ub where span:
-        "finite Sa" "Sa \<subseteq> basis ` {..<DIM('a)}" "a = (\<Sum>v\<in>Sa. ua v *\<^sub>R v)"
-        "finite Sb" "Sb \<subseteq> basis ` {..<DIM('b)}" "b = (\<Sum>v\<in>Sb. ub v *\<^sub>R v)"
-      unfolding span_explicit by auto
-
-    let ?S = "((Sa - {0}) \<times> {0} \<union> {0} \<times> (Sb - {0}))"
-    have *:
-      "?S \<inter> {v. fst v = 0} \<inter> {v. snd v = 0} = {}"
-      "?S \<inter> - {v. fst v = 0} \<inter> {v. snd v = 0} = (Sa - {0}) \<times> {0}"
-      "?S \<inter> {v. fst v = 0} \<inter> - {v. snd v = 0} = {0} \<times> (Sb - {0})"
-      by (auto simp: zero_prod_def)
-    show "\<exists>S u. finite S \<and> S \<subseteq> ?prod \<union> {0} \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = (a, b)"
-      apply (rule exI[of _ ?S])
-      apply (rule exI[of _ "\<lambda>(v, w). (if w = 0 then ua v else 0) + (if v = 0 then ub w else 0)"])
-      using span
-      apply (simp add: prod_case_unfold setsum_addf if_distrib cond_application_beta setsum_cases prod *)
-      by (auto simp add: setsum_prod intro!: setsum_mono_zero_cong_left)
-  qed simp
-
-  show "\<exists>d>0. ?b ` {d..} = {0} \<and> independent (?b ` {..<d}) \<and> inj_on ?b {..<d}"
-    apply (rule exI[of _ "DIM('b) + DIM('a)"]) unfolding b_0
-  proof (safe intro!: DIM_positive del: notI)
-    show inj_on: "inj_on ?b {..<DIM('b) + DIM('a)}" unfolding split_range
-      using inj_on_iff[OF basis_inj[where 'a='a]] inj_on_iff[OF basis_inj[where 'a='b]]
-      by (auto intro!: inj_onI simp: basis_prod_def basis_eq_0_iff)
-
-    show "independent (?b ` {..<DIM('b) + DIM('a)})"
-      unfolding independent_eq_inj_on[OF inj_on]
-    proof safe
-      fix i u assume i_upper: "i < DIM('b) + DIM('a)" and
-          "(\<Sum>j\<in>{..<DIM('b) + DIM('a)} - {i}. u (?b j) *\<^sub>R ?b j) = ?b i" (is "?SUM = _")
-      let ?left = "{..<DIM('a)}" and ?right = "{DIM('a)..<DIM('b) + DIM('a)}"
-      show False
-      proof cases
-        assume "i < DIM('a)"
-        hence "(basis i, 0) = ?SUM" unfolding `?SUM = ?b i` unfolding basis_prod_def by auto
-        also have "\<dots> = (\<Sum>j\<in>?left - {i}. u (?b j) *\<^sub>R ?b j) +
-          (\<Sum>j\<in>?right. u (?b j) *\<^sub>R ?b j)"
-          using `i < DIM('a)` by (subst setsum_Un_disjoint[symmetric]) (auto intro!: setsum_cong)
-        also have "\<dots> =  (\<Sum>j\<in>?left - {i}. u (?b_a j, 0) *\<^sub>R (?b_a j, 0)) +
-          (\<Sum>j\<in>?right. u (0, ?b_b (j-DIM('a))) *\<^sub>R (0, ?b_b (j-DIM('a))))"
-          unfolding basis_prod_def by auto
-        finally have "basis i = (\<Sum>j\<in>?left - {i}. u (?b_a j, 0) *\<^sub>R ?b_a j)"
-          by (simp add: setsum_prod)
-        moreover
-        note independent_basis[where 'a='a, unfolded independent_eq_inj_on[OF basis_inj]]
-        note this[rule_format, of i "\<lambda>v. u (v, 0)"]
-        ultimately show False using `i < DIM('a)` by auto
-      next
-        let ?i = "i - DIM('a)"
-        assume not: "\<not> i < DIM('a)" hence "DIM('a) \<le> i" by auto
-        hence "?i < DIM('b)" using `i < DIM('b) + DIM('a)` by auto
-
-        have inj_on: "inj_on (\<lambda>j. j - DIM('a)) {DIM('a)..<DIM('b) + DIM('a)}"
-          by (auto intro!: inj_onI)
-        with i_upper not have *: "{..<DIM('b)} - {?i} = (\<lambda>j. j-DIM('a))`(?right - {i})"
-          by (auto simp: inj_on_image_set_diff image_minus_const_atLeastLessThan_nat)
-
-        have "(0, basis ?i) = ?SUM" unfolding `?SUM = ?b i`
-          unfolding basis_prod_def using not `?i < DIM('b)` by auto
-        also have "\<dots> = (\<Sum>j\<in>?left. u (?b j) *\<^sub>R ?b j) +
-          (\<Sum>j\<in>?right - {i}. u (?b j) *\<^sub>R ?b j)"
-          using not by (subst setsum_Un_disjoint[symmetric]) (auto intro!: setsum_cong)
-        also have "\<dots> =  (\<Sum>j\<in>?left. u (?b_a j, 0) *\<^sub>R (?b_a j, 0)) +
-          (\<Sum>j\<in>?right - {i}. u (0, ?b_b (j-DIM('a))) *\<^sub>R (0, ?b_b (j-DIM('a))))"
-          unfolding basis_prod_def by auto
-        finally have "basis ?i = (\<Sum>j\<in>{..<DIM('b)} - {?i}. u (0, ?b_b j) *\<^sub>R ?b_b j)"
-          unfolding *
-          by (subst setsum_reindex[OF inj_on[THEN subset_inj_on]])
-             (auto simp: setsum_prod)
-        moreover
-        note independent_basis[where 'a='b, unfolded independent_eq_inj_on[OF basis_inj]]
-        note this[rule_format, of ?i "\<lambda>v. u (0, v)"]
-        ultimately show False using `?i < DIM('b)` by auto
-      qed
-    qed
-  qed
-qed
-end
-
-lemma DIM_prod[simp]: "DIM('a \<times> 'b) = DIM('b::real_basis) + DIM('a::real_basis)"
-  by (rule dimension_eq) (auto simp: basis_prod_def zero_prod_def basis_eq_0_iff)
-
-instance prod :: (euclidean_space, euclidean_space) euclidean_space
-proof (default, safe)
-  let ?b = "basis :: nat \<Rightarrow> 'a \<times> 'b"
-  fix i j assume "i < DIM('a \<times> 'b)" "j < DIM('a \<times> 'b)"
-  thus "?b i \<bullet> ?b j = (if i = j then 1 else 0)"
-    unfolding basis_prod_def by (auto simp: dot_basis)
-qed
-
-instantiation prod :: (ordered_euclidean_space, ordered_euclidean_space) ordered_euclidean_space
-begin
-
-definition "x \<le> (y::('a\<times>'b)) \<longleftrightarrow> (\<forall>i<DIM('a\<times>'b). x $$ i \<le> y $$ i)"
-definition "x < (y::('a\<times>'b)) \<longleftrightarrow> (\<forall>i<DIM('a\<times>'b). x $$ i < y $$ i)"
-
-instance proof qed (auto simp: less_prod_def less_eq_prod_def)
-end
-
 lemma delta_mult_idempotent:
   "(if k=a then 1 else (0::'a::semiring_1)) * (if k=a then 1 else 0) = (if k=a then 1 else 0)" by (cases "k=a", auto)
 
@@ -1450,10 +1307,6 @@
   unfolding nth_conv_component
   using component_le_infnorm[of x] .
 
-lemma dist_nth_le_cart: "dist (x $ i) (y $ i) \<le> dist x y"
-  unfolding dist_vector_def
-  by (rule member_le_setL2) simp_all
-
 instance cart :: (perfect_space, finite) perfect_space
 proof
   fix x :: "'a ^ 'b"
--- a/src/HOL/Multivariate_Analysis/Euclidean_Space.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Multivariate_Analysis/Euclidean_Space.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -1934,6 +1934,16 @@
   assumes eucl_le: "x \<le> y \<longleftrightarrow> (\<forall>i < DIM('a). x $$ i \<le> y $$ i)"
   and eucl_less: "x < y \<longleftrightarrow> (\<forall>i < DIM('a). x $$ i < y $$ i)"
 
+lemma eucl_less_not_refl[simp, intro!]: "\<not> x < (x::'a::ordered_euclidean_space)"
+  unfolding eucl_less[where 'a='a] by auto
+
+lemma euclidean_trans[trans]:
+  fixes x y z :: "'a::ordered_euclidean_space"
+  shows "x < y \<Longrightarrow> y < z \<Longrightarrow> x < z"
+  and "x \<le> y \<Longrightarrow> y < z \<Longrightarrow> x < z"
+  and "x \<le> y \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> z"
+  by (force simp: eucl_less[where 'a='a] eucl_le[where 'a='a])+
+
 subsection {* Linearity and Bilinearity continued *}
 
 lemma linear_bounded:
@@ -3388,4 +3398,150 @@
 instance complex :: euclidean_space
   proof qed (auto simp add: basis_complex_def inner_complex_def)
 
+section {* Products Spaces *}
+
+instantiation prod :: (real_basis, real_basis) real_basis
+begin
+
+definition "basis i = (if i < DIM('a) then (basis i, 0) else (0, basis (i - DIM('a))))"
+
+instance
+proof
+  let ?b = "basis :: nat \<Rightarrow> 'a \<times> 'b"
+  let ?b_a = "basis :: nat \<Rightarrow> 'a"
+  let ?b_b = "basis :: nat \<Rightarrow> 'b"
+
+  note image_range =
+    image_add_atLeastLessThan[symmetric, of 0 "DIM('a)" "DIM('b)", simplified]
+
+  have split_range:
+    "{..<DIM('b) + DIM('a)} = {..<DIM('a)} \<union> {DIM('a)..<DIM('b) + DIM('a)}"
+    by auto
+  have *: "?b ` {DIM('a)..<DIM('b) + DIM('a)} = {0} \<times> (?b_b ` {..<DIM('b)})"
+    "?b ` {..<DIM('a)} = (?b_a ` {..<DIM('a)}) \<times> {0}"
+    unfolding image_range image_image basis_prod_def_raw range_basis
+    by (auto simp: zero_prod_def basis_eq_0_iff)
+  hence b_split:
+    "?b ` {..<DIM('b) + DIM('a)} = (?b_a ` {..<DIM('a)}) \<times> {0} \<union> {0} \<times> (?b_b ` {..<DIM('b)})" (is "_ = ?prod")
+    by (subst split_range) (simp add: image_Un)
+
+  have b_0: "?b ` {DIM('b) + DIM('a)..} = {0}" unfolding basis_prod_def_raw
+    by (auto simp: zero_prod_def image_iff basis_eq_0_iff elim!: ballE[of _ _ "DIM('a) + DIM('b)"])
+
+  have split_UNIV:
+    "UNIV = {..<DIM('b) + DIM('a)} \<union> {DIM('b)+DIM('a)..}"
+    by auto
+
+  have range_b: "range ?b = ?prod \<union> {0}"
+    by (subst split_UNIV) (simp add: image_Un b_split b_0)
+
+  have prod: "\<And>f A B. setsum f (A \<times> B) = (\<Sum>a\<in>A. \<Sum>b\<in>B. f (a, b))"
+    by (simp add: setsum_cartesian_product)
+
+  show "span (range ?b) = UNIV"
+    unfolding span_explicit range_b
+  proof safe
+    fix a::'a and b::'b
+    from in_span_basis[of a] in_span_basis[of b]
+    obtain Sa ua Sb ub where span:
+        "finite Sa" "Sa \<subseteq> basis ` {..<DIM('a)}" "a = (\<Sum>v\<in>Sa. ua v *\<^sub>R v)"
+        "finite Sb" "Sb \<subseteq> basis ` {..<DIM('b)}" "b = (\<Sum>v\<in>Sb. ub v *\<^sub>R v)"
+      unfolding span_explicit by auto
+
+    let ?S = "((Sa - {0}) \<times> {0} \<union> {0} \<times> (Sb - {0}))"
+    have *:
+      "?S \<inter> {v. fst v = 0} \<inter> {v. snd v = 0} = {}"
+      "?S \<inter> - {v. fst v = 0} \<inter> {v. snd v = 0} = (Sa - {0}) \<times> {0}"
+      "?S \<inter> {v. fst v = 0} \<inter> - {v. snd v = 0} = {0} \<times> (Sb - {0})"
+      by (auto simp: zero_prod_def)
+    show "\<exists>S u. finite S \<and> S \<subseteq> ?prod \<union> {0} \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = (a, b)"
+      apply (rule exI[of _ ?S])
+      apply (rule exI[of _ "\<lambda>(v, w). (if w = 0 then ua v else 0) + (if v = 0 then ub w else 0)"])
+      using span
+      apply (simp add: prod_case_unfold setsum_addf if_distrib cond_application_beta setsum_cases prod *)
+      by (auto simp add: setsum_prod intro!: setsum_mono_zero_cong_left)
+  qed simp
+
+  show "\<exists>d>0. ?b ` {d..} = {0} \<and> independent (?b ` {..<d}) \<and> inj_on ?b {..<d}"
+    apply (rule exI[of _ "DIM('b) + DIM('a)"]) unfolding b_0
+  proof (safe intro!: DIM_positive del: notI)
+    show inj_on: "inj_on ?b {..<DIM('b) + DIM('a)}" unfolding split_range
+      using inj_on_iff[OF basis_inj[where 'a='a]] inj_on_iff[OF basis_inj[where 'a='b]]
+      by (auto intro!: inj_onI simp: basis_prod_def basis_eq_0_iff)
+
+    show "independent (?b ` {..<DIM('b) + DIM('a)})"
+      unfolding independent_eq_inj_on[OF inj_on]
+    proof safe
+      fix i u assume i_upper: "i < DIM('b) + DIM('a)" and
+          "(\<Sum>j\<in>{..<DIM('b) + DIM('a)} - {i}. u (?b j) *\<^sub>R ?b j) = ?b i" (is "?SUM = _")
+      let ?left = "{..<DIM('a)}" and ?right = "{DIM('a)..<DIM('b) + DIM('a)}"
+      show False
+      proof cases
+        assume "i < DIM('a)"
+        hence "(basis i, 0) = ?SUM" unfolding `?SUM = ?b i` unfolding basis_prod_def by auto
+        also have "\<dots> = (\<Sum>j\<in>?left - {i}. u (?b j) *\<^sub>R ?b j) +
+          (\<Sum>j\<in>?right. u (?b j) *\<^sub>R ?b j)"
+          using `i < DIM('a)` by (subst setsum_Un_disjoint[symmetric]) (auto intro!: setsum_cong)
+        also have "\<dots> =  (\<Sum>j\<in>?left - {i}. u (?b_a j, 0) *\<^sub>R (?b_a j, 0)) +
+          (\<Sum>j\<in>?right. u (0, ?b_b (j-DIM('a))) *\<^sub>R (0, ?b_b (j-DIM('a))))"
+          unfolding basis_prod_def by auto
+        finally have "basis i = (\<Sum>j\<in>?left - {i}. u (?b_a j, 0) *\<^sub>R ?b_a j)"
+          by (simp add: setsum_prod)
+        moreover
+        note independent_basis[where 'a='a, unfolded independent_eq_inj_on[OF basis_inj]]
+        note this[rule_format, of i "\<lambda>v. u (v, 0)"]
+        ultimately show False using `i < DIM('a)` by auto
+      next
+        let ?i = "i - DIM('a)"
+        assume not: "\<not> i < DIM('a)" hence "DIM('a) \<le> i" by auto
+        hence "?i < DIM('b)" using `i < DIM('b) + DIM('a)` by auto
+
+        have inj_on: "inj_on (\<lambda>j. j - DIM('a)) {DIM('a)..<DIM('b) + DIM('a)}"
+          by (auto intro!: inj_onI)
+        with i_upper not have *: "{..<DIM('b)} - {?i} = (\<lambda>j. j-DIM('a))`(?right - {i})"
+          by (auto simp: inj_on_image_set_diff image_minus_const_atLeastLessThan_nat)
+
+        have "(0, basis ?i) = ?SUM" unfolding `?SUM = ?b i`
+          unfolding basis_prod_def using not `?i < DIM('b)` by auto
+        also have "\<dots> = (\<Sum>j\<in>?left. u (?b j) *\<^sub>R ?b j) +
+          (\<Sum>j\<in>?right - {i}. u (?b j) *\<^sub>R ?b j)"
+          using not by (subst setsum_Un_disjoint[symmetric]) (auto intro!: setsum_cong)
+        also have "\<dots> =  (\<Sum>j\<in>?left. u (?b_a j, 0) *\<^sub>R (?b_a j, 0)) +
+          (\<Sum>j\<in>?right - {i}. u (0, ?b_b (j-DIM('a))) *\<^sub>R (0, ?b_b (j-DIM('a))))"
+          unfolding basis_prod_def by auto
+        finally have "basis ?i = (\<Sum>j\<in>{..<DIM('b)} - {?i}. u (0, ?b_b j) *\<^sub>R ?b_b j)"
+          unfolding *
+          by (subst setsum_reindex[OF inj_on[THEN subset_inj_on]])
+             (auto simp: setsum_prod)
+        moreover
+        note independent_basis[where 'a='b, unfolded independent_eq_inj_on[OF basis_inj]]
+        note this[rule_format, of ?i "\<lambda>v. u (0, v)"]
+        ultimately show False using `?i < DIM('b)` by auto
+      qed
+    qed
+  qed
+qed
 end
+
+lemma DIM_prod[simp]: "DIM('a \<times> 'b) = DIM('b::real_basis) + DIM('a::real_basis)"
+  by (rule dimension_eq) (auto simp: basis_prod_def zero_prod_def basis_eq_0_iff)
+
+instance prod :: (euclidean_space, euclidean_space) euclidean_space
+proof (default, safe)
+  let ?b = "basis :: nat \<Rightarrow> 'a \<times> 'b"
+  fix i j assume "i < DIM('a \<times> 'b)" "j < DIM('a \<times> 'b)"
+  thus "?b i \<bullet> ?b j = (if i = j then 1 else 0)"
+    unfolding basis_prod_def by (auto simp: dot_basis)
+qed
+
+instantiation prod :: (ordered_euclidean_space, ordered_euclidean_space) ordered_euclidean_space
+begin
+
+definition "x \<le> (y::('a\<times>'b)) \<longleftrightarrow> (\<forall>i<DIM('a\<times>'b). x $$ i \<le> y $$ i)"
+definition "x < (y::('a\<times>'b)) \<longleftrightarrow> (\<forall>i<DIM('a\<times>'b). x $$ i < y $$ i)"
+
+instance proof qed (auto simp: less_prod_def less_eq_prod_def)
+end
+
+
+end
--- a/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Multivariate_Analysis/Finite_Cartesian_Product.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -254,7 +254,7 @@
 definition dist_vector_def:
   "dist x y = setL2 (\<lambda>i. dist (x$i) (y$i)) UNIV"
 
-lemma dist_nth_le: "dist (x $ i) (y $ i) \<le> dist x y"
+lemma dist_nth_le_cart: "dist (x $ i) (y $ i) \<le> dist x y"
 unfolding dist_vector_def
 by (rule member_le_setL2) simp_all
 
@@ -283,7 +283,7 @@
       apply (rule_tac x=e in exI, clarify)
       apply (drule spec, erule mp, clarify)
       apply (drule spec, drule spec, erule mp)
-      apply (erule le_less_trans [OF dist_nth_le])
+      apply (erule le_less_trans [OF dist_nth_le_cart])
      apply (subgoal_tac "\<forall>i\<in>UNIV. \<exists>e>0. \<forall>y. dist y (x$i) < e \<longrightarrow> y \<in> A i")
       apply (drule finite_choice [OF finite], clarify)
       apply (rule_tac x="Min (range f)" in exI, simp)
@@ -315,7 +315,7 @@
 
 lemma Cauchy_Cart_nth:
   "Cauchy (\<lambda>n. X n) \<Longrightarrow> Cauchy (\<lambda>n. X n $ i)"
-unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le])
+unfolding Cauchy_def by (fast intro: le_less_trans [OF dist_nth_le_cart])
 
 lemma Cauchy_vector:
   fixes X :: "nat \<Rightarrow> 'a::metric_space ^ 'n"
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Multivariate_Analysis/Gauge_Measure.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -0,0 +1,3447 @@
+
+header {* Lebsegue measure (defined via the gauge integral). *}
+(*  Author:                     John Harrison
+    Translation from HOL light: Robert Himmelmann, TU Muenchen *)
+
+theory Gauge_Measure
+  imports Integration 
+begin
+
+(* ------------------------------------------------------------------------- *)
+(* Lebesgue measure (in the case where the measure is finite).               *)
+(* For the non-finite version, please see Probability/Lebesgue_Measure.thy   *)
+(* ------------------------------------------------------------------------- *)
+
+definition has_gmeasure (infixr "has'_gmeasure" 80) where
+  "s has_gmeasure m \<equiv> ((\<lambda>x. 1::real) has_integral m) s"
+
+definition gmeasurable :: "('n::ordered_euclidean_space) set \<Rightarrow> bool" where 
+  "gmeasurable s \<equiv> (\<exists>m. s has_gmeasure m)"
+
+lemma gmeasurableI[dest]:"s has_gmeasure m \<Longrightarrow> gmeasurable s"
+  unfolding gmeasurable_def by auto
+
+definition gmeasure where
+  "gmeasure s \<equiv> (if gmeasurable s then (SOME m. s has_gmeasure m) else 0)"
+
+lemma has_gmeasure_measure: "gmeasurable s \<longleftrightarrow> s has_gmeasure (gmeasure s)"
+  unfolding gmeasure_def gmeasurable_def
+  apply meson apply(subst if_P) defer apply(rule someI) by auto
+
+lemma has_gmeasure_measureI[intro]:"gmeasurable s \<Longrightarrow> s has_gmeasure (gmeasure s)"
+  using has_gmeasure_measure by auto
+  
+lemma has_gmeasure_unique: "s has_gmeasure m1 \<Longrightarrow> s has_gmeasure m2 \<Longrightarrow> m1 = m2"
+  unfolding has_gmeasure_def apply(rule has_integral_unique) by auto
+
+lemma measure_unique[intro]: assumes "s has_gmeasure m" shows "gmeasure s = m"
+  apply(rule has_gmeasure_unique[OF _ assms]) using assms 
+  unfolding has_gmeasure_measure[THEN sym] by auto
+
+lemma has_gmeasure_measurable_measure:
+ "s has_gmeasure m \<longleftrightarrow> gmeasurable s \<and> gmeasure s = m"
+  by(auto intro!:measure_unique simp:has_gmeasure_measure[THEN sym])
+
+lemmas has_gmeasure_imp_measurable = gmeasurableI
+
+lemma has_gmeasure:
+ "s has_gmeasure m \<longleftrightarrow> ((\<lambda>x. if x \<in> s then 1 else 0) has_integral m) UNIV"
+  unfolding has_integral_restrict_univ has_gmeasure_def ..
+
+lemma gmeasurable: "gmeasurable s \<longleftrightarrow> (\<lambda>x. 1::real) integrable_on s"
+  unfolding gmeasurable_def integrable_on_def has_gmeasure_def by auto
+
+lemma gmeasurable_integrable:
+ "gmeasurable s \<longleftrightarrow> (\<lambda>x. if x \<in> s then 1 else (0::real)) integrable_on UNIV"
+  unfolding gmeasurable_def integrable_on_def has_gmeasure ..
+
+lemma measure_integral:
+  assumes "gmeasurable s" shows "gmeasure s = (integral s (\<lambda>x. 1))"
+  apply(rule integral_unique[THEN sym])
+  unfolding has_gmeasure_def[symmetric] using assms by auto 
+
+lemma measure_integral_univ: assumes "gmeasurable s"
+  shows "gmeasure s = (integral UNIV (\<lambda>x. if x \<in> s then 1 else 0))"
+  apply(rule integral_unique[THEN sym])
+  using assms by(auto simp:has_gmeasure[THEN sym])
+
+lemmas integral_measure = measure_integral[THEN sym]
+
+lemmas integral_measure_univ = measure_integral_univ[THEN sym]
+
+lemma has_gmeasure_interval[intro]:
+  "{a..b} has_gmeasure content{a..b}" (is ?t1)
+  "{a<..<b} has_gmeasure content{a..b}" (is ?t2)
+proof- show ?t1 unfolding has_gmeasure_def using has_integral_const[where c="1::real"] by auto
+  show ?t2 unfolding has_gmeasure apply(rule has_integral_spike[of "{a..b} - {a<..<b}",
+    where f="\<lambda>x. (if x \<in> {a..b} then 1 else 0)"]) apply(rule negligible_frontier_interval) 
+    using interval_open_subset_closed[of a b]
+    using `?t1` unfolding has_gmeasure by auto
+qed
+
+lemma gmeasurable_interval[intro]: "gmeasurable {a..b}" "gmeasurable {a<..<b}"
+  by(auto intro:gmeasurableI)
+
+lemma measure_interval[simp]: "gmeasure{a..b} = content{a..b}"  "gmeasure({a<..<b}) = content{a..b}"
+  by(auto intro:measure_unique)
+
+lemma nonnegative_absolutely_integrable: fixes f::"'n::ordered_euclidean_space \<Rightarrow> 'm::ordered_euclidean_space"
+  assumes "\<forall>x\<in>s. \<forall>i<DIM('m). 0 \<le> f(x)$$i" "f integrable_on s"
+  shows "f absolutely_integrable_on s"
+  unfolding absolutely_integrable_abs_eq apply rule defer
+  apply(rule integrable_eq[of _ f]) using assms apply-apply(subst euclidean_eq) by auto
+
+lemma gmeasurable_inter[dest]: assumes "gmeasurable s" "gmeasurable t" shows "gmeasurable (s \<inter> t)"
+proof- have *:"(\<lambda>x. if x \<in> s \<inter> t then 1 else (0::real)) =
+    (\<lambda>x. \<chi>\<chi> i. min (((if x \<in> s then 1 else 0)::real)$$i) (((if x \<in> t then 1 else 0)::real)$$i))"
+    apply(rule ext) by auto
+  show ?thesis unfolding gmeasurable_integrable apply(rule absolutely_integrable_onD)
+    unfolding * apply(rule absolutely_integrable_min)
+    apply(rule_tac[!] nonnegative_absolutely_integrable)
+    using assms unfolding gmeasurable_integrable by auto
+qed
+
+lemma gmeasurable_union: assumes "gmeasurable s" "gmeasurable t"
+  shows "gmeasurable (s \<union> t)"
+proof- have *:"(\<lambda>x. if x \<in> s \<union> t then 1 else (0::real)) =
+    (\<lambda>x. \<chi>\<chi> i. max (((if x \<in> s then 1 else 0)::real)$$i) (((if x \<in> t then 1 else 0)::real)$$i)) "
+    by(rule ext,auto)
+  show ?thesis unfolding gmeasurable_integrable apply(rule absolutely_integrable_onD)
+    unfolding * apply(rule absolutely_integrable_max)
+    apply(rule_tac[!]nonnegative_absolutely_integrable)
+    using assms unfolding gmeasurable_integrable by auto
+qed
+
+lemma has_gmeasure_disjoint_union: 
+  assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "s1 \<inter> s2 = {}"
+  shows "(s1 \<union> s2) has_gmeasure (m1 + m2)"
+proof- have *:"\<And>x. (if x \<in> s1 then 1 else 0) + (if x \<in> s2 then 1 else 0) =
+    (if x \<in> s1 \<union> s2 then 1 else (0::real))" using assms(3) by auto
+  show ?thesis using has_integral_add[OF assms(1-2)[unfolded has_gmeasure]]
+    unfolding has_gmeasure * .
+qed
+
+lemma measure_disjoint_union: assumes "gmeasurable s" "gmeasurable t" "s \<inter> t = {}"
+  shows "gmeasure(s \<union> t) = gmeasure s + gmeasure t"
+  apply rule apply(rule has_gmeasure_disjoint_union) using assms by auto
+
+lemma has_gmeasure_pos_le[dest]: assumes "s has_gmeasure m" shows "0 \<le> m"
+  apply(rule has_integral_nonneg) using assms unfolding has_gmeasure by auto
+
+lemma not_measurable_measure:"\<not> gmeasurable s \<Longrightarrow> gmeasure s = 0"
+  unfolding gmeasure_def if_not_P ..
+
+lemma measure_pos_le[intro]: "0 <= gmeasure s"
+  apply(cases "gmeasurable s") unfolding not_measurable_measure
+  unfolding has_gmeasure_measure by auto
+
+lemma has_gmeasure_subset[dest]:
+  assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "s1 \<subseteq> s2"
+  shows "m1 <= m2"
+  using has_integral_subset_le[OF assms(3,1,2)[unfolded has_gmeasure_def]] by auto
+
+lemma measure_subset[dest]: assumes "gmeasurable s" "gmeasurable t" "s \<subseteq> t"
+  shows "gmeasure s \<le> gmeasure t"
+  using assms unfolding has_gmeasure_measure by auto
+
+lemma has_gmeasure_0:"s has_gmeasure 0 \<longleftrightarrow> negligible s" (is "?l = ?r")
+proof assume ?r thus ?l unfolding indicator_def_raw negligible apply(erule_tac x="UNIV" in allE)
+    unfolding has_integral_restrict_univ has_gmeasure_def .
+next assume ?l note this[unfolded has_gmeasure_def has_integral_alt']
+  note * = conjunctD2[OF this,rule_format]
+  show ?r unfolding negligible_def 
+  proof safe case goal1
+    from *(1)[of a b,unfolded integrable_on_def] guess y apply-
+      apply(subst (asm) has_integral_restrict_univ[THEN sym]) by (erule exE) note y=this
+    have "0 \<le> y" apply(rule has_integral_nonneg[OF y]) by auto
+    moreover have "y \<le> 0" apply(rule has_integral_le[OF y]) 
+      apply(rule `?l`[unfolded has_gmeasure_def has_integral_restrict_univ[THEN sym,of"\<lambda>x. 1"]]) by auto
+    ultimately have "y = 0" by auto
+    thus ?case using y unfolding has_integral_restrict_univ indicator_def_raw by auto
+  qed
+qed
+
+lemma measure_eq_0: "negligible s ==> gmeasure s = 0"
+  apply(rule measure_unique) unfolding has_gmeasure_0 by auto
+
+lemma has_gmeasure_empty[intro]: "{} has_gmeasure 0"
+  unfolding has_gmeasure_0 by auto
+
+lemma measure_empty[simp]: "gmeasure {} = 0"
+  apply(rule measure_eq_0) by auto
+
+lemma gmeasurable_empty[intro]: "gmeasurable {}" by(auto intro:gmeasurableI)
+
+lemma gmeasurable_measure_eq_0:
+  "gmeasurable s ==> (gmeasure s = 0 \<longleftrightarrow> negligible s)"
+  unfolding has_gmeasure_measure has_gmeasure_0[THEN sym] by(auto intro:measure_unique)
+
+lemma gmeasurable_measure_pos_lt:
+ "gmeasurable s ==> (0 < gmeasure s \<longleftrightarrow> ~negligible s)"
+  unfolding gmeasurable_measure_eq_0[THEN sym]
+  using measure_pos_le[of s] unfolding le_less by fastsimp
+
+lemma negligible_interval:True .. (*
+ "(!a b. negligible{a..b} \<longleftrightarrow> {a<..<b} = {}) \<and>
+   (!a b. negligible({a<..<b}) \<longleftrightarrow> {a<..<b} = {})"
+qed   REWRITE_TAC[GSYM HAS_GMEASURE_0] THEN
+  MESON_TAC[HAS_GMEASURE_INTERVAL; CONTENT_EQ_0_INTERIOR;
+            INTERIOR_CLOSED_INTERVAL; HAS_GMEASURE_UNIQUE]);;*)
+
+lemma gmeasurable_finite_unions:
+  assumes "finite f" "\<And>s. s \<in> f \<Longrightarrow> gmeasurable s"
+  shows "gmeasurable (\<Union> f)" using assms(1,2) 
+proof induct case (insert s F)
+  show ?case unfolding Union_insert apply(rule gmeasurable_union)
+    using insert by auto
+qed auto  
+
+lemma has_gmeasure_diff_subset: assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "s2 \<subseteq> s1"
+  shows "(s1 - s2) has_gmeasure (m1 - m2)"
+proof- have *:"(\<lambda>x. (if x \<in> s1 then 1 else 0) - (if x \<in> s2 then 1 else (0::real))) =
+    (\<lambda>x. if x \<in> s1 - s2 then 1 else 0)" apply(rule ext) using assms(3) by auto
+  show ?thesis using has_integral_sub[OF assms(1-2)[unfolded has_gmeasure]] 
+    unfolding has_gmeasure * . 
+qed
+
+lemma gmeasurable_diff: assumes "gmeasurable s" "gmeasurable t" 
+  shows "gmeasurable (s - t)"
+proof- have *:"\<And>s t. gmeasurable s \<Longrightarrow> gmeasurable t \<Longrightarrow> t \<subseteq> s ==> gmeasurable (s - t)"
+    unfolding gmeasurable_def apply(erule exE)+ apply(rule,rule has_gmeasure_diff_subset)
+    by assumption+
+  have **:"s - t = s - (s \<inter> t)" by auto
+  show ?thesis unfolding ** apply(rule *) using assms by auto
+qed
+
+lemma measure_diff_subset: True .. (*
+ "!s t. gmeasurable s \<and> gmeasurable t \<and> t \<subseteq> s
+         ==> measure(s DIFF t) = gmeasure s - gmeasure t"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_DIFF_SUBSET; GSYM HAS_GMEASURE_MEASURE]);; *)
+
+lemma has_gmeasure_union_negligible[dest]:
+  assumes "s has_gmeasure m" "negligible t"
+  shows "(s \<union> t) has_gmeasure m" unfolding has_gmeasure
+  apply(rule has_integral_spike[OF assms(2) _ assms(1)[unfolded has_gmeasure]]) by auto
+
+lemma has_gmeasure_diff_negligible[dest]:
+  assumes "s has_gmeasure m" "negligible t" 
+  shows "(s - t) has_gmeasure m" unfolding has_gmeasure
+  apply(rule has_integral_spike[OF assms(2) _ assms(1)[unfolded has_gmeasure]]) by auto
+
+lemma has_gmeasure_union_negligible_eq: True .. (*
+ "!s t:real^N->bool m.
+     negligible t ==> ((s \<union> t) has_gmeasure m \<longleftrightarrow> s has_gmeasure m)"
+qed   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_UNION_NEGLIGIBLE] THEN
+  SUBST1_TAC(SET_RULE `s:real^N->bool = (s \<union> t) DIFF (t DIFF s)`) THEN
+  MATCH_MP_TAC HAS_GMEASURE_DIFF_NEGLIGIBLE THEN ASM_REWRITE_TAC[] THEN
+  MATCH_MP_TAC NEGLIGIBLE_DIFF THEN ASM_REWRITE_TAC[]);; *)
+
+lemma has_gmeasure_diff_negligible_eq: True .. (*
+ "!s t:real^N->bool m.
+     negligible t ==> ((s DIFF t) has_gmeasure m \<longleftrightarrow> s has_gmeasure m)"
+qed   REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_DIFF_NEGLIGIBLE] THEN
+  SUBST1_TAC(SET_RULE `s:real^N->bool = (s DIFF t) \<union> (t \<inter> s)`) THEN
+  MATCH_MP_TAC HAS_GMEASURE_UNION_NEGLIGIBLE THEN
+  ASM_SIMP_TAC[NEGLIGIBLE_INTER]);; *)
+
+lemma has_gmeasure_almost: assumes "s has_gmeasure m" "negligible t" "s \<union> t = s' \<union> t"
+  shows "s' has_gmeasure m"
+proof- have *:"s' \<union> t - (t - s') = s'" by blast
+  show ?thesis using has_gmeasure_union_negligible[OF assms(1-2)] unfolding assms(3)
+    apply-apply(drule has_gmeasure_diff_negligible[where t="t - s'"])
+    apply(rule negligible_diff) using assms(2) unfolding * by auto
+qed
+
+lemma has_gmeasure_almost_eq: True .. (*
+ "!s s' t. negligible t \<and> s \<union> t = s' \<union> t
+            ==> (s has_gmeasure m \<longleftrightarrow> s' has_gmeasure m)"
+qed   MESON_TAC[HAS_GMEASURE_ALMOST]);; *)
+
+lemma gmeasurable_almost: True .. (*
+ "!s s' t. gmeasurable s \<and> negligible t \<and> s \<union> t = s' \<union> t
+            ==> gmeasurable s'"
+qed   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_GMEASURE_ALMOST]);; *)
+
+lemma has_gmeasure_negligible_union:
+  assumes "s1 has_gmeasure m1" "s2 has_gmeasure m2" "negligible(s1 \<inter> s2)"
+  shows "(s1 \<union> s2) has_gmeasure (m1 + m2)" 
+  apply(rule has_gmeasure_almost[of "(s1 - (s1 \<inter> s2)) \<union> (s2 - (s1 \<inter> s2))" _ "s1 \<inter> s2"])
+  apply(rule has_gmeasure_disjoint_union)
+  apply(rule has_gmeasure_almost[of s1,OF _ assms(3)]) prefer 3
+  apply(rule has_gmeasure_almost[of s2,OF _ assms(3)])
+  using assms by auto
+
+lemma measure_negligible_union: True .. (*
+  "!s t. gmeasurable s \<and> gmeasurable t \<and> negligible(s \<inter> t)
+         ==> measure(s \<union> t) = gmeasure s + gmeasure t"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_NEGLIGIBLE_UNION; GSYM HAS_GMEASURE_MEASURE]);; *)
+
+lemma has_gmeasure_negligible_symdiff: True .. (*
+ "!s t:real^N->bool m.
+        s has_gmeasure m \<and>
+        negligible((s DIFF t) \<union> (t DIFF s))
+        ==> t has_gmeasure m"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_GMEASURE_ALMOST THEN
+  MAP_EVERY EXISTS_TAC
+   [`s:real^N->bool`; `(s DIFF t) \<union> (t DIFF s):real^N->bool`] THEN
+  ASM_REWRITE_TAC[] THEN SET_TAC[]);; *)
+
+lemma gmeasurable_negligible_symdiff: True .. (*
+ "!s t:real^N->bool.
+        gmeasurable s \<and> negligible((s DIFF t) \<union> (t DIFF s))
+        ==> gmeasurable t"
+qed   REWRITE_TAC[measurable] THEN
+  MESON_TAC[HAS_GMEASURE_NEGLIGIBLE_SYMDIFF]);; *)
+
+lemma measure_negligible_symdiff: True .. (*
+ "!s t:real^N->bool.
+        (measurable s \/ gmeasurable t) \<and>
+        negligible((s DIFF t) \<union> (t DIFF s))
+        ==> gmeasure s = gmeasure t"
+qed   MESON_TAC[HAS_GMEASURE_NEGLIGIBLE_SYMDIFF; MEASURE_UNIQUE; UNION_COMM;
+                HAS_GMEASURE_MEASURE]);; *)
+
+lemma has_gmeasure_negligible_unions: assumes "finite f"
+  "\<And>s. s \<in> f ==> s has_gmeasure (m s)"
+  "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> ~(s = t) ==> negligible(s \<inter> t)"
+  shows "(\<Union> f) has_gmeasure (setsum m f)" using assms
+proof induct case (insert x s)
+  have *:"(x \<inter> \<Union>s) = \<Union>{x \<inter> y| y. y\<in>s}"by auto
+  show ?case unfolding Union_insert ring_class.setsum.insert[OF insert(1-2)] 
+    apply(rule has_gmeasure_negligible_union) unfolding *
+    apply(rule insert) defer apply(rule insert) apply(rule insert) defer
+    apply(rule insert) prefer 4 apply(rule negligible_unions)
+    defer apply safe apply(rule insert) using insert by auto
+qed auto
+
+lemma measure_negligible_unions: 
+  assumes "finite f" "\<And>s. s \<in> f ==> s has_gmeasure (m s)"
+  "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> negligible(s \<inter> t)"
+  shows "gmeasure(\<Union> f) = setsum m f"
+  apply rule apply(rule has_gmeasure_negligible_unions)
+  using assms by auto
+
+lemma has_gmeasure_disjoint_unions:
+  assumes"finite f" "\<And>s. s \<in> f ==> s has_gmeasure (m s)"
+  "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> s \<inter> t = {}"
+  shows "(\<Union> f) has_gmeasure (setsum m f)"
+  apply(rule has_gmeasure_negligible_unions[OF assms(1-2)]) using assms(3) by auto
+
+lemma measure_disjoint_unions: 
+  assumes "finite f" "\<And>s. s \<in> f ==> s has_gmeasure (m s)" 
+  "\<And>s t. s \<in> f \<Longrightarrow> t \<in> f \<Longrightarrow> s \<noteq> t ==> s \<inter> t = {}"
+  shows "gmeasure(\<Union> f) = setsum m f"
+  apply rule apply(rule has_gmeasure_disjoint_unions[OF assms]) by auto
+
+lemma has_gmeasure_negligible_unions_image:
+  assumes "finite s" "\<And>x. x \<in> s ==> gmeasurable(f x)"
+  "\<And>x y. x \<in> s \<Longrightarrow> y \<in> s \<Longrightarrow> x \<noteq> y \<Longrightarrow> negligible((f x) \<inter> (f y))"
+  shows "(\<Union> (f ` s)) has_gmeasure (setsum (\<lambda>x. gmeasure(f x)) s)"
+proof- have *:"setsum (\<lambda>x. gmeasure(f x)) s = setsum gmeasure (f ` s)"
+    apply(subst setsum_reindex_nonzero) defer
+    apply(subst gmeasurable_measure_eq_0)
+  proof- case goal2 thus ?case using assms(3)[of x y] by auto
+  qed(insert assms, auto)
+  show ?thesis unfolding * apply(rule has_gmeasure_negligible_unions) using assms by auto
+qed
+
+lemma measure_negligible_unions_image: True .. (*
+ "!f:A->real^N->bool s.
+        FINITE s \<and>
+        (!x. x \<in> s ==> gmeasurable(f x)) \<and>
+        (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> negligible((f x) \<inter> (f y)))
+        ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE]);;*)
+
+lemma has_gmeasure_disjoint_unions_image: True .. (*
+ "!f:A->real^N->bool s.
+        FINITE s \<and>
+        (!x. x \<in> s ==> gmeasurable(f x)) \<and>
+        (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
+        ==> (UNIONS (IMAGE f s)) has_gmeasure (sum s (\<lambda>x. measure(f x)))"
+qed   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
+  MATCH_MP_TAC HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
+  ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);;*)
+
+lemma measure_disjoint_unions_image: True .. (*
+ "!f:A->real^N->bool s.
+        FINITE s \<and>
+        (!x. x \<in> s ==> gmeasurable(f x)) \<and>
+        (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
+        ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_DISJOINT_UNIONS_IMAGE]);;*)
+
+lemma has_gmeasure_negligible_unions_image_strong: True .. (*
+ "!f:A->real^N->bool s.
+        FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
+        (!x. x \<in> s ==> gmeasurable(f x)) \<and>
+        (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> negligible((f x) \<inter> (f y)))
+        ==> (UNIONS (IMAGE f s)) has_gmeasure (sum s (\<lambda>x. measure(f x)))"
+qed   REPEAT STRIP_TAC THEN
+  MP_TAC(ISPECL [`f:A->real^N->bool`;
+                 `{x | x \<in> s \<and> ~((f:A->real^N->bool) x = {})}`]
+        HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
+  ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN
+  MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL
+   [GEN_REWRITE_TAC I [EXTENSION] THEN
+    REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN
+    MESON_TAC[NOT_IN_EMPTY];
+    CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
+    SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a \<and> ~(a \<and> b) \<longleftrightarrow> a \<and> ~b`] THEN
+    REWRITE_TAC[MEASURE_EMPTY]]);; *)
+
+lemma measure_negligible_unions_image_strong: True .. (*
+ "!f:A->real^N->bool s.
+        FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
+        (!x. x \<in> s ==> gmeasurable(f x)) \<and>
+        (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> negligible((f x) \<inter> (f y)))
+        ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);; *)
+
+lemma has_gmeasure_disjoint_unions_image_strong: True .. (*
+ "!f:A->real^N->bool s.
+        FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
+        (!x. x \<in> s ==> gmeasurable(f x)) \<and>
+        (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
+        ==> (UNIONS (IMAGE f s)) has_gmeasure (sum s (\<lambda>x. measure(f x)))"
+qed   REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN
+  MATCH_MP_TAC HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
+  ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; *)
+
+lemma measure_disjoint_unions_image_strong: True .. (*
+ "!f:A->real^N->bool s.
+        FINITE {x | x \<in> s \<and> ~(f x = {})} \<and>
+        (!x. x \<in> s ==> gmeasurable(f x)) \<and>
+        (!x y. x \<in> s \<and> y \<in> s \<and> ~(x = y) ==> DISJOINT (f x) (f y))
+        ==> measure(UNIONS (IMAGE f s)) = sum s (\<lambda>x. measure(f x))"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);; *)
+
+lemma measure_union: True .. (*
+ "!s t:real^N->bool.
+        gmeasurable s \<and> gmeasurable t
+        ==> measure(s \<union> t) = measure(s) + measure(t) - measure(s \<inter> t)"
+qed   REPEAT STRIP_TAC THEN
+  ONCE_REWRITE_TAC[SET_RULE
+   `s \<union> t = (s \<inter> t) \<union> (s DIFF t) \<union> (t DIFF s)`] THEN
+  ONCE_REWRITE_TAC[REAL_ARITH `a + b - c = c + (a - c) + (b - c)`] THEN
+  MP_TAC(ISPECL [`s DIFF t:real^N->bool`; `t DIFF s:real^N->bool`]
+        MEASURE_DISJOINT_UNION) THEN
+  ASM_SIMP_TAC[MEASURABLE_DIFF] THEN
+  ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
+  MP_TAC(ISPECL [`s \<inter> t:real^N->bool`;
+                 `(s DIFF t) \<union> (t DIFF s):real^N->bool`]
+                MEASURE_DISJOINT_UNION) THEN
+  ASM_SIMP_TAC[MEASURABLE_DIFF; GMEASURABLE_UNION; GMEASURABLE_INTER] THEN
+  ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
+  REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN
+  REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL
+   [EXISTS_TAC `measure((s DIFF t) \<union> (s \<inter> t):real^N->bool)`;
+    EXISTS_TAC `measure((t DIFF s) \<union> (s \<inter> t):real^N->bool)`] THEN
+  (CONJ_TAC THENL
+    [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION THEN
+     ASM_SIMP_TAC[MEASURABLE_DIFF; GMEASURABLE_INTER];
+     AP_TERM_TAC] THEN
+   SET_TAC[]));; *)
+
+lemma measure_union_le: True .. (*
+ "!s t:real^N->bool.
+        gmeasurable s \<and> gmeasurable t
+        ==> measure(s \<union> t) <= gmeasure s + gmeasure t"
+qed   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURE_UNION] THEN
+  REWRITE_TAC[REAL_ARITH `a + b - c <= a + b \<longleftrightarrow> 0 <= c`] THEN
+  MATCH_MP_TAC MEASURE_POS_LE THEN ASM_SIMP_TAC[MEASURABLE_INTER]);; *)
+
+lemma measure_unions_le: True .. (*
+ "!f:(real^N->bool)->bool.
+        FINITE f \<and> (!s. s \<in> f ==> gmeasurable s)
+        ==> measure(UNIONS f) <= sum f (\<lambda>s. gmeasure s)"
+qed   REWRITE_TAC[IMP_CONJ] THEN
+  MATCH_MP_TAC FINITE_INDUCT_STRONG THEN
+  SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN
+  REWRITE_TAC[MEASURE_EMPTY; REAL_LE_REFL] THEN
+  MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN
+  REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN
+  MATCH_MP_TAC REAL_LE_TRANS THEN
+  EXISTS_TAC `measure(s:real^N->bool) + measure(UNIONS f:real^N->bool)` THEN
+  ASM_SIMP_TAC[MEASURE_UNION_LE; GMEASURABLE_UNIONS] THEN
+  REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
+  ASM_SIMP_TAC[]);; *)
+
+lemma measure_unions_le_image: True .. (*
+ "!f:A->bool s:A->(real^N->bool).
+        FINITE f \<and> (!a. a \<in> f ==> gmeasurable(s a))
+        ==> measure(UNIONS (IMAGE s f)) <= sum f (\<lambda>a. measure(s a))"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN
+  EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\<lambda>k:real^N->bool. gmeasure k)` THEN
+  ASM_SIMP_TAC[MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN
+  GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN
+  REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN
+  ASM_SIMP_TAC[MEASURE_POS_LE]);; *)
+
+lemma gmeasurable_inner_outer: True .. (*
+ "!s:real^N->bool.
+        gmeasurable s \<longleftrightarrow>
+                !e. 0 < e
+                    ==> ?t u. t \<subseteq> s \<and> s \<subseteq> u \<and>
+                              gmeasurable t \<and> gmeasurable u \<and>
+                              abs(measure t - gmeasure u) < e"
+qed   GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
+   [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real^N->bool`) THEN
+    ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM];
+    ALL_TAC] THEN
+  REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN
+  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
+  FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN
+  ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+  MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN
+  MAP_EVERY EXISTS_TAC
+   [`(\<lambda>x. if x \<in> t then 1 else 0):real^N->real^1`;
+    `(\<lambda>x. if x \<in> u then 1 else 0):real^N->real^1`;
+    `lift(measure(t:real^N->bool))`;
+    `lift(measure(u:real^N->bool))`] THEN
+  ASM_REWRITE_TAC[GSYM HAS_GMEASURE; GSYM HAS_GMEASURE_MEASURE] THEN
+  ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN
+  REPEAT(COND_CASES_TAC THEN
+         ASM_REWRITE_TAC[_VEC; REAL_POS; REAL_LE_REFL]) THEN
+  ASM SET_TAC[]);; *)
+
+lemma has_gmeasure_inner_outer: True .. (*
+ "!s:real^N->bool m.
+        s has_gmeasure m \<longleftrightarrow>
+                (!e. 0 < e ==> ?t. t \<subseteq> s \<and> gmeasurable t \<and>
+                                    m - e < gmeasure t) \<and>
+                (!e. 0 < e ==> ?u. s \<subseteq> u \<and> gmeasurable u \<and>
+                                    gmeasure u < m + e)"
+qed   REPEAT GEN_TAC THEN
+  GEN_REWRITE_TAC LAND_CONV [HAS_GMEASURE_MEASURABLE_MEASURE] THEN EQ_TAC THENL
+   [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real^N->bool` THEN
+    ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC;
+    ALL_TAC] THEN
+  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN
+  MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
+   [GEN_REWRITE_TAC I [MEASURABLE_INNER_OUTER] THEN
+    X_GEN_TAC `e:real` THEN DISCH_TAC THEN
+    REMOVE_THEN "u" (MP_TAC o SPEC `e / 2`) THEN
+    REMOVE_THEN "t" (MP_TAC o SPEC `e / 2`) THEN
+    ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN
+    REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN
+    REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN
+    REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN
+    STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH
+     `0 < e \<and> t <= u \<and> m - e / 2 < t \<and> u < m + e / 2
+                          ==> abs(t - u) < e`) THEN
+    ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN
+    ASM_REWRITE_TAC[] THEN ASM SET_TAC[];
+    DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH
+     `~(0 < x - y) \<and> ~(0 < y - x) ==> x = y`) THEN
+    CONJ_TAC THEN DISCH_TAC THENL
+     [REMOVE_THEN "u" (MP_TAC o SPEC `measure(s:real^N->bool) - m`) THEN
+      ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE];
+      REMOVE_THEN "t" (MP_TAC o SPEC `m - measure(s:real^N->bool)`) THEN
+      ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN
+    ASM_MESON_TAC[MEASURE_SUBSET]]);; *)
+
+lemma has_gmeasure_inner_outer_le: True .. (*
+ "!s:real^N->bool m.
+        s has_gmeasure m \<longleftrightarrow>
+                (!e. 0 < e ==> ?t. t \<subseteq> s \<and> gmeasurable t \<and>
+                                    m - e <= gmeasure t) \<and>
+                (!e. 0 < e ==> ?u. s \<subseteq> u \<and> gmeasurable u \<and>
+                                    gmeasure u <= m + e)"
+qed   REWRITE_TAC[HAS_GMEASURE_INNER_OUTER] THEN
+  MESON_TAC[REAL_ARITH `0 < e \<and> m - e / 2 <= t ==> m - e < t`;
+            REAL_ARITH `0 < e \<and> u <= m + e / 2 ==> u < m + e`;
+            REAL_ARITH `0 < e \<longleftrightarrow> 0 < e / 2`; REAL_LT_IMP_LE]);; *)
+
+lemma has_gmeasure_limit: True .. (*
+ "!s. s has_gmeasure m \<longleftrightarrow>
+        !e. 0 < e
+            ==> ?B. 0 < B \<and>
+                    !a b. ball(0,B) \<subseteq> {a..b}
+                          ==> ?z. (s \<inter> {a..b}) has_gmeasure z \<and>
+                                  abs(z - m) < e"
+qed   GEN_TAC THEN REWRITE_TAC[HAS_GMEASURE] THEN
+  GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL] THEN
+  REWRITE_TAC[IN_UNIV] THEN
+  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)
+    [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
+  REWRITE_TAC[MESON[IN_INTER]
+        `(if x \<in> k \<inter> s then a else b) =
+         (if x \<in> s then if x \<in> k then a else b else b)`] THEN
+  REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; NORM_LIFT]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* properties of gmeasure under simple affine transformations.                *)
+(* ------------------------------------------------------------------------- *)
+
+lemma has_gmeasure_affinity: True .. (*
+ "!s m c y. s has_gmeasure y
+             ==> (IMAGE (\<lambda>x:real^N. m % x + c) s)
+                 has_gmeasure abs(m) pow (dimindex(:N)) * y"
+qed   REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THENL
+   [ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN
+    ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(x = 0) ==> x = SUC(x - 1)`)
+     (SPEC_ALL DIMINDEX_NONZERO)] THEN DISCH_TAC THEN
+    REWRITE_TAC[real_pow; REAL_MUL_LZERO; HAS_GMEASURE_0] THEN
+    MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{c:real^N}` THEN
+    SIMP_TAC[NEGLIGIBLE_FINITE; FINITE_RULES] THEN SET_TAC[];
+    ALL_TAC] THEN
+  REWRITE_TAC[HAS_GMEASURE] THEN
+  ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
+  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
+  FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(m) pow dimindex(:N)`) THEN
+  ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
+  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
+  EXISTS_TAC `abs(m) * B + norm(c:real^N)` THEN
+  ASM_SIMP_TAC[REAL_ARITH `0 < B \<and> 0 <= x ==> 0 < B + x`;
+               NORM_POS_LE; REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN
+  MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
+  REWRITE_TAC[IN_IMAGE] THEN
+  ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; UNWIND_THM1] THEN
+  FIRST_X_ASSUM(MP_TAC o SPECL
+    [`if 0 <= m then inv m % u + --(inv m % c):real^N
+                 else inv m % v + --(inv m % c)`;
+     `if 0 <= m then inv m % v + --(inv m % c):real^N
+                 else inv m % u + --(inv m % c)`]) THEN
+  MATCH_MP_TAC(TAUT `a \<and> (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN
+  CONJ_TAC THENL
+   [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN
+    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN
+    DISCH_THEN(MP_TAC o SPEC `m % x + c:real^N`) THEN
+    MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[IN_BALL; IN_INTERVAL] THEN
+    CONJ_TAC THENL
+     [REWRITE_TAC[NORM_ARITH `dist(0,x) = norm(x:real^N)`] THEN
+      DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH
+       `norm(x:real^N) < a ==> norm(x + y) < a + norm(y)`) THEN
+      ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL; GSYM REAL_ABS_NZ];
+      ALL_TAC] THEN
+    SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT;
+             COND_COMPONENT] THEN
+    MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN
+    REWRITE_TAC[REAL_ARITH `m * u + --(m * c):real = (u - c) * m`] THEN
+    SUBST1_TAC(REAL_ARITH
+      `inv(m) = if 0 <= inv(m) then abs(inv m) else --(abs(inv m))`) THEN
+    SIMP_TAC[REAL_LE_INV_EQ] THEN
+    REWRITE_TAC[REAL_ARITH `(x - y:real) * --z = (y - x) * z`] THEN
+    REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN COND_CASES_TAC THEN
+    ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN
+    ASM_REWRITE_TAC[real_abs] THEN REAL_ARITH_TAC;
+    ALL_TAC] THEN
+  REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `0:real^N`) THEN
+  ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_TAC THEN
+  DISCH_THEN(X_CHOOSE_THEN `z:real^1`
+   (fun th -> EXISTS_TAC `(abs m pow dimindex (:N)) % z:real^1` THEN
+              MP_TAC th)) THEN
+  DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
+  FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_FIELD `~(x = 0) ==> ~(inv x = 0)`)) THEN
+  REWRITE_TAC[TAUT `a ==> b ==> c \<longleftrightarrow> b \<and> a ==> c`] THEN
+  DISCH_THEN(MP_TAC o SPEC `--(inv m % c):real^N` o
+    MATCH_MP HAS_INTEGRAL_AFFINITY) THEN
+  ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV] THEN
+  SIMP_TAC[COND_ID] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
+  REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC;
+               VECTOR_MUL_LNEG; VECTOR_MUL_RNEG] THEN
+  ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_NEG_NEG] THEN
+  REWRITE_TAC[VECTOR_ARITH `(u + --c) + c:real^N = u`] THEN
+  REWRITE_TAC[REAL_ABS_INV; REAL_INV_INV; GSYM REAL_POW_INV] THEN
+  DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN
+  REWRITE_TAC[LIFT_CMUL; GSYM VECTOR_SUB_LDISTRIB] THEN
+  REWRITE_TAC[NORM_MUL; REAL_ABS_POW; REAL_ABS_ABS] THEN
+  ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
+  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_POW_LT; GSYM REAL_ABS_NZ]);; *)
+
+lemma stretch_galois: True .. (*
+ "!x:real^N y:real^N m.
+        (!k. 1 <= k \<and> k <= dimindex(:N) ==>  ~(m k = 0))
+        ==> ((y = (lambda k. m k * x$k)) \<longleftrightarrow> (lambda k. inv(m k) * y$k) = x)"
+qed   REPEAT GEN_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
+  MATCH_MP_TAC(MESON[]
+   `(!x. p x ==> (q x \<longleftrightarrow> r x))
+    ==> (!x. p x) ==> ((!x. q x) \<longleftrightarrow> (!x. r x))`) THEN
+  GEN_TAC THEN ASM_CASES_TAC `1 <= k \<and> k <= dimindex(:N)` THEN
+  ASM_REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);; *)
+
+lemma has_gmeasure_stretch: True .. (*
+ "!s m y. s has_gmeasure y
+           ==> (IMAGE (\<lambda>x:real^N. lambda k. m k * x$k) s :real^N->bool)
+               has_gmeasure abs(product (1..dimindex(:N)) m) * y"
+qed   REPEAT STRIP_TAC THEN ASM_CASES_TAC
+   `!k. 1 <= k \<and> k <= dimindex(:N) ==> ~(m k = 0)`
+  THENL
+   [ALL_TAC;
+    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN
+    REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM] THEN
+    X_GEN_TAC `k:num` THEN STRIP_TAC THEN
+    SUBGOAL_THEN `product(1..dimindex (:N)) m = 0` SUBST1_TAC THENL
+     [ASM_MESON_TAC[PRODUCT_EQ_0_NUMSEG]; ALL_TAC] THEN
+    REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO; HAS_GMEASURE_0] THEN
+    MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+    EXISTS_TAC `{x:real^N | x$k = 0}` THEN
+    ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; SUBSET; FORALL_IN_IMAGE] THEN
+    ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; REAL_MUL_LZERO]] THEN
+  UNDISCH_TAC `(s:real^N->bool) has_gmeasure y` THEN
+  REWRITE_TAC[HAS_GMEASURE] THEN
+  ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN
+  DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN
+  SUBGOAL_THEN `0 < abs(product(1..dimindex(:N)) m)` ASSUME_TAC THENL
+   [ASM_MESON_TAC[REAL_ABS_NZ; REAL_LT_DIV; PRODUCT_EQ_0_NUMSEG];
+    ALL_TAC] THEN
+  FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(product(1..dimindex(:N)) m)`) THEN
+  ASM_SIMP_TAC[REAL_LT_DIV] THEN
+  DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN
+  EXISTS_TAC `sup(IMAGE (\<lambda>k. abs(m k) * B) (1..dimindex(:N)))` THEN
+  MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
+   [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; NUMSEG_EMPTY; FINITE_NUMSEG;
+                 IN_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1; IMAGE_EQ_EMPTY;
+                 EXISTS_IN_IMAGE] THEN
+    ASM_MESON_TAC[IN_NUMSEG; DIMINDEX_GE_1; LE_REFL; REAL_LT_MUL; REAL_ABS_NZ];
+    DISCH_TAC] THEN
+  MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN
+  ASM_SIMP_TAC[IN_IMAGE; STRETCH_GALOIS; UNWIND_THM1] THEN
+  FIRST_X_ASSUM(MP_TAC o SPECL
+    [`(lambda k. min (inv(m k) * (u:real^N)$k)
+                     (inv(m k) * (v:real^N)$k)):real^N`;
+     `(lambda k. max (inv(m k) * (u:real^N)$k)
+                 (inv(m k) * (v:real^N)$k)):real^N`]) THEN
+  MATCH_MP_TAC(TAUT `a \<and> (b ==> a ==> c) ==> (a ==> b) ==> c`) THEN
+  CONJ_TAC THENL
+   [ALL_TAC;
+    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^1` THEN
+    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN
+    SUBGOAL_THEN `!k. 1 <= k \<and> k <= dimindex (:N) ==> ~(inv(m k) = 0)`
+    MP_TAC THENL [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN
+    ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN
+    DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_STRETCH)] THEN
+  (MP_TAC(ISPECL [`u:real^N`; `v:real^N`; `\i:num. inv(m i)`]
+    IMAGE_STRETCH_INTERVAL) THEN
+   SUBGOAL_THEN `~(interval[u:real^N,v] = {})` ASSUME_TAC THENL
+    [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
+      `s \<subseteq> t ==> ~(s = {}) ==> ~(t = {})`)) THEN
+     ASM_REWRITE_TAC[BALL_EQ_EMPTY; GSYM REAL_NOT_LT];
+     ALL_TAC] THEN
+   ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM))
+  THENL
+   [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE
+     `b \<subseteq> s ==> b' \<subseteq> IMAGE f b ==> b' \<subseteq> IMAGE f s`)) THEN
+    REWRITE_TAC[IN_BALL; SUBSET; NORM_ARITH `dist(0,x) = norm x`;
+                IN_IMAGE] THEN
+    ASM_SIMP_TAC[STRETCH_GALOIS; REAL_INV_EQ_0; UNWIND_THM1; REAL_INV_INV] THEN
+    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
+    MATCH_MP_TAC REAL_LET_TRANS THEN
+    EXISTS_TAC
+     `norm(sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N))) % x:real^N)` THEN
+    CONJ_TAC THENL
+     [MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN
+      SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; REAL_ABS_MUL] THEN
+      REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN
+      REWRITE_TAC[REAL_ABS_POS] THEN
+      MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN
+      ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
+                  NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
+      REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[REAL_LE_REFL];
+      ALL_TAC] THEN
+    REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN
+    EXISTS_TAC `abs(sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N)))) * B` THEN
+    SUBGOAL_THEN `0 < sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N)))`
+    ASSUME_TAC THENL
+     [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
+                  NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
+      REWRITE_TAC[EXISTS_IN_IMAGE; GSYM REAL_ABS_NZ; IN_NUMSEG] THEN
+      ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL];
+      ALL_TAC] THEN
+    ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `0 < x ==> 0 < abs x`] THEN
+    MATCH_MP_TAC REAL_LE_TRANS THEN
+    EXISTS_TAC `sup(IMAGE(\<lambda>k. abs(m k)) (1..dimindex(:N))) * B` THEN
+    ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `0 < x ==> abs x <= x`] THEN
+    ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
+                  NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
+    ASM_SIMP_TAC[EXISTS_IN_IMAGE; REAL_LE_RMUL_EQ] THEN
+    ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY;
+                 NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN
+    MP_TAC(ISPEC `IMAGE (\<lambda>k. abs (m k)) (1..dimindex(:N))` SUP_FINITE) THEN
+    REWRITE_TAC[FORALL_IN_IMAGE] THEN
+    ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY;
+                 GSYM NOT_LE; DIMINDEX_GE_1] THEN
+    REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[];
+
+    MATCH_MP_TAC(MESON[]
+     `s = t \<and> P z ==> (f has_integral z) s ==> Q
+                       ==> ?w. (f has_integral w) t \<and> P w`) THEN
+    SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG; GSYM REAL_ABS_INV] THEN
+    REWRITE_TAC[REAL_INV_INV] THEN CONJ_TAC THENL
+     [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE
+       `(!x. f x = x) ==> IMAGE f s = s`) THEN
+      SIMP_TAC[o_THM; LAMBDA_BETA; CART_EQ] THEN
+      ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID];
+      REWRITE_TAC[ABS_; _SUB; LIFT_; _CMUL] THEN
+      REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; ETA_AX] THEN
+      REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_ABS] THEN
+      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
+      ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN
+      ASM_MESON_TAC[ABS_; _SUB; LIFT_]]]);; *)
+
+lemma has_gmeasure_translation: True .. (*
+ "!s m a. s has_gmeasure m ==> (IMAGE (\<lambda>x:real^N. a + x) s) has_gmeasure m"
+qed   REPEAT GEN_TAC THEN
+  MP_TAC(ISPECL [`s:real^N->bool`; `1`; `a:real^N`; `m:real`]
+                HAS_GMEASURE_AFFINITY) THEN
+  REWRITE_TAC[VECTOR_MUL_LID; REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN
+  REWRITE_TAC[VECTOR_ADD_SYM]);; *)
+
+lemma negligible_translation: True .. (*
+ "!s a. negligible s ==> negligible (IMAGE (\<lambda>x:real^N. a + x) s)"
+qed   SIMP_TAC[GSYM HAS_GMEASURE_0; HAS_GMEASURE_TRANSLATION]);; *)
+
+lemma has_gmeasure_translation_eq: True .. (*
+ "!s m. (IMAGE (\<lambda>x:real^N. a + x) s) has_gmeasure m \<longleftrightarrow> s has_gmeasure m"
+qed   REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_GMEASURE_TRANSLATION] THEN
+  DISCH_THEN(MP_TAC o SPEC `--a:real^N` o
+    MATCH_MP HAS_GMEASURE_TRANSLATION) THEN
+  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
+  REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + b:real^N = b`] THEN
+  SET_TAC[]);; *)
+
+lemma negligible_translation_rev: True .. (*
+ "!s a. negligible (IMAGE (\<lambda>x:real^N. a + x) s) ==> negligible s"
+qed   SIMP_TAC[GSYM HAS_GMEASURE_0; HAS_GMEASURE_TRANSLATION_EQ]);; *)
+
+lemma negligible_translation_eq: True .. (*
+ "!s a. negligible (IMAGE (\<lambda>x:real^N. a + x) s) \<longleftrightarrow> negligible s"
+qed   SIMP_TAC[GSYM HAS_GMEASURE_0; HAS_GMEASURE_TRANSLATION_EQ]);; *)
+
+lemma gmeasurable_translation: True .. (*
+ "!s. gmeasurable (IMAGE (\<lambda>x. a + x) s) \<longleftrightarrow> gmeasurable s"
+qed   REWRITE_TAC[measurable; HAS_GMEASURE_TRANSLATION_EQ]);; *)
+
+lemma measure_translation: True .. (*
+ "!s. gmeasurable s ==> measure(IMAGE (\<lambda>x. a + x) s) = gmeasure s"
+qed   REWRITE_TAC[HAS_GMEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
+  MATCH_MP_TAC MEASURE_UNIQUE THEN
+  ASM_REWRITE_TAC[HAS_GMEASURE_TRANSLATION_EQ]);; *)
+
+lemma has_gmeasure_scaling: True .. (*
+ "!s m c. s has_gmeasure m
+           ==> (IMAGE (\<lambda>x:real^N. c % x) s) has_gmeasure
+               (abs(c) pow dimindex(:N)) * m"
+qed   REPEAT GEN_TAC THEN
+  MP_TAC(ISPECL [`s:real^N->bool`; `c:real`; `0:real^N`; `m:real`]
+                HAS_GMEASURE_AFFINITY) THEN
+  REWRITE_TAC[VECTOR_ADD_RID]);; *)
+
+lemma has_gmeasure_scaling_eq: True .. (*
+ "!s m c. ~(c = 0)
+           ==> (IMAGE (\<lambda>x:real^N. c % x) s
+                  has_gmeasure (abs(c) pow dimindex(:N)) * m \<longleftrightarrow>
+                s has_gmeasure m)"
+qed   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_GMEASURE_SCALING] THEN
+  DISCH_THEN(MP_TAC o SPEC `inv(c)` o MATCH_MP HAS_GMEASURE_SCALING) THEN
+  REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
+  REWRITE_TAC[GSYM REAL_POW_MUL; VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN
+  ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN
+  REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID; VECTOR_MUL_LID] THEN
+  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; *)
+
+lemma gmeasurable_scaling: True .. (*
+ "!s c. gmeasurable s ==> gmeasurable (IMAGE (\<lambda>x. c % x) s)"
+qed   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_GMEASURE_SCALING]);; *)
+
+lemma gmeasurable_scaling_eq: True .. (*
+ "!s c. ~(c = 0) ==> (measurable (IMAGE (\<lambda>x. c % x) s) \<longleftrightarrow> gmeasurable s)"
+qed   REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_SCALING] THEN
+  DISCH_THEN(MP_TAC o SPEC `inv c` o MATCH_MP GMEASURABLE_SCALING) THEN
+  REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN
+  MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
+  ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN
+  SET_TAC[]);; *)
+
+lemma measure_scaling: True .. (*
+ "!s. gmeasurable s
+       ==> measure(IMAGE (\<lambda>x:real^N. c % x) s) =
+              (abs(c) pow dimindex(:N)) * gmeasure s"
+qed   REWRITE_TAC[HAS_GMEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN
+  MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_GMEASURE_SCALING]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Measurability of countable unions and intersections of various kinds.     *)
+(* ------------------------------------------------------------------------- *)
+
+lemma has_gmeasure_nested_unions:
+  assumes "\<And>n. gmeasurable(s n)" "\<And>n. gmeasure(s n) \<le> B" "\<And>n. s(n) \<subseteq> s(Suc n)"
+  shows "gmeasurable(\<Union> { s n | n. n \<in> UNIV }) \<and>
+  (\<lambda>n. gmeasure(s n)) ----> gmeasure(\<Union> { s(n) | n. n \<in> UNIV })"
+proof- let ?g = "\<lambda>x. if x \<in> \<Union>{s n |n. n \<in> UNIV} then 1 else (0::real)"
+  have "?g integrable_on UNIV \<and> (\<lambda>k. integral UNIV (\<lambda>x. if x \<in> s k then 1 else 0)) ----> integral UNIV ?g"
+  proof(rule monotone_convergence_increasing)
+    case goal1 show ?case using assms(1) unfolding gmeasurable_integrable by auto
+    case goal2 show ?case using assms(3) by auto
+    have "\<forall>m n. m\<le>n \<longrightarrow> s m \<subseteq> s n" apply(subst transitive_stepwise_le_eq)
+      using assms(3) by auto note * = this[rule_format]
+    have **:"\<And>x e n. \<lbrakk>x \<in> s n; 0 < e\<rbrakk> \<Longrightarrow> \<exists>N. \<forall>n. x \<notin> s n \<longrightarrow> N \<le> n \<longrightarrow> dist 0 1 < e"
+      apply(rule_tac x=n in exI) using * by auto 
+    case goal3 show ?case unfolding Lim_sequentially by(auto intro!: **) 
+    case goal4 show ?case unfolding bounded_def apply(rule_tac x=0 in exI)
+      apply(rule_tac x=B in exI) unfolding dist_real_def apply safe
+      unfolding measure_integral_univ[OF assms(1),THEN sym]
+      apply(subst abs_of_nonpos) using assms(1,2) by auto
+  qed note conjunctD2[OF this]
+  thus ?thesis unfolding gmeasurable_integrable[THEN sym] measure_integral_univ[OF assms(1)]
+    apply- unfolding measure_integral_univ by auto
+qed
+
+lemmas gmeasurable_nested_unions = has_gmeasure_nested_unions(1)
+
+lemma sums_alt:"f sums s = (\<lambda>n. setsum f {0..n}) ----> s"
+proof- have *:"\<And>n. {0..<Suc n} = {0..n}" by auto
+  show ?thesis unfolding sums_def apply(subst LIMSEQ_Suc_iff[THEN sym]) unfolding * ..
+qed
+
+lemma has_gmeasure_countable_negligible_unions: 
+  assumes "\<And>n. gmeasurable(s n)" "\<And>m n. m \<noteq> n \<Longrightarrow> negligible(s m \<inter> s n)"
+  "\<And>n. setsum (\<lambda>k. gmeasure(s k)) {0..n}  <= B"
+  shows "gmeasurable(\<Union> { s(n) |n. n \<in> UNIV })" (is ?m)
+  "((\<lambda>n. gmeasure(s n)) sums (gmeasure(\<Union> { s(n) |n. n \<in> UNIV })))" (is ?s)
+proof- have *:"\<And>n. (\<Union> (s ` {0..n})) has_gmeasure (setsum (\<lambda>k. gmeasure(s k)) {0..n})"
+    apply(rule has_gmeasure_negligible_unions_image) using assms by auto
+  have **:"(\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV}) = (\<Union>{s n |n. n \<in> UNIV})" unfolding simple_image by fastsimp
+  have "gmeasurable (\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV}) \<and>
+    (\<lambda>n. gmeasure (\<Union>(s ` {0..n}))) ----> gmeasure (\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV})"
+    apply(rule has_gmeasure_nested_unions) apply(rule gmeasurableI,rule *)
+    unfolding measure_unique[OF *] defer apply(rule Union_mono,rule image_mono) using assms(3) by auto
+  note lem = conjunctD2[OF this,unfolded **]
+  show ?m using lem(1) .
+  show ?s using lem(2) unfolding sums_alt measure_unique[OF *] .
+qed     
+
+lemma negligible_countable_unions: True .. (*
+ "!s:num->real^N->bool.
+        (!n. negligible(s n)) ==> negligible(UNIONS {s(n) | n \<in> (:num)})"
+qed   REPEAT STRIP_TAC THEN
+  MP_TAC(ISPECL [`s:num->real^N->bool`; `0`]
+    HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
+  ASM_SIMP_TAC[MEASURE_EQ_0; SUM_0; REAL_LE_REFL; LIFT_NUM] THEN ANTS_TAC THENL
+   [ASM_MESON_TAC[HAS_GMEASURE_0; gmeasurable; INTER_SUBSET; NEGLIGIBLE_SUBSET];
+    ALL_TAC] THEN
+  SIMP_TAC[GSYM GMEASURABLE_MEASURE_EQ_0] THEN
+  STRIP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ] THEN
+  MATCH_MP_TAC SERIES_UNIQUE THEN REWRITE_TAC[LIFT_NUM] THEN
+  MAP_EVERY EXISTS_TAC [`(\<lambda>k. 0):num->real^1`; `from 0`] THEN
+  ASM_REWRITE_TAC[SERIES_0]);; *)
+
+lemma gmeasurable_countable_unions_strong:
+  assumes "\<And>n. gmeasurable(s n)" "\<And>n::nat. gmeasure(\<Union>{s k |k. k \<le> n}) \<le> B"
+  shows "gmeasurable(\<Union>{ s(n) |n. n \<in> UNIV })"
+proof- have *:"\<Union>{\<Union>s ` {0..n} |n. n \<in> UNIV} = \<Union>range s" unfolding simple_image by fastsimp
+  show ?thesis unfolding simple_image
+    apply(rule gmeasurable_nested_unions[of "\<lambda>n. \<Union>(s ` {0..n})", THEN conjunct1,unfolded *])
+  proof- fix n::nat show "gmeasurable (\<Union>s ` {0..n})"
+      apply(rule gmeasurable_finite_unions) using assms(1) by auto
+    show "gmeasure (\<Union>s ` {0..n}) \<le> B"
+      using assms(2)[of n] unfolding simple_image[THEN sym] by auto
+    show "\<Union>s ` {0..n} \<subseteq> \<Union>s ` {0..Suc n}" apply(rule Union_mono) by auto
+  qed
+qed
+
+lemma has_gmeasure_countable_negligible_unions_bounded: True .. (*
+ "!s:num->real^N->bool.
+        (!n. gmeasurable(s n)) \<and>
+        (!m n. ~(m = n) ==> negligible(s m \<inter> s n)) \<and>
+        bounded(\<Union>{ s(n) | n \<in> (:num) })
+        ==> gmeasurable(\<Union>{ s(n) | n \<in> (:num) }) \<and>
+            ((\<lambda>n. lift(measure(s n))) sums
+             lift(measure(\<Union>{ s(n) | n \<in> (:num) }))) (from 0)"
+qed   REPEAT GEN_TAC THEN STRIP_TAC THEN
+  FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
+  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
+  MATCH_MP_TAC HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS THEN
+  EXISTS_TAC `measure(interval[a:real^N,b])` THEN
+  ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
+  EXISTS_TAC `measure(UNIONS (IMAGE (s:num->real^N->bool) (0..n)))` THEN
+  CONJ_TAC THENL
+   [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
+    MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
+    ASM_SIMP_TAC[FINITE_NUMSEG];
+    MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN
+    CONJ_TAC THENL
+     [MATCH_MP_TAC GMEASURABLE_UNIONS THEN
+      ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE];
+      ASM SET_TAC[]]]);; *)
+
+lemma gmeasurable_countable_negligible_unions_bounded: True .. (*
+ "!s:num->real^N->bool.
+        (!n. gmeasurable(s n)) \<and>
+        (!m n. ~(m = n) ==> negligible(s m \<inter> s n)) \<and>
+        bounded(\<Union>{ s(n) | n \<in> (:num) })
+        ==> gmeasurable(\<Union>{ s(n) | n \<in> (:num) })"
+qed   SIMP_TAC[HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED]);; *)
+
+lemma gmeasurable_countable_unions: True .. (*
+ "!s:num->real^N->bool B.
+        (!n. gmeasurable(s n)) \<and>
+        (!n. sum (0..n) (\<lambda>k. measure(s k)) \<le> B)
+        ==> gmeasurable(\<Union>{ s(n) | n \<in> (:num) })"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC GMEASURABLE_COUNTABLE_UNIONS_STRONG THEN
+  EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN
+  X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN
+  EXISTS_TAC `sum(0..n) (\<lambda>k. measure(s k:real^N->bool))` THEN
+  ASM_REWRITE_TAC[] THEN
+  W(MP_TAC o PART_MATCH (rand o rand) MEASURE_UNIONS_LE_IMAGE o
+       rand o snd) THEN
+  ASM_REWRITE_TAC[FINITE_NUMSEG] THEN
+  ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN
+  REWRITE_TAC[IN_NUMSEG; LE_0]);; *)
+
+lemma gmeasurable_countable_inters: True .. (*
+ "!s:num->real^N->bool.
+        (!n. gmeasurable(s n))
+        ==> gmeasurable(INTERS { s(n) | n \<in> (:num) })"
+qed   REPEAT STRIP_TAC THEN
+  SUBGOAL_THEN `INTERS { s(n):real^N->bool | n \<in> (:num) } =
+                s 0 DIFF (\<Union>{s 0 DIFF s n | n \<in> (:num)})`
+  SUBST1_TAC THENL
+   [GEN_REWRITE_TAC I [EXTENSION] THEN
+    REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN
+    REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN
+    ASM SET_TAC[];
+    ALL_TAC] THEN
+  MATCH_MP_TAC GMEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN
+  MATCH_MP_TAC GMEASURABLE_COUNTABLE_UNIONS_STRONG THEN
+  EXISTS_TAC `measure(s 0:real^N->bool)` THEN
+  ASM_SIMP_TAC[MEASURABLE_DIFF; LE_0] THEN
+  GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
+  ASM_REWRITE_TAC[] THEN CONJ_TAC THENL
+   [ALL_TAC;
+    REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN
+    MESON_TAC[IN_DIFF]] THEN
+  ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN
+  ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
+  ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG;
+               GMEASURABLE_DIFF; GMEASURABLE_UNIONS]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* measurability of compact and bounded open sets.                           *)
+(* ------------------------------------------------------------------------- *)
+
+lemma gmeasurable_compact: True .. (*
+ "!s:real^N->bool. compact s ==> gmeasurable s"
+qed   lemma lemma = prove
+   (`!f s:real^N->bool.
+          (!n. FINITE(f n)) \<and>
+          (!n. s \<subseteq> UNIONS(f n)) \<and>
+          (!x. ~(x \<in> s) ==> ?n. ~(x \<in> UNIONS(f n))) \<and>
+          (!n a. a \<in> f(SUC n) ==> ?b. b \<in> f(n) \<and> a \<subseteq> b) \<and>
+          (!n a. a \<in> f(n) ==> gmeasurable a)
+          ==> gmeasurable s"
+qed     REPEAT STRIP_TAC THEN
+    SUBGOAL_THEN `!n. UNIONS(f(SUC n):(real^N->bool)->bool) \<subseteq> UNIONS(f n)`
+    ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
+    SUBGOAL_THEN `s = INTERS { UNIONS(f n) | n \<in> (:num) }:real^N->bool`
+    SUBST1_TAC THENL
+     [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN
+      MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN
+      REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN
+      REWRITE_TAC[IN_IMAGE] THEN ASM SET_TAC[];
+      MATCH_MP_TAC GMEASURABLE_COUNTABLE_INTERS THEN
+      ASM_REWRITE_TAC[] THEN GEN_TAC THEN
+      MATCH_MP_TAC GMEASURABLE_UNIONS THEN
+      ASM_MESON_TAC[]]) in
+  REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN
+  EXISTS_TAC
+   `\n. { k | ?u:real^N. (!i. 1 \<le> i \<and> i \<le> dimindex(:N)
+                              ==> integer(u$i)) \<and>
+                  k = { x:real^N | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
+                                       ==> u$i / 2 pow n \<le> x$i \<and>
+                                           x$i < (u$i + 1) / 2 pow n } \<and>
+                  ~(s \<inter> k = {})}` THEN
+  REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
+   [X_GEN_TAC `n:num` THEN
+    SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
+    SUBGOAL_THEN
+     `?N. !x:real^N i. x \<in> s \<and> 1 \<le> i \<and> i \<le> dimindex(:N)
+                       ==> abs(x$i * 2 pow n) < N`
+    STRIP_ASSUME_TAC THENL
+     [FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN
+      REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN
+      X_GEN_TAC `B:real` THEN STRIP_TAC THEN
+      MP_TAC(SPEC `B * 2 pow n` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN
+      MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN
+      X_GEN_TAC `N:num` THEN
+      REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN
+      SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
+      ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS];
+      ALL_TAC] THEN
+    MATCH_MP_TAC FINITE_SUBSET THEN
+    EXISTS_TAC
+     `IMAGE (\<lambda>u. {x | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
+                          ==> (u:real^N)$i \<le> (x:real^N)$i * 2 pow n \<and>
+                              x$i * 2 pow n < u$i + 1})
+            {u | !i. 1 \<le> i \<and> i \<le> dimindex(:N) ==> integer (u$i) \<and>
+                                                     abs(u$i) \<le> N}` THEN
+    CONJ_TAC THENL
+     [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_CART THEN
+      REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG];
+      REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN
+      X_GEN_TAC `l:real^N->bool` THEN
+      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN
+      STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[] THEN
+      X_GEN_TAC `k:num` THEN STRIP_TAC THEN
+      MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN
+      ASM_SIMP_TAC[INTEGER_CLOSED] THEN
+      FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
+      DISCH_THEN(X_CHOOSE_THEN `x:real^N` MP_TAC) THEN
+      REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
+      DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN
+      ASM_REWRITE_TAC[] THEN
+      FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `k:num`]) THEN
+      ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC];
+    X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN
+    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
+    REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
+    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
+    EXISTS_TAC `(lambda i. floor(2 pow n * (x:real^N)$i)):real^N` THEN
+    ONCE_REWRITE_TAC[TAUT `(a \<and> b \<and> c) \<and> d \<longleftrightarrow> b \<and> a \<and> c \<and> d`] THEN
+    REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[LAMBDA_BETA; FLOOR] THEN
+    REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN
+    REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `x:real^N` THEN
+    ASM_REWRITE_TAC[IN_ELIM_THM] THEN
+    SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
+    REWRITE_TAC[REAL_MUL_SYM; FLOOR];
+    X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
+    FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN
+    REWRITE_TAC[closed; open_def] THEN
+    DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN
+    ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN
+    DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
+    MP_TAC(SPECL [`inv(2)`; `e / (dimindex(:N))`] REAL_ARCH_POW_INV) THEN
+    ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT;
+                 DIMINDEX_GE_1; ARITH_RULE `0 < x \<longleftrightarrow> 1 \<le> x`] THEN
+    CONV_TAC REAL_RAT_REDUCE_CONV THEN
+    MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN
+    REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
+    REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
+    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
+    ONCE_REWRITE_TAC[TAUT `(a \<and> b \<and> c) \<and> d \<longleftrightarrow> b \<and> a \<and> c \<and> d`] THEN
+    REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN
+    X_GEN_TAC `u:real^N` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN
+    REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN
+    DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o CONJUNCT2) THEN
+    DISCH_THEN(X_CHOOSE_THEN `y:real^N`
+     (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
+    REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
+    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
+     `d < e ==> x \<le> d ==> x < e`)) THEN
+    REWRITE_TAC[dist] THEN
+    W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN
+    MATCH_MP_TAC(REAL_ARITH `a \<le> b ==> x \<le> a ==> x \<le> b`) THEN
+    GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM CARD_NUMSEG_1] THEN
+    ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC SUM_BOUND THEN
+    SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN
+    X_GEN_TAC `k:num` THEN STRIP_TAC THEN
+    REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN
+    ASM_REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN
+    REWRITE_TAC[REAL_MUL_LID; GSYM REAL_POW_INV] THEN REAL_ARITH_TAC;
+    MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`] THEN
+    DISCH_THEN(X_CHOOSE_THEN `u:real^N`
+     (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
+    DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN
+    REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN
+    ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN
+    ONCE_REWRITE_TAC[TAUT `(a \<and> b \<and> c) \<and> d \<longleftrightarrow> b \<and> a \<and> c \<and> d`] THEN
+    REWRITE_TAC[UNWIND_THM2] THEN
+    EXISTS_TAC `(lambda i. floor((u:real^N)$i / 2)):real^N` THEN
+    ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; FLOOR] THEN
+    MATCH_MP_TAC(SET_RULE `~(s \<inter> a = {}) \<and> a \<subseteq> b
+                           ==> ~(s \<inter> b = {}) \<and> a \<subseteq> b`) THEN
+    ASM_REWRITE_TAC[] THEN EXPAND_TAC "a" THEN REWRITE_TAC[SUBSET] THEN
+    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN
+    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
+    DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
+    REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN
+    REWRITE_TAC[GSYM real_div] THEN
+    SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN
+    MP_TAC(SPEC `(u:real^N)$k / 2` FLOOR) THEN
+    REWRITE_TAC[REAL_ARITH `u / 2 < floor(u / 2) + 1 \<longleftrightarrow>
+                            u < 2 * floor(u / 2) + 2`] THEN
+    ASM_SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; FLOOR_FRAC] THEN
+    REAL_ARITH_TAC;
+    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+    MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`; `u:real^N`] THEN
+    DISCH_THEN(SUBST1_TAC o CONJUNCT1 o CONJUNCT2) THEN
+    ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
+    GEN_TAC THEN DISCH_TAC THEN
+    EXISTS_TAC `interval(inv(2 pow n) % u:real^N,
+                         inv(2 pow n) % (u + 1))` THEN
+    EXISTS_TAC `interval[inv(2 pow n) % u:real^N,
+                         inv(2 pow n) % (u + 1)]` THEN
+    REWRITE_TAC[MEASURABLE_INTERVAL; MEASURE_INTERVAL] THEN
+    ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN
+    REWRITE_TAC[SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN
+    CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN
+    MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN
+    DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
+    ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT;
+                 VEC_COMPONENT] THEN
+    REAL_ARITH_TAC]);; *)
+
+lemma gmeasurable_open: True .. (*
+ "!s:real^N->bool. bounded s \<and> open s ==> gmeasurable s"
+qed   REPEAT STRIP_TAC THEN
+  FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
+  REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
+  FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE
+   `s \<subseteq> t ==> s = t DIFF (t DIFF s)`)) THEN
+  MATCH_MP_TAC GMEASURABLE_DIFF THEN
+  REWRITE_TAC[MEASURABLE_INTERVAL] THEN
+  MATCH_MP_TAC GMEASURABLE_COMPACT THEN
+  SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_DIFF; BOUNDED_INTERVAL] THEN
+  MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[CLOSED_INTERVAL]);; *)
+
+lemma gmeasurable_closure: True .. (*
+ "!s. bounded s ==> gmeasurable(closure s)"
+qed   SIMP_TAC[MEASURABLE_COMPACT; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE;
+           BOUNDED_CLOSURE]);; *)
+
+lemma gmeasurable_interior: True .. (*
+ "!s. bounded s ==> gmeasurable(interior s)"
+qed   SIMP_TAC[MEASURABLE_OPEN; OPEN_INTERIOR; BOUNDED_INTERIOR]);; *)
+
+lemma gmeasurable_frontier: True .. (*
+ "!s:real^N->bool. bounded s ==> gmeasurable(frontier s)"
+qed   REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
+  MATCH_MP_TAC GMEASURABLE_DIFF THEN
+  ASM_SIMP_TAC[MEASURABLE_CLOSURE; GMEASURABLE_INTERIOR] THEN
+  MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
+  REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; *)
+
+lemma measure_frontier: True .. (*
+ "!s:real^N->bool.
+        bounded s
+        ==> measure(frontier s) = measure(closure s) - measure(interior s)"
+qed   REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN
+  MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
+  ASM_SIMP_TAC[MEASURABLE_CLOSURE; GMEASURABLE_INTERIOR] THEN
+  MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN
+  REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; *)
+
+lemma gmeasurable_jordan: True .. (*
+ "!s:real^N->bool. bounded s \<and> negligible(frontier s) ==> gmeasurable s"
+qed   REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN
+  GEN_TAC THEN DISCH_TAC THEN
+  EXISTS_TAC `interior(s):real^N->bool` THEN
+  EXISTS_TAC `closure(s):real^N->bool` THEN
+  ASM_SIMP_TAC[MEASURABLE_INTERIOR; GMEASURABLE_CLOSURE] THEN
+  REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET] THEN
+  ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN
+  ASM_SIMP_TAC[GSYM MEASURE_FRONTIER; REAL_ABS_NUM; MEASURE_EQ_0]);; *)
+
+lemma has_gmeasure_elementary: True .. (*
+ "!d s. d division_of s ==> s has_gmeasure (sum d content)"
+qed   REPEAT STRIP_TAC THEN REWRITE_TAC[has_gmeasure] THEN
+  FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN
+  ASM_SIMP_TAC[LIFT_SUM] THEN
+  MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN
+  ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM has_gmeasure] THEN
+  ASM_MESON_TAC[HAS_GMEASURE_INTERVAL; division_of]);; *)
+
+lemma gmeasurable_elementary: True .. (*
+ "!d s. d division_of s ==> gmeasurable s"
+qed   REWRITE_TAC[measurable] THEN MESON_TAC[HAS_GMEASURE_ELEMENTARY]);; *)
+
+lemma measure_elementary: True .. (*
+ "!d s. d division_of s ==> gmeasure s = sum d content"
+qed   MESON_TAC[HAS_GMEASURE_ELEMENTARY; MEASURE_UNIQUE]);; *)
+
+lemma gmeasurable_inter_interval: True .. (*
+ "!s a b:real^N. gmeasurable s ==> gmeasurable (s \<inter> {a..b})"
+qed   SIMP_TAC[MEASURABLE_INTER; GMEASURABLE_INTERVAL]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* A nice lemma for negligibility proofs.                                    *)
+(* ------------------------------------------------------------------------- *)
+
+lemma STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE: True .. (*
+ "!s. gmeasurable s \<and> bounded s \<and>
+       (!c x:real^N. 0 \<le> c \<and> x \<in> s \<and> (c % x) \<in> s ==> c = 1)
+       ==> negligible s"
+qed   REPEAT STRIP_TAC THEN
+  SUBGOAL_THEN `~(0 < measure(s:real^N->bool))`
+   (fun th -> ASM_MESON_TAC[th; GMEASURABLE_MEASURE_POS_LT]) THEN
+  DISCH_TAC THEN
+  MP_TAC(SPEC `(0:real^N) INSERT s`
+      BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN
+  ASM_SIMP_TAC[BOUNDED_INSERT; COMPACT_IMP_BOUNDED; NOT_EXISTS_THM] THEN
+  X_GEN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN
+  SUBGOAL_THEN
+   `?N. EVEN N \<and> 0 < N \<and>
+        measure(interval[--a:real^N,a])
+         < (N * measure(s:real^N->bool)) / 4 pow dimindex (:N)`
+  STRIP_ASSUME_TAC THENL
+   [FIRST_ASSUM(MP_TAC o SPEC
+     `measure(interval[--a:real^N,a]) * 4 pow (dimindex(:N))` o
+     MATCH_MP REAL_ARCH) THEN
+    SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
+    SIMP_TAC[GSYM REAL_LT_LDIV_EQ; ASSUME `0 < measure(s:real^N->bool)`] THEN
+    DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN
+    EXISTS_TAC `2 * (N DIV 2 + 1)` THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN
+    CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN
+    FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
+     `x < a ==> a \<le> b ==> x < b`)) THEN
+    REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC;
+    ALL_TAC] THEN
+  MP_TAC(ISPECL [`\<Union>(IMAGE (\<lambda>m. IMAGE (\<lambda>x:real^N. (m / N) % x) s)
+                                (1..N))`;
+                  `interval[--a:real^N,a]`] MEASURE_SUBSET) THEN
+  MP_TAC(ISPECL [`measure:(real^N->bool)->real`;
+                 `IMAGE (\<lambda>m. IMAGE (\<lambda>x:real^N. (m / N) % x) s) (1..N)`]
+                HAS_GMEASURE_DISJOINT_UNIONS) THEN
+  SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMP_CONJ] THEN
+  REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ANTS_TAC THENL
+   [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM HAS_GMEASURE_MEASURE] THEN
+    MATCH_MP_TAC GMEASURABLE_SCALING THEN ASM_REWRITE_TAC[];
+    ALL_TAC] THEN
+  REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN
+  ONCE_REWRITE_TAC[TAUT `(a \<and> b) \<and> ~c ==> d \<longleftrightarrow> a \<and> b \<and> ~d ==> c`] THEN
+  SUBGOAL_THEN
+   `!m n. m \<in> 1..N \<and> n \<in> 1..N \<and>
+          ~(DISJOINT (IMAGE (\<lambda>x:real^N. m / N % x) s)
+                     (IMAGE (\<lambda>x. n / N % x) s))
+          ==> m = n`
+  ASSUME_TAC THENL
+   [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN
+    REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
+    REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN
+    REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN
+    DISCH_THEN(X_CHOOSE_THEN `x:real^N`
+     (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
+    REWRITE_TAC[IN_IMAGE] THEN
+    DISCH_THEN(X_CHOOSE_THEN `y:real^N`
+     (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN
+    DISCH_THEN(MP_TAC o AP_TERM `(%) (N / m) :real^N->real^N`) THEN
+    SUBGOAL_THEN `~(N = 0) \<and> ~(m = 0)` STRIP_ASSUME_TAC THENL
+     [REWRITE_TAC[REAL_OF_NUM_EQ] THEN
+      REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG])) THEN
+      ARITH_TAC;
+      ALL_TAC] THEN
+    FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV)
+     [GSYM CONTRAPOS_THM]) THEN
+    ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD
+     `~(x = 0) \<and> ~(y = 0) ==> x / y * y / x = 1`] THEN
+    ASM_SIMP_TAC[REAL_FIELD
+     `~(x = 0) \<and> ~(y = 0) ==> x / y * z / x = z / y`] THEN
+    REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST_ALL_TAC THEN
+    FIRST_X_ASSUM(MP_TAC o SPECL [`n / m`; `y:real^N`]) THEN
+    ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_FIELD
+     `~(y = 0) ==> (x / y = 1 \<longleftrightarrow> x = y)`] THEN
+    REWRITE_TAC[REAL_OF_NUM_EQ; EQ_SYM_EQ];
+    ALL_TAC] THEN
+  ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN
+  REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL
+   [REWRITE_TAC[measurable] THEN ASM_MESON_TAC[];
+    REWRITE_TAC[MEASURABLE_INTERVAL];
+    REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN
+    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN
+    X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN
+    DISCH_TAC THEN
+    MP_TAC(ISPECL [`--a:real^N`; `a:real^N`] CONVEX_INTERVAL) THEN
+    DISCH_THEN(MP_TAC o REWRITE_RULE[CONVEX_ALT] o CONJUNCT1) THEN
+    DISCH_THEN(MP_TAC o SPECL [`0:real^N`; `x:real^N`; `n / N`]) THEN
+    ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN
+    DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN
+    CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN
+    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN
+    DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE
+     `1 \<le> n \<and> n \<le> N ==> 0 < N \<and> n \<le> N`)) THEN
+    SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT; REAL_LE_LDIV_EQ] THEN
+    SIMP_TAC[REAL_MUL_LID];
+    ALL_TAC] THEN
+  FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN
+  ASM_SIMP_TAC[MEASURE_SCALING; REAL_NOT_LE] THEN
+  FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN
+  MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC
+   `sum (1..N) (measure o (\<lambda>m. IMAGE (\<lambda>x:real^N. m / N % x) s))` THEN
+  CONJ_TAC THENL
+   [ALL_TAC;
+    MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
+    MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[] THEN
+    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
+    ASM_REWRITE_TAC[SET_RULE `DISJOINT s s \<longleftrightarrow> s = {}`; IMAGE_EQ_EMPTY] THEN
+    DISCH_THEN SUBST_ALL_TAC THEN
+    ASM_MESON_TAC[REAL_LT_REFL; MEASURE_EMPTY]] THEN
+  FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN
+  ASM_SIMP_TAC[o_DEF; MEASURE_SCALING; SUM_RMUL] THEN
+  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
+   `x < a ==> a \<le> b ==> x < b`)) THEN
+  ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN
+  ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN
+  ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN
+  REWRITE_TAC[GSYM REAL_POW_MUL] THEN
+  REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN
+  FIRST_X_ASSUM(X_CHOOSE_THEN `M:num` SUBST_ALL_TAC o
+        GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN
+  REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN
+  RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_MUL]) THEN
+  RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `0 < 2 * x \<longleftrightarrow> 0 < x`]) THEN
+  ASM_SIMP_TAC[REAL_FIELD `0 < y ==> x / (2 * y) * 4 = x * 2 / y`] THEN
+  MATCH_MP_TAC REAL_LE_TRANS THEN
+  EXISTS_TAC `sum(M..(2*M)) (\<lambda>i. (i * 2 / M) pow dimindex (:N))` THEN
+  CONJ_TAC THENL
+   [ALL_TAC;
+    MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN
+    SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_DIV; REAL_POS] THEN
+    REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG; SUBSET] THEN
+    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_OF_NUM_LT]) THEN
+    ARITH_TAC] THEN
+  MATCH_MP_TAC REAL_LE_TRANS THEN
+  EXISTS_TAC `sum(M..(2*M)) (\<lambda>i. 2)` THEN CONJ_TAC THENL
+   [REWRITE_TAC[SUM_CONST_NUMSEG] THEN
+    REWRITE_TAC[ARITH_RULE `(2 * M + 1) - M = M + 1`] THEN
+    REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
+    ALL_TAC] THEN
+  MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN
+  X_GEN_TAC `n:num` THEN STRIP_TAC THEN
+  MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `2 pow (dimindex(:N))` THEN
+  CONJ_TAC THENL
+   [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN
+    MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[DIMINDEX_GE_1] THEN
+    ARITH_TAC;
+    ALL_TAC] THEN
+  MATCH_MP_TAC REAL_POW_LE2 THEN
+  REWRITE_TAC[REAL_POS; ARITH; real_div; REAL_MUL_ASSOC] THEN
+  ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN
+  REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN
+  UNDISCH_TAC `M:num \<le> n` THEN ARITH_TAC);; *)
+
+lemma STARLIKE_NEGLIGIBLE_LEMMA: True .. (*
+ "!s. compact s \<and>
+       (!c x:real^N. 0 \<le> c \<and> x \<in> s \<and> (c % x) \<in> s ==> c = 1)
+       ==> negligible s"
+qed   REPEAT STRIP_TAC THEN
+  MATCH_MP_TAC STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE THEN
+  ASM_MESON_TAC[MEASURABLE_COMPACT; COMPACT_IMP_BOUNDED]);; *)
+
+lemma STARLIKE_NEGLIGIBLE: True .. (*
+ "!s a. closed s \<and>
+         (!c x:real^N. 0 \<le> c \<and> (a + x) \<in> s \<and> (a + c % x) \<in> s ==> c = 1)
+         ==> negligible s"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN
+  EXISTS_TAC `--a:real^N` THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN
+  MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN
+  MATCH_MP_TAC STARLIKE_NEGLIGIBLE_LEMMA THEN CONJ_TAC THENL
+   [MATCH_MP_TAC CLOSED_INTER_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN
+    ASM_SIMP_TAC[CLOSED_TRANSLATION];
+    REWRITE_TAC[IN_IMAGE; IN_INTER] THEN
+    ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y \<longleftrightarrow> y = a + x`] THEN
+    REWRITE_TAC[UNWIND_THM2] THEN ASM MESON_TAC[]]);; *)
+
+lemma STARLIKE_NEGLIGIBLE_STRONG: True .. (*
+ "!s a. closed s \<and>
+         (!c x:real^N. 0 \<le> c \<and> c < 1 \<and> (a + x) \<in> s
+                       ==> ~((a + c % x) \<in> s))
+         ==> negligible s"
+qed   REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
+  EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN
+  MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN
+  MATCH_MP_TAC(REAL_ARITH `~(x < y) \<and> ~(y < x) ==> x = y`) THEN
+  STRIP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN
+  FIRST_X_ASSUM(MP_TAC o SPECL [`inv c`; `c % x:real^N`]) THEN
+  ASM_REWRITE_TAC[REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN
+  ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `1 < c ==> ~(c = 0)`] THEN
+  ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN
+  GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN
+  MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* In particular.                                                            *)
+(* ------------------------------------------------------------------------- *)
+
+lemma NEGLIGIBLE_HYPERPLANE: True .. (*
+ "!a b. ~(a = 0 \<and> b = 0) ==> negligible {x:real^N | a dot x = b}"
+qed   REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = 0` THEN
+  ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | F} = {}`; NEGLIGIBLE_EMPTY] THEN
+  MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN
+  SUBGOAL_THEN `?x:real^N. ~(a dot x = b)` MP_TAC THENL
+   [MATCH_MP_TAC(MESON[] `!a:real^N. P a \/ P(--a) ==> ?x. P x`) THEN
+    EXISTS_TAC `a:real^N` THEN REWRITE_TAC[DOT_RNEG] THEN
+    MATCH_MP_TAC(REAL_ARITH `~(a = 0) ==> ~(a = b) \/ ~(--a = b)`) THEN
+    ASM_REWRITE_TAC[DOT_EQ_0];
+    ALL_TAC] THEN
+  MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN
+  REWRITE_TAC[CLOSED_HYPERPLANE; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN
+  MAP_EVERY X_GEN_TAC [`t:real`; `y:real^N`] THEN
+  DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
+   `0 \<le> t \<and> ac + ay = b \<and> ac + t * ay = b
+    ==> ((ay = 0 ==> ac = b) \<and> (t - 1) * ay = 0)`)) THEN
+  ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0] THEN CONV_TAC TAUT);; *)
+
+lemma NEGLIGIBLE_LOWDIM: True .. (*
+ "!s:real^N->bool. dim(s) < dimindex(:N) ==> negligible s"
+qed   GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN
+  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
+  MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+  EXISTS_TAC `span(s):real^N->bool` THEN REWRITE_TAC[SPAN_INC] THEN
+  MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+  EXISTS_TAC `{x:real^N | a dot x = 0}` THEN
+  ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Measurability of bounded convex sets.                                     *)
+(* ------------------------------------------------------------------------- *)
+
+lemma NEGLIGIBLE_CONVEX_FRONTIER: True .. (*
+ "!s:real^N->bool. convex s ==> negligible(frontier s)"
+qed   SUBGOAL_THEN
+   `!s:real^N->bool. convex s \<and> (0) \<in> s ==> negligible(frontier s)`
+  ASSUME_TAC THENL
+   [ALL_TAC;
+    X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN
+    ASM_CASES_TAC `s:real^N->bool = {}` THEN
+    ASM_REWRITE_TAC[FRONTIER_EMPTY; NEGLIGIBLE_EMPTY] THEN
+    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN
+    DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN
+    FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\<lambda>x:real^N. --a + x) s`) THEN
+    ASM_SIMP_TAC[CONVEX_TRANSLATION; IN_IMAGE] THEN
+    ASM_REWRITE_TAC[UNWIND_THM2;
+                    VECTOR_ARITH `0:real^N = --a + x \<longleftrightarrow> x = a`] THEN
+    REWRITE_TAC[FRONTIER_TRANSLATION; NEGLIGIBLE_TRANSLATION_EQ]] THEN
+  REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIM_SUBSET_UNIV) THEN
+  REWRITE_TAC[ARITH_RULE `d:num \<le> e \<longleftrightarrow> d < e \/ d = e`] THEN STRIP_TAC THENL
+   [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+    EXISTS_TAC `closure s:real^N->bool` THEN
+    REWRITE_TAC[frontier; SUBSET_DIFF] THEN
+    MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_REWRITE_TAC[DIM_CLOSURE];
+    ALL_TAC] THEN
+  SUBGOAL_THEN `?a:real^N. a \<in> interior s` CHOOSE_TAC THENL
+   [X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC
+     (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN
+    FIRST_X_ASSUM SUBST_ALL_TAC THEN
+    MP_TAC(ISPEC `b:real^N->bool` INTERIOR_SIMPLEX_NONEMPTY) THEN
+    ASM_REWRITE_TAC[] THEN
+    MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM SUBSET] THEN
+    MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN
+    ASM_REWRITE_TAC[INSERT_SUBSET];
+    ALL_TAC] THEN
+  MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN
+  EXISTS_TAC `a:real^N` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN
+  REPEAT GEN_TAC THEN STRIP_TAC THEN
+  REWRITE_TAC[frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN
+  SIMP_TAC[VECTOR_ARITH
+   `a + c % x:real^N = (a + x) - (1 - c) % ((a + x) - a)`] THEN
+  MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN
+  RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN
+  ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; *)
+
+lemma GMEASURABLE_CONVEX: True .. (*
+ "!s:real^N->bool. convex s \<and> bounded s ==> gmeasurable s"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC GMEASURABLE_JORDAN THEN
+  ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Various special cases.                                                    *)
+(* ------------------------------------------------------------------------- *)
+
+lemma NEGLIGIBLE_SPHERE: True .. (*
+ "!a r. negligible {x:real^N | dist(a,x) = r}"
+qed   REWRITE_TAC[GSYM FRONTIER_CBALL] THEN
+  SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; *)
+
+lemma GMEASURABLE_BALL: True .. (*
+ "!a r. gmeasurable(ball(a,r))"
+qed   SIMP_TAC[MEASURABLE_OPEN; BOUNDED_BALL; OPEN_BALL]);; *)
+
+lemma GMEASURABLE_CBALL: True .. (*
+ "!a r. gmeasurable(cball(a,r))"
+qed   SIMP_TAC[MEASURABLE_COMPACT; COMPACT_CBALL]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Negligibility of image under non-injective linear map.                    *)
+(* ------------------------------------------------------------------------- *)
+
+lemma NEGLIGIBLE_LINEAR_SINGULAR_IMAGE: True .. (*
+ "!f:real^N->real^N s.
+        linear f \<and> ~(!x y. f(x) = f(y) ==> x = y)
+        ==> negligible(IMAGE f s)"
+qed   REPEAT GEN_TAC THEN
+  DISCH_THEN(MP_TAC o MATCH_MP LINEAR_SINGULAR_IMAGE_HYPERPLANE) THEN
+  DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN
+  MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+  EXISTS_TAC `{x:real^N | a dot x = 0}` THEN
+  ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Approximation of gmeasurable set by union of intervals.                    *)
+(* ------------------------------------------------------------------------- *)
+
+lemma COVERING_LEMMA: True .. (*
+ "!a b:real^N s g.
+        s \<subseteq> {a..b} \<and> ~({a<..<b} = {}) \<and> gauge g
+        ==> ?d. COUNTABLE d \<and>
+                (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
+                                (\<exists>c d. k = {c..d})) \<and>
+                (!k1 k2. k1 \<in> d \<and> k2 \<in> d \<and> ~(k1 = k2)
+                         ==> interior k1 \<inter> interior k2 = {}) \<and>
+                (!k. k \<in> d ==> ?x. x \<in> (s \<inter> k) \<and> k \<subseteq> g(x)) \<and>
+                s \<subseteq> \<Union>d"
+qed   REPEAT STRIP_TAC THEN
+  SUBGOAL_THEN
+   `?d. COUNTABLE d \<and>
+        (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
+                        (\<exists>c d:real^N. k = {c..d})) \<and>
+        (!k1 k2. k1 \<in> d \<and> k2 \<in> d
+                 ==> k1 \<subseteq> k2 \/ k2 \<subseteq> k1 \/
+                     interior k1 \<inter> interior k2 = {}) \<and>
+        (!x. x \<in> s ==> ?k. k \<in> d \<and> x \<in> k \<and> k \<subseteq> g(x)) \<and>
+        (!k. k \<in> d ==> FINITE {l | l \<in> d \<and> k \<subseteq> l})`
+  ASSUME_TAC THENL
+   [EXISTS_TAC
+     `IMAGE (\<lambda>(n,v).
+             interval[(lambda i. a$i + (v$i) / 2 pow n *
+                                       ((b:real^N)$i - (a:real^N)$i)):real^N,
+                      (lambda i. a$i + ((v$i) + 1) / 2 pow n * (b$i - a$i))])
+            {n,v | n \<in> (:num) \<and>
+                   v \<in> {v:num^N | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
+                                       ==> v$i < 2 EXP n}}` THEN
+    CONJ_TAC THENL
+     [MATCH_MP_TAC COUNTABLE_IMAGE THEN
+      MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN
+      REWRITE_TAC[NUM_COUNTABLE; IN_UNIV] THEN
+      GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN
+      MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
+      ALL_TAC] THEN
+    CONJ_TAC THENL
+     [REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN
+      MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
+      REWRITE_TAC[IN_ELIM_PAIR_THM] THEN
+      REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
+      REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN
+      SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; LAMBDA_BETA] THEN
+      REWRITE_TAC[REAL_LE_LADD; REAL_LE_ADDR; REAL_ARITH
+        `a + x * (b - a) \<le> b \<longleftrightarrow> 0 \<le> (1 - x) * (b - a)`] THEN
+      RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
+      REPEAT STRIP_TAC THEN
+      (MATCH_MP_TAC REAL_LE_MUL ORELSE MATCH_MP_TAC REAL_LE_RMUL) THEN
+      ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
+      ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
+      REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID; REAL_LE_ADDR] THEN
+      SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN
+      ASM_SIMP_TAC[ARITH_RULE `x + 1 \<le> y \<longleftrightarrow> x < y`; REAL_LT_IMP_LE];
+      ALL_TAC] THEN
+    CONJ_TAC THENL
+     [ONCE_REWRITE_TAC[IMP_CONJ] THEN
+      REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; RIGHT_FORALL_IMP_THM] THEN
+      REWRITE_TAC[IN_ELIM_PAIR_THM; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN
+      REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
+      GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN
+      MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL
+       [REPEAT GEN_TAC THEN
+        GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN
+        REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[];
+        ALL_TAC] THEN
+      MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN
+      MAP_EVERY X_GEN_TAC [`v:num^N`; `w:num^N`] THEN REPEAT DISCH_TAC THEN
+      REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; SUBSET_INTERVAL] THEN
+      SIMP_TAC[DISJOINT_INTERVAL; LAMBDA_BETA] THEN
+      MATCH_MP_TAC(TAUT `p \/ q \/ r ==> (a ==> p) \/ (b ==> q) \/ r`) THEN
+      ONCE_REWRITE_TAC[TAUT `a \<and> b \<and> c \<longleftrightarrow> ~(a \<and> b ==> ~c)`] THEN
+      RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
+      ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; LAMBDA_BETA] THEN
+      REWRITE_TAC[NOT_IMP; REAL_LE_LADD] THEN
+      ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
+      REWRITE_TAC[REAL_ARITH `~(x + 1 \<le> x)`] THEN DISJ2_TAC THEN
+      MATCH_MP_TAC(MESON[]
+       `(!i. ~P i ==> Q i) ==> (!i. Q i) \/ (\<exists>i. P i)`) THEN
+      X_GEN_TAC `i:num` THEN
+      DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
+      ASM_REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN
+      UNDISCH_TAC `m:num \<le> n` THEN REWRITE_TAC[LE_EXISTS] THEN
+      DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN
+      ONCE_REWRITE_TAC[ADD_SYM] THEN
+      REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN
+      REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
+      ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2; REAL_LT_DIV2_EQ] THEN
+      ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2;
+                   REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN
+      SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC;
+      ALL_TAC] THEN
+    CONJ_TAC THENL
+     [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
+      SUBGOAL_THEN
+        `?e. 0 < e \<and> !y. (!i. 1 \<le> i \<and> i \<le> dimindex(:N)
+                                ==> abs((x:real^N)$i - (y:real^N)$i) \<le> e)
+                           ==> y \<in> g(x)`
+      STRIP_ASSUME_TAC THENL
+       [FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [gauge]) THEN
+        STRIP_TAC THEN
+        FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN
+        DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN
+        DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN
+        EXISTS_TAC `e / 2 / (dimindex(:N))` THEN
+        ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1;
+                     ARITH] THEN
+        X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN
+        MATCH_MP_TAC(SET_RULE `!s. s \<subseteq> t \<and> x \<in> s ==> x \<in> t`) THEN
+        EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[IN_BALL] THEN
+        MATCH_MP_TAC(REAL_ARITH `0 < e \<and> x \<le> e / 2 ==> x < e`) THEN
+        ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN
+        EXISTS_TAC `sum(1..dimindex(:N)) (\<lambda>i. abs((x - y:real^N)$i))` THEN
+        REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN
+        ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT;
+                     DIMINDEX_GE_1; VECTOR_SUB_COMPONENT; CARD_NUMSEG_1];
+        ALL_TAC] THEN
+      REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
+      MP_TAC(SPECL [`1 / 2`; `e / norm(b - a:real^N)`]
+        REAL_ARCH_POW_INV) THEN
+      SUBGOAL_THEN `0 < norm(b - a:real^N)` ASSUME_TAC THENL
+       [ASM_MESON_TAC[VECTOR_SUB_EQ; NORM_POS_LT; INTERVAL_SING]; ALL_TAC] THEN
+      CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN
+      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN
+      REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN DISCH_TAC THEN
+      SIMP_TAC[IN_ELIM_THM; IN_INTERVAL; SUBSET; LAMBDA_BETA] THEN
+      MATCH_MP_TAC(MESON[]
+       `(!x. Q x ==> R x) \<and> (\<exists>x. P x \<and> Q x) ==> ?x. P x \<and> Q x \<and> R x`) THEN
+      CONJ_TAC THENL
+       [REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN
+        MAP_EVERY X_GEN_TAC [`w:num^N`; `y:real^N`] THEN
+        REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN
+        DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN
+        MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN
+        DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
+        ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
+         `(a + n \<le> x \<and> x \<le> a + m) \<and>
+          (a + n \<le> y \<and> y \<le> a + m) ==> abs(x - y) \<le> m - n`)) THEN
+        MATCH_MP_TAC(REAL_ARITH
+         `y * z \<le> e
+          ==> a \<le> ((x + 1) * y) * z - ((x * y) * z) ==> a \<le> e`) THEN
+        RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
+        ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN
+        FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
+        (REAL_ARITH `n < e * x ==> 0 \<le> e * (inv y - x) ==> n \<le> e / y`)) THEN
+        MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN
+        REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN
+        ASM_SIMP_TAC[REAL_SUB_LT] THEN
+        MP_TAC(SPECL [`b - a:real^N`; `i:num`] COMPONENT_LE_NORM) THEN
+        ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC;
+        ALL_TAC] THEN
+      REWRITE_TAC[IN_UNIV; AND_FORALL_THM] THEN
+      REWRITE_TAC[TAUT `(a ==> c) \<and> (a ==> b) \<longleftrightarrow> a ==> b \<and> c`] THEN
+      REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN
+      STRIP_TAC THEN
+      SUBGOAL_THEN `(x:real^N) \<in> {a..b}` MP_TAC THENL
+       [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN
+      DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN
+      RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN STRIP_TAC THEN
+      DISJ_CASES_TAC(MATCH_MP (REAL_ARITH `x \<le> y ==> x = y \/ x < y`)
+       (ASSUME `(x:real^N)$i \<le> (b:real^N)$i`))
+      THENL
+       [EXISTS_TAC `2 EXP n - 1` THEN
+        SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_LT;
+                 EXP_LT_0; LE_1; ARITH] THEN
+        ASM_REWRITE_TAC[REAL_SUB_ADD; REAL_ARITH `a - 1 < a`] THEN
+        MATCH_MP_TAC(REAL_ARITH
+         `1 * (b - a) = x \<and> y \<le> x ==> a + y \<le> b \<and> b \<le> a + x`) THEN
+        ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_LE_RMUL_EQ;
+                     REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN
+        SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_MUL_RINV; REAL_POW_EQ_0;
+                 REAL_OF_NUM_EQ; ARITH_EQ] THEN REAL_ARITH_TAC;
+        ALL_TAC] THEN
+      MP_TAC(SPEC `2 pow n * ((x:real^N)$i - (a:real^N)$i) /
+                              ((b:real^N)$i - (a:real^N)$i)` FLOOR_POS) THEN
+      ANTS_TAC THENL
+       [ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_MUL; REAL_POW_LE; REAL_POS;
+                      REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_DIV];
+        ALL_TAC] THEN
+      MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN
+      REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN
+      DISCH_THEN(SUBST_ALL_TAC o SYM) THEN
+      REWRITE_TAC[REAL_ARITH `a + b * c \<le> x \<and> x \<le> a + b' * c \<longleftrightarrow>
+                              b * c \<le> x - a \<and> x - a \<le> b' * c`] THEN
+      ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ;
+                   REAL_SUB_LT; GSYM real_div] THEN
+      ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN
+      SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN
+      SIMP_TAC[FLOOR; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN
+      EXISTS_TAC `((x:real^N)$i - (a:real^N)$i) /
+                  ((b:real^N)$i - (a:real^N)$i) *
+                  2 pow n` THEN
+      REWRITE_TAC[FLOOR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN
+      ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN
+      ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_SUB_LT] THEN
+      ASM_REAL_ARITH_TAC;
+      ALL_TAC] THEN
+    REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
+    MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN
+    REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN
+    MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC
+     `IMAGE (\<lambda>(n,v).
+            interval[(lambda i. a$i + (v$i) / 2 pow n *
+                                      ((b:real^N)$i - (a:real^N)$i)):real^N,
+                     (lambda i. a$i + ((v$i) + 1) / 2 pow n * (b$i - a$i))])
+            {m,v | m \<in> 0..n \<and>
+                   v \<in> {v:num^N | !i. 1 \<le> i \<and> i \<le> dimindex(:N)
+                                       ==> v$i < 2 EXP m}}` THEN
+    CONJ_TAC THENL
+     [MATCH_MP_TAC FINITE_IMAGE THEN
+      MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN
+      REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN
+      MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT];
+      ALL_TAC] THEN
+    GEN_REWRITE_TAC I [SUBSET] THEN
+    REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN
+    REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN
+    MAP_EVERY X_GEN_TAC [`m:num`; `w:num^N`] THEN DISCH_TAC THEN
+    DISCH_TAC THEN SIMP_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN
+    MAP_EVERY EXISTS_TAC [`m:num`; `w:num^N`] THEN ASM_REWRITE_TAC[] THEN
+    REWRITE_TAC[IN_NUMSEG; GSYM NOT_LT; LT] THEN DISCH_TAC THEN
+    FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN
+    SIMP_TAC[NOT_IMP; LAMBDA_BETA] THEN
+    RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN
+    ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN
+    ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN
+    REWRITE_TAC[REAL_ARITH `x \<le> x + 1`] THEN
+    DISCH_THEN(MP_TAC o SPEC `1`) THEN
+    REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN
+    DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH
+     `w / m \<le> v / n \<and> (v + 1) / n \<le> (w + 1) / m
+      ==> inv n \<le> inv m`)) THEN
+    REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_INV2 THEN
+    ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN
+    ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV;
+    ALL_TAC] THEN
+  SUBGOAL_THEN
+   `?d. COUNTABLE d \<and>
+        (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
+                        (\<exists>c d:real^N. k = {c..d})) \<and>
+        (!k1 k2. k1 \<in> d \<and> k2 \<in> d
+                 ==> k1 \<subseteq> k2 \/ k2 \<subseteq> k1 \/
+                     interior k1 \<inter> interior k2 = {}) \<and>
+        (!k. k \<in> d ==> (\<exists>x. x \<in> s \<inter> k \<and> k \<subseteq> g x)) \<and>
+        (!k. k \<in> d ==> FINITE {l | l \<in> d \<and> k \<subseteq> l}) \<and>
+        s \<subseteq> \<Union>d`
+  MP_TAC THENL
+   [FIRST_X_ASSUM(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
+    EXISTS_TAC
+     `{k:real^N->bool | k \<in> d \<and> ?x. x \<in> (s \<inter> k) \<and> k \<subseteq> g x}` THEN
+    ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
+     [MATCH_MP_TAC COUNTABLE_SUBSET THEN
+      EXISTS_TAC `d:(real^N->bool)->bool` THEN
+      ASM_REWRITE_TAC[] THEN SET_TAC[];
+      X_GEN_TAC `k:real^N->bool` THEN REPEAT STRIP_TAC THEN
+      MATCH_MP_TAC FINITE_SUBSET THEN
+      EXISTS_TAC `{l:real^N->bool | l \<in> d \<and> k \<subseteq> l}` THEN
+      ASM_REWRITE_TAC[] THEN SET_TAC[];
+      ASM SET_TAC[]];
+    ALL_TAC] THEN
+  DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
+  EXISTS_TAC
+   `{k:real^N->bool | k \<in> d \<and> !k'. k' \<in> d \<and> ~(k = k')
+                                     ==> ~(k \<subseteq> k')}` THEN
+  ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL
+   [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `d:(real^N->bool)->bool` THEN
+    ASM_REWRITE_TAC[] THEN SET_TAC[];
+    ASM SET_TAC[];
+    ALL_TAC] THEN
+  FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP
+   (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN
+  GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN
+  MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `x:real^N`] THEN DISCH_TAC THEN
+  REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN
+  MP_TAC(ISPEC `\k l:real^N->bool. k \<in> d \<and> l \<in> d \<and> l \<subseteq> k \<and> ~(k = l)`
+     WF_FINITE) THEN
+  REWRITE_TAC[WF] THEN ANTS_TAC THENL
+   [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N->bool` THEN
+    ASM_CASES_TAC `(l:real^N->bool) \<in> d` THEN
+    ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES] THEN
+    MATCH_MP_TAC FINITE_SUBSET THEN
+    EXISTS_TAC `{m:real^N->bool | m \<in> d \<and> l \<subseteq> m}` THEN
+    ASM_SIMP_TAC[] THEN SET_TAC[];
+    ALL_TAC] THEN
+  DISCH_THEN(MP_TAC o SPEC `\l:real^N->bool. l \<in> d \<and> x \<in> l`) THEN
+  REWRITE_TAC[] THEN ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN
+  MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; *)
+
+lemma GMEASURABLE_OUTER_INTERVALS_BOUNDED: True .. (*
+ "!s a b:real^N e.
+        gmeasurable s \<and> s \<subseteq> {a..b} \<and> 0 < e
+        ==> ?d. COUNTABLE d \<and>
+                (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
+                                (\<exists>c d. k = {c..d})) \<and>
+                (!k1 k2. k1 \<in> d \<and> k2 \<in> d \<and> ~(k1 = k2)
+                         ==> interior k1 \<inter> interior k2 = {}) \<and>
+                s \<subseteq> \<Union>d \<and>
+                gmeasurable (\<Union>d) \<and>
+                gmeasure (\<Union>d) \<le> gmeasure s + e"
+qed   lemma lemma = prove
+   (`(!x y. (x,y) \<in> IMAGE (\<lambda>z. f z,g z) s ==> P x y) \<longleftrightarrow>
+     (!z. z \<in> s ==> P (f z) (g z))"
+qed   REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN MESON_TAC[]) in
+  REPEAT GEN_TAC THEN
+  ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
+   [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN STRIP_TAC THEN
+    EXISTS_TAC `{}:(real^N->bool)->bool` THEN
+    ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0; MEASURE_EMPTY; REAL_ADD_LID;
+                    SUBSET_REFL; COUNTABLE_EMPTY; GMEASURABLE_EMPTY] THEN
+    ASM_SIMP_TAC[REAL_LT_IMP_LE];
+    ALL_TAC] THEN
+  STRIP_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THENL
+   [EXISTS_TAC `{interval[a:real^N,b]}` THEN
+    REWRITE_TAC[UNIONS_1; COUNTABLE_SING] THEN
+    ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT;
+                    NOT_IN_EMPTY; SUBSET_REFL; GMEASURABLE_INTERVAL] THEN
+    CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN
+    SUBGOAL_THEN
+     `measure(interval[a:real^N,b]) = 0 \<and> measure(s:real^N->bool) = 0`
+     (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE; REAL_ADD_LID]) THEN
+    SUBGOAL_THEN
+      `interval[a:real^N,b] has_gmeasure 0 \<and> (s:real^N->bool) has_gmeasure 0`
+      (fun th -> MESON_TAC[th; MEASURE_UNIQUE]) THEN
+    REWRITE_TAC[HAS_GMEASURE_0] THEN
+    MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
+     [ASM_REWRITE_TAC[NEGLIGIBLE_INTERVAL];
+      ASM_MESON_TAC[NEGLIGIBLE_SUBSET]];
+    ALL_TAC] THEN
+  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN
+  DISCH_THEN(X_CHOOSE_TAC `m:real`) THEN
+  FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_UNIQUE) THEN
+  SUBGOAL_THEN
+   `((\<lambda>x:real^N. if x \<in> s then 1 else 0) has_integral (lift m))
+    {a..b}`
+  ASSUME_TAC THENL
+   [ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN
+    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_GMEASURE]) THEN
+    MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN
+    ASM SET_TAC[];
+    ALL_TAC] THEN
+  FIRST_ASSUM(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN
+  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN
+  DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN
+  DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN
+  MP_TAC(SPECL [`a:real^N`; `b:real^N`; `s:real^N->bool`;
+                `g:real^N->real^N->bool`] COVERING_LEMMA) THEN
+  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN
+  X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+  MP_TAC(ISPECL [`(\<lambda>x. if x \<in> s then 1 else 0):real^N->real^1`;
+                 `a:real^N`; `b:real^N`; `g:real^N->real^N->bool`;
+                 `e:real`]
+                HENSTOCK_LEMMA_PART1) THEN
+  ASM_REWRITE_TAC[] THEN
+  FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN
+  ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN
+  SUBGOAL_THEN
+   `!k l:real^N->bool. k \<in> d \<and> l \<in> d \<and> ~(k = l)
+                       ==> negligible(k \<inter> l)`
+  ASSUME_TAC THENL
+   [REPEAT STRIP_TAC THEN
+    FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`]) THEN
+    ASM_SIMP_TAC[] THEN
+    SUBGOAL_THEN
+     `?x y:real^N u v:real^N. k = {x..y} \<and> l = {u..v}`
+    MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN
+    DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN
+    REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN
+    MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+    EXISTS_TAC `(interval[x:real^N,y] DIFF {x<..<y}) UNION
+                (interval[u:real^N,v] DIFF {u<..<v}) UNION
+                (interval (x,y) \<inter> interval (u,v))` THEN
+    CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
+    ASM_REWRITE_TAC[UNION_EMPTY] THEN
+    SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_FRONTIER_INTERVAL];
+    ALL_TAC] THEN
+  SUBGOAL_THEN
+   `!D. FINITE D \<and> D \<subseteq> d
+         ==> gmeasurable(\<Union>D :real^N->bool) \<and> measure(\<Union>D) \<le> m + e`
+  ASSUME_TAC THENL
+   [GEN_TAC THEN STRIP_TAC THEN
+    SUBGOAL_THEN
+     `?t:(real^N->bool)->real^N. !k. k \<in> D ==> t(k) \<in> (s \<inter> k) \<and>
+                                                k \<subseteq> (g(t k))`
+    (CHOOSE_THEN (LABEL_TAC "+")) THENL
+     [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN
+    REMOVE_THEN "*" (MP_TAC o SPEC
+     `IMAGE (\<lambda>k. (t:(real^N->bool)->real^N) k,k) D`) THEN
+    ASM_SIMP_TAC[VSUM_IMAGE; PAIR_EQ] THEN REWRITE_TAC[o_DEF] THEN
+    ANTS_TAC THENL
+     [REWRITE_TAC[tagged_partial_division_of; fine] THEN
+      ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN
+      REWRITE_TAC[lemma; RIGHT_FORALL_IMP_THM; IMP_CONJ; PAIR_EQ] THEN
+      ASM_SIMP_TAC[] THEN
+      CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET]];
+      ALL_TAC] THEN
+    USE_THEN "+" (MP_TAC o REWRITE_RULE[IN_INTER]) THEN
+    SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN
+    ASM_SIMP_TAC[VSUM_SUB] THEN
+    SUBGOAL_THEN `D division_of (\<Union>D:real^N->bool)` ASSUME_TAC THENL
+     [REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN
+    FIRST_ASSUM(ASSUME_TAC o MATCH_MP GMEASURABLE_ELEMENTARY) THEN
+    SUBGOAL_THEN `vsum D (\<lambda>k:real^N->bool. content k % 1) =
+                  lift(measure(\<Union>D))`
+    SUBST1_TAC THENL
+     [ONCE_REWRITE_TAC[GSYM _EQ] THEN
+      ASM_SIMP_TAC[LIFT_; _VSUM; o_DEF; _CMUL; _VEC] THEN
+      SIMP_TAC[REAL_MUL_RID; ETA_AX] THEN ASM_MESON_TAC[MEASURE_ELEMENTARY];
+      ALL_TAC] THEN
+    SUBGOAL_THEN
+     `vsum D (\<lambda>k. integral k (\<lambda>x:real^N. if x \<in> s then 1 else 0)) =
+      lift(sum D (\<lambda>k. measure(k \<inter> s)))`
+    SUBST1_TAC THENL
+     [ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC VSUM_EQ THEN
+      X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN
+      SUBGOAL_THEN `measurable(k:real^N->bool)` ASSUME_TAC THENL
+       [ASM_MESON_TAC[SUBSET; GMEASURABLE_INTERVAL]; ALL_TAC] THEN
+      ASM_SIMP_TAC[GSYM INTEGRAL_MEASURE_UNIV; GMEASURABLE_INTER] THEN
+      REWRITE_TAC[MESON[IN_INTER]
+        `(if x \<in> k \<inter> s then a else b) =
+         (if x \<in> k then if x \<in> s then a else b else b)`] THEN
+      CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_RESTRICT_UNIV THEN
+      ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN
+      REWRITE_TAC[MESON[IN_INTER]
+       `(if x \<in> k then if x \<in> s then a else b else b) =
+        (if x \<in> k \<inter> s then a else b)`] THEN
+      ASM_SIMP_TAC[GSYM GMEASURABLE_INTEGRABLE; GMEASURABLE_INTER];
+      ALL_TAC] THEN
+    ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN
+    MATCH_MP_TAC(REAL_ARITH `y \<le> m ==> abs(x - y) \<le> e ==> x \<le> m + e`) THEN
+    MATCH_MP_TAC REAL_LE_TRANS THEN
+    EXISTS_TAC `measure(\<Union>D \<inter> s:real^N->bool)` THEN
+    CONJ_TAC THENL
+     [ALL_TAC;
+      EXPAND_TAC "m" THEN MATCH_MP_TAC MEASURE_SUBSET THEN
+      ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN
+      MATCH_MP_TAC GMEASURABLE_INTER THEN ASM_REWRITE_TAC[]] THEN
+    REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN
+    ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN CONV_TAC SYM_CONV THEN
+    MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN
+    ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL
+     [ASM_MESON_TAC[SUBSET; GMEASURABLE_INTERVAL; GMEASURABLE_INTER];
+      ALL_TAC] THEN
+    MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN
+    STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+    EXISTS_TAC `k \<inter> l:real^N->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[];
+    ALL_TAC] THEN
+  ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
+   [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN
+  MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
+  ASM_REWRITE_TAC[INFINITE] THEN
+  DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
+   (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
+  MP_TAC(ISPECL [`s:num->real^N->bool`; `m + e:real`]
+    HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN
+  MATCH_MP_TAC(TAUT `a \<and> (a \<and> b ==> c) ==> (a ==> b) ==> c`) THEN
+  REWRITE_TAC[GSYM CONJ_ASSOC] THEN
+  RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
+                              FORALL_IN_IMAGE; IN_UNIV]) THEN
+  RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
+  REPEAT CONJ_TAC THENL
+   [ASM_MESON_TAC[MEASURABLE_INTERVAL; GMEASURABLE_INTER];
+    ASM_MESON_TAC[];
+    X_GEN_TAC `n:num` THEN
+    FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (s:num->real^N->bool) (0..n)`) THEN
+    SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_SUBSET; SUBSET_UNIV] THEN
+    DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+    MATCH_MP_TAC(REAL_ARITH `x = y ==> x \<le> e ==> y \<le> e`) THEN
+    MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN
+    ASM_MESON_TAC[FINITE_NUMSEG; GMEASURABLE_INTERVAL];
+    ALL_TAC] THEN
+  ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN
+  GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_)] THEN
+  REWRITE_TAC[] THEN
+  MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_UBOUND) THEN
+  EXISTS_TAC
+   `\n. vsum(from 0 \<inter> (0..n)) (\<lambda>n. lift(measure(s n:real^N->bool)))` THEN
+  ASM_REWRITE_TAC[GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN
+  REWRITE_TAC[DIMINDEX_1; ARITH; EVENTUALLY_SEQUENTIALLY] THEN
+  SIMP_TAC[VSUM_COMPONENT; ARITH; DIMINDEX_1] THEN
+  ASM_REWRITE_TAC[GSYM ; LIFT_; FROM_INTER_NUMSEG]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Hence for linear transformation, suffices to check compact intervals.     *)
+(* ------------------------------------------------------------------------- *)
+
+lemma GMEASURABLE_LINEAR_IMAGE_INTERVAL: True .. (*
+ "!f a b. linear f ==> gmeasurable(IMAGE f {a..b})"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC GMEASURABLE_CONVEX THEN CONJ_TAC THENL
+   [MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN
+    ASM_MESON_TAC[CONVEX_INTERVAL];
+    MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN
+    ASM_MESON_TAC[BOUNDED_INTERVAL]]);; *)
+
+lemma HAS_GMEASURE_LINEAR_SUFFICIENT: True .. (*
+ "!f:real^N->real^N m.
+        linear f \<and>
+        (!a b. IMAGE f {a..b} has_gmeasure
+               (m * measure{a..b}))
+        ==> !s. gmeasurable s ==> (IMAGE f s) has_gmeasure (m * gmeasure s)"
+qed   REPEAT GEN_TAC THEN STRIP_TAC THEN
+  DISJ_CASES_TAC(REAL_ARITH `m < 0 \/ 0 \<le> m`) THENL
+   [FIRST_X_ASSUM(MP_TAC o SPECL [`0:real^N`; `1:real^N`]) THEN
+    DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_POS_LE) THEN
+    MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN
+    MATCH_MP_TAC(REAL_ARITH `0 < --m * x ==> ~(0 \<le> m * x)`) THEN
+    MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_NEG_GT0] THEN
+    REWRITE_TAC[MEASURE_INTERVAL] THEN MATCH_MP_TAC CONTENT_POS_LT THEN
+    SIMP_TAC[VEC_COMPONENT; REAL_LT_01];
+    ALL_TAC] THEN
+  ASM_CASES_TAC `!x y. (f:real^N->real^N) x = f y ==> x = y` THENL
+   [ALL_TAC;
+    SUBGOAL_THEN `!s. negligible(IMAGE (f:real^N->real^N) s)` ASSUME_TAC THENL
+     [ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; ALL_TAC] THEN
+    SUBGOAL_THEN `m * measure(interval[0:real^N,1]) = 0` MP_TAC THENL
+     [MATCH_MP_TAC(ISPEC `IMAGE (f:real^N->real^N) {0..1}`
+        HAS_GMEASURE_UNIQUE) THEN
+      ASM_REWRITE_TAC[HAS_GMEASURE_0];
+      REWRITE_TAC[REAL_ENTIRE; MEASURE_INTERVAL] THEN
+      MATCH_MP_TAC(TAUT `~b \<and> (a ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL
+       [SIMP_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL;
+                 INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01];
+        ASM_SIMP_TAC[REAL_MUL_LZERO; HAS_GMEASURE_0]]]] THEN
+  MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_ISOMORPHISM) THEN
+  ASM_REWRITE_TAC[] THEN
+  DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN
+  UNDISCH_THEN `!x y. (f:real^N->real^N) x = f y ==> x = y` (K ALL_TAC) THEN
+  SUBGOAL_THEN
+   `!s. bounded s \<and> gmeasurable s
+        ==> (IMAGE (f:real^N->real^N) s) has_gmeasure (m * gmeasure s)`
+  ASSUME_TAC THENL
+   [REPEAT STRIP_TAC THEN
+    FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
+    REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN
+    MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
+    SUBGOAL_THEN
+     `!d. COUNTABLE d \<and>
+          (!k. k \<in> d ==> k \<subseteq> {a..b} \<and> ~(k = {}) \<and>
+                          (\<exists>c d. k = {c..d})) \<and>
+          (!k1 k2. k1 \<in> d \<and> k2 \<in> d \<and> ~(k1 = k2)
+                   ==> interior k1 \<inter> interior k2 = {})
+          ==> IMAGE (f:real^N->real^N) (\<Union>d) has_gmeasure
+                    (m * measure(\<Union>d))`
+    ASSUME_TAC THENL
+     [REWRITE_TAC[IMAGE_UNIONS] THEN REPEAT STRIP_TAC THEN
+      SUBGOAL_THEN
+       `!g:real^N->real^N.
+          linear g
+          ==> !k l. k \<in> d \<and> l \<in> d \<and> ~(k = l)
+                    ==> negligible((IMAGE g k) \<inter> (IMAGE g l))`
+      MP_TAC THENL
+       [REPEAT STRIP_TAC THEN
+        ASM_CASES_TAC `!x y. (g:real^N->real^N) x = g y ==> x = y` THENL
+         [ALL_TAC;
+          ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE;
+                        NEGLIGIBLE_INTER]] THEN
+        MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+        EXISTS_TAC `frontier(IMAGE (g:real^N->real^N) k \<inter> IMAGE g l) UNION
+                    interior(IMAGE g k \<inter> IMAGE g l)` THEN
+        CONJ_TAC THENL
+         [ALL_TAC;
+          REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE
+           `s \<subseteq> t ==> s \<subseteq> (t DIFF u) \<union> u`) THEN
+          REWRITE_TAC[CLOSURE_SUBSET]] THEN
+        MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THENL
+         [MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN
+          MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THEN
+          MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_MESON_TAC[CONVEX_INTERVAL];
+          ALL_TAC] THEN
+        REWRITE_TAC[INTERIOR_INTER] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+        EXISTS_TAC `IMAGE (g:real^N->real^N) (interior k) INTER
+                    IMAGE g (interior l)` THEN
+        CONJ_TAC THENL
+         [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+          EXISTS_TAC
+           `IMAGE (g:real^N->real^N) (interior k \<inter> interior l)` THEN
+          CONJ_TAC THENL
+           [ASM_SIMP_TAC[IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]; SET_TAC[]];
+          MATCH_MP_TAC(SET_RULE
+           `s \<subseteq> u \<and> t \<subseteq> v ==> (s \<inter> t) \<subseteq> (u \<inter> v)`) THEN
+          CONJ_TAC THEN MATCH_MP_TAC INTERIOR_IMAGE_SUBSET THEN
+          ASM_MESON_TAC[LINEAR_CONTINUOUS_AT]];
+        ALL_TAC] THEN
+      DISCH_THEN(fun th -> MP_TAC(SPEC `f:real^N->real^N` th) THEN
+          MP_TAC(SPEC `\x:real^N. x` th)) THEN
+      ASM_REWRITE_TAC[LINEAR_ID; SET_RULE `IMAGE (\<lambda>x. x) s = s`] THEN
+      REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL
+       [MP_TAC(ISPECL [`IMAGE (f:real^N->real^N)`; `d:(real^N->bool)->bool`]
+                  HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
+        ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN
+        MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
+        MATCH_MP_TAC EQ_TRANS THEN
+        EXISTS_TAC `sum d (\<lambda>k:real^N->bool. m * gmeasure k)` THEN CONJ_TAC THENL
+         [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN
+        REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN
+        CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS THEN
+        ASM_REWRITE_TAC[GSYM HAS_GMEASURE_MEASURE] THEN
+        ASM_MESON_TAC[MEASURABLE_INTERVAL];
+        ALL_TAC] THEN
+      MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN
+      ASM_REWRITE_TAC[INFINITE] THEN
+      DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool`
+       (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN
+      MP_TAC(ISPEC `s:num->real^N->bool`
+        HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
+      MP_TAC(ISPEC `\n:num. IMAGE (f:real^N->real^N) (s n)`
+        HAS_GMEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN
+      RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM;
+                                  FORALL_IN_IMAGE; IN_UNIV]) THEN
+      RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN
+      ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ANTS_TAC THENL
+       [REPEAT CONJ_TAC THENL
+         [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_INTERVAL];
+          ASM_MESON_TAC[];
+          ONCE_REWRITE_TAC[GSYM o_DEF] THEN
+          REWRITE_TAC[GSYM IMAGE_UNIONS; IMAGE_o] THEN
+          MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN
+          MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
+          EXISTS_TAC `interval[a:real^N,b]` THEN
+          REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
+        ALL_TAC] THEN
+      STRIP_TAC THEN ANTS_TAC THENL
+       [REPEAT CONJ_TAC THENL
+         [ASM_MESON_TAC[MEASURABLE_INTERVAL];
+          ASM_MESON_TAC[];
+          MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN
+          EXISTS_TAC `interval[a:real^N,b]` THEN
+          REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]];
+        ALL_TAC] THEN
+      STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN
+      SUBGOAL_THEN `m * gmeasure (\<Union>(IMAGE s (:num)):real^N->bool) =
+             measure(\<Union>(IMAGE (\<lambda>x. IMAGE f (s x)) (:num)):real^N->bool)`
+       (fun th -> ASM_REWRITE_TAC[GSYM HAS_GMEASURE_MEASURE; th]) THEN
+      ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN
+      MATCH_MP_TAC SERIES_UNIQUE THEN
+      EXISTS_TAC `\n:num. lift(measure(IMAGE (f:real^N->real^N) (s n)))` THEN
+      EXISTS_TAC `from 0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUMS_EQ THEN
+      EXISTS_TAC `\n:num. m % lift(measure(s n:real^N->bool))` THEN
+      CONJ_TAC THENL
+       [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_EQ] THEN
+        ASM_MESON_TAC[MEASURE_UNIQUE];
+        REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC SERIES_CMUL THEN
+        ASM_REWRITE_TAC[]];
+      ALL_TAC] THEN
+    REWRITE_TAC[HAS_GMEASURE_INNER_OUTER_LE] THEN CONJ_TAC THEN
+    X_GEN_TAC `e:real` THEN DISCH_TAC THENL
+     [MP_TAC(ISPECL [`{a..b} DIFF s:real^N->bool`; `a:real^N`;
+       `b:real^N`; `e / (1 + abs m)`] GMEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
+      ANTS_TAC THENL
+       [ASM_SIMP_TAC[MEASURABLE_DIFF; GMEASURABLE_INTERVAL] THEN
+        ASM_SIMP_TAC[REAL_ARITH `0 < 1 + abs x`; REAL_LT_DIV] THEN SET_TAC[];
+        ALL_TAC] THEN
+      DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
+      EXISTS_TAC `IMAGE f {a..b} DIFF
+                  IMAGE (f:real^N->real^N) (\<Union>d)` THEN
+      FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
+      ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_TAC THEN
+      CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL
+       [ASM_MESON_TAC[MEASURABLE_DIFF; gmeasurable]; ALL_TAC] THEN
+      MATCH_MP_TAC REAL_LE_TRANS THEN
+      EXISTS_TAC `measure(IMAGE f {a..b}) -
+                  measure(IMAGE (f:real^N->real^N) (\<Union>d))` THEN
+      CONJ_TAC THENL
+       [ALL_TAC;
+        MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN
+        MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
+        REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC]) THEN
+        MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[UNIONS_SUBSET]] THEN
+      FIRST_ASSUM(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN
+      REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE)) THEN
+      MATCH_MP_TAC REAL_LE_TRANS THEN
+      EXISTS_TAC `m * measure(s:real^N->bool) - m * e / (1 + abs m)` THEN
+      CONJ_TAC THENL
+       [REWRITE_TAC[REAL_ARITH `a - x \<le> a - y \<longleftrightarrow> y \<le> x`] THEN
+        REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
+        REWRITE_TAC[GSYM real_div] THEN
+        ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `0 < 1 + abs x`] THEN
+        GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
+        ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC;
+        ALL_TAC] THEN
+      REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN
+      ASM_REWRITE_TAC[] THEN
+      FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
+        `d \<le> a + e ==> a = i - s ==> s - e \<le> i - d`)) THEN
+      MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN
+      ASM_REWRITE_TAC[MEASURABLE_INTERVAL];
+      MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`;
+                `e / (1 + abs m)`] GMEASURABLE_OUTER_INTERVALS_BOUNDED) THEN
+      ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `0 < 1 + abs x`] THEN
+      DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN
+      EXISTS_TAC `IMAGE (f:real^N->real^N) (\<Union>d)` THEN
+      FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN
+      ASM_SIMP_TAC[IMAGE_SUBSET] THEN
+      SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC THEN
+      MATCH_MP_TAC REAL_LE_TRANS THEN
+      EXISTS_TAC `m * measure(s:real^N->bool) + m * e / (1 + abs m)` THEN
+      CONJ_TAC THENL
+       [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_LMUL];
+        REWRITE_TAC[REAL_LE_LADD] THEN
+        REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN
+        REWRITE_TAC[GSYM real_div] THEN
+        ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `0 < 1 + abs x`] THEN
+        GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
+        ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC]];
+      ALL_TAC] THEN
+  REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_GMEASURE_LIMIT] THEN
+  X_GEN_TAC `e:real` THEN DISCH_TAC THEN
+  FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_GMEASURE_MEASURE]) THEN
+  GEN_REWRITE_TAC LAND_CONV [HAS_GMEASURE_LIMIT] THEN
+  DISCH_THEN(MP_TAC o SPEC `e / (1 + abs m)`) THEN
+  ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `0 < 1 + abs x`] THEN
+  DISCH_THEN(X_CHOOSE_THEN `B:real`
+   (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN
+  MP_TAC(ISPEC `ball(0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN
+  REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN
+  REMOVE_THEN "*" MP_TAC THEN
+  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N` THEN
+  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N` THEN
+  DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
+  DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN
+  MP_TAC(ISPECL [`interval[c:real^N,d]`; `0:real^N`]
+    BOUNDED_SUBSET_BALL) THEN
+  REWRITE_TAC[BOUNDED_INTERVAL] THEN
+  DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN
+  MP_TAC(ISPEC `f:real^N->real^N` LINEAR_BOUNDED_POS) THEN
+  ASM_REWRITE_TAC[] THEN
+  DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN
+
+  EXISTS_TAC `D * C` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN
+  MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN
+  FIRST_X_ASSUM(MP_TAC o SPEC
+   `s \<inter> (IMAGE (h:real^N->real^N) {a..b})`) THEN
+  SUBGOAL_THEN
+   `IMAGE (f:real^N->real^N) (s \<inter> IMAGE h (interval [a,b])) =
+    (IMAGE f s) \<inter> {a..b}`
+  SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL
+   [ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
+    ASM_SIMP_TAC[MEASURABLE_INTER; GMEASURABLE_LINEAR_IMAGE_INTERVAL];
+    ALL_TAC] THEN
+  DISCH_TAC THEN EXISTS_TAC
+   `m * measure(s \<inter> (IMAGE (h:real^N->real^N) {a..b}))` THEN
+  ASM_REWRITE_TAC[] THEN
+  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `m * e / (1 + abs m)` THEN
+  CONJ_TAC THENL
+   [ALL_TAC;
+    REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN
+    ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `0 < 1 + abs x`] THEN
+    GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
+    ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN REAL_ARITH_TAC] THEN
+  REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN
+  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [real_abs] THEN
+  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN
+  FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH
+   `abs(z - m) < e ==> z \<le> w \<and> w \<le> m ==> abs(w - m) \<le> e`)) THEN
+  SUBST1_TAC(SYM(MATCH_MP MEASURE_UNIQUE
+   (ASSUME `s \<inter> interval [c:real^N,d] has_gmeasure z`))) THEN
+  CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN
+  ASM_SIMP_TAC[MEASURABLE_INTER; GMEASURABLE_LINEAR_IMAGE_INTERVAL;
+               GMEASURABLE_INTERVAL; INTER_SUBSET] THEN
+  MATCH_MP_TAC(SET_RULE
+   `!v. t \<subseteq> v \<and> v \<subseteq> u ==> s \<inter> t \<subseteq> s \<inter> u`) THEN
+  EXISTS_TAC `ball(0:real^N,D)` THEN ASM_REWRITE_TAC[] THEN
+  MATCH_MP_TAC(SET_RULE
+   `!f. (!x. h(f x) = x) \<and> IMAGE f s \<subseteq> t ==> s \<subseteq> IMAGE h t`) THEN
+  EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN
+  MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(0:real^N,D * C)` THEN
+  ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0] THEN
+  X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN
+  MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `C * norm(x:real^N)` THEN
+  ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN
+  ASM_SIMP_TAC[REAL_LT_LMUL_EQ]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Some inductions by expressing mapping in terms of elementary matrices.    *)
+(* ------------------------------------------------------------------------- *)
+
+lemma INDUCT_MATRIX_ROW_OPERATIONS: True .. (*
+ "!P:real^N^N->bool.
+        (!A i. 1 \<le> i \<and> i \<le> dimindex(:N) \<and> row i A = 0 ==> P A) \<and>
+        (!A. (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
+                    1 \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
+                    ==> A$i$j = 0) ==> P A) \<and>
+        (!A m n. P A \<and> 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+                 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+                 ==> P(lambda i j. A$i$(swap(m,n) j))) \<and>
+        (!A m n c. P A \<and> 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+                   1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+                   ==> P(lambda i. if i = m then row m A + c % row n A
+                                   else row i A))
+        ==> !A. P A"
+qed   GEN_TAC THEN
+  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "zero_row") MP_TAC) THEN
+  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "diagonal") MP_TAC) THEN
+  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "swap_cols") (LABEL_TAC "row_op")) THEN
+  SUBGOAL_THEN
+   `!k A:real^N^N.
+        (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
+               k \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
+               ==> A$i$j = 0)
+        ==> P A`
+   (fun th -> GEN_TAC THEN MATCH_MP_TAC th THEN
+              EXISTS_TAC `dimindex(:N) + 1` THEN ARITH_TAC) THEN
+  MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
+   [REPEAT STRIP_TAC THEN USE_THEN "diagonal" MATCH_MP_TAC THEN
+    REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN
+    ASM_REWRITE_TAC[LE_0];
+    ALL_TAC] THEN
+  X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "ind_hyp") THEN
+  DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC (ARITH_RULE `k = 0 \/ 1 \<le> k`) THEN
+  ASM_REWRITE_TAC[ARITH] THEN
+  ASM_CASES_TAC `k \<le> dimindex(:N)` THENL
+   [ALL_TAC;
+    REPEAT STRIP_TAC THEN REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
+    ASM_ARITH_TAC] THEN
+  SUBGOAL_THEN
+   `!A:real^N^N.
+        ~(A$k$k = 0) \<and>
+        (!i j. 1 \<le> i \<and> i \<le> dimindex (:N) \<and>
+               SUC k \<le> j \<and> j \<le> dimindex (:N) \<and> ~(i = j)
+               ==> A$i$j = 0)
+        ==> P A`
+  (LABEL_TAC "nonzero_hyp") THENL
+   [ALL_TAC;
+    X_GEN_TAC `A:real^N^N` THEN DISCH_TAC THEN
+    ASM_CASES_TAC `row k (A:real^N^N) = 0` THENL
+     [REMOVE_THEN "zero_row" MATCH_MP_TAC THEN ASM_MESON_TAC[];
+      ALL_TAC] THEN
+    FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN
+    SIMP_TAC[VEC_COMPONENT; row; LAMBDA_BETA] THEN
+    REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN
+    X_GEN_TAC `l:num` THEN STRIP_TAC THEN
+    ASM_CASES_TAC `l:num = k` THENL
+     [REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN ASM_MESON_TAC[];
+      ALL_TAC] THEN
+    REMOVE_THEN "swap_cols" (MP_TAC o SPECL
+     [`(lambda i j. (A:real^N^N)$i$swap(k,l) j):real^N^N`;
+      `k:num`; `l:num`]) THEN
+    ASM_SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL
+     [ALL_TAC;
+      MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
+      SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
+      REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
+      REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])] THEN
+    REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN
+    ONCE_REWRITE_TAC[ARITH_RULE `SUC k \<le> i \<longleftrightarrow> 1 \<le> i \<and> SUC k \<le> i`] THEN
+    ASM_SIMP_TAC[LAMBDA_BETA] THEN
+    ASM_REWRITE_TAC[swap] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN
+    STRIP_TAC THEN SUBGOAL_THEN `l:num \<le> k` ASSUME_TAC THENL
+     [FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
+      ASM_REWRITE_TAC[] THEN ARITH_TAC;
+      ALL_TAC] THEN
+    REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
+    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
+    ASM_ARITH_TAC] THEN
+   SUBGOAL_THEN
+   `!l A:real^N^N.
+        ~(A$k$k = 0) \<and>
+        (!i j. 1 \<le> i \<and> i \<le> dimindex (:N) \<and>
+               SUC k \<le> j \<and> j \<le> dimindex (:N) \<and> ~(i = j)
+               ==> A$i$j = 0) \<and>
+        (!i. l \<le> i \<and> i \<le> dimindex(:N) \<and> ~(i = k) ==> A$i$k = 0)
+        ==> P A`
+   MP_TAC THENL
+    [ALL_TAC;
+     DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN
+     REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `~(n + 1 \<le> i \<and> i \<le> n)`]] THEN
+   MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL
+    [GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+     DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
+     USE_THEN "ind_hyp" MATCH_MP_TAC THEN
+     MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
+     ASM_CASES_TAC `j:num = k` THENL
+      [ASM_REWRITE_TAC[] THEN USE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
+       REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
+    ALL_TAC] THEN
+  X_GEN_TAC `l:num` THEN DISCH_THEN(LABEL_TAC "inner_hyp") THEN
+  GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+  DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN
+  ASM_CASES_TAC `l:num = k` THENL
+   [REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
+    REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
+    ALL_TAC] THEN
+  DISJ_CASES_TAC(ARITH_RULE `l = 0 \/ 1 \<le> l`) THENL
+   [REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN
+    MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN
+    ASM_CASES_TAC `j:num = k` THENL
+     [ASM_REWRITE_TAC[] THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC;
+      REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC];
+    ALL_TAC] THEN
+  ASM_CASES_TAC `l \<le> dimindex(:N)` THENL
+   [ALL_TAC;
+    REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN
+    ASM_ARITH_TAC] THEN
+  REMOVE_THEN "inner_hyp" (MP_TAC o SPECL
+   [`(lambda i. if i = l then row l (A:real^N^N) + --(A$l$k/A$k$k) % row k A
+                else row i A):real^N^N`]) THEN
+  ANTS_TAC THENL
+   [SUBGOAL_THEN `!i. l \<le> i ==> 1 \<le> i` ASSUME_TAC THENL
+     [ASM_ARITH_TAC; ALL_TAC] THEN
+    ONCE_REWRITE_TAC[ARITH_RULE `SUC k \<le> j \<longleftrightarrow> 1 \<le> j \<and> SUC k \<le> j`] THEN
+    ASM_SIMP_TAC[LAMBDA_BETA; row; COND_COMPONENT;
+                 VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
+    ASM_SIMP_TAC[REAL_FIELD `~(y = 0) ==> x + --(x / y) * y = 0`] THEN
+    REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN
+    ASM_CASES_TAC `i:num = l` THEN ASM_REWRITE_TAC[] THENL
+     [REPEAT STRIP_TAC THEN
+      MATCH_MP_TAC(REAL_RING `x = 0 \<and> y = 0 ==> x + z * y = 0`) THEN
+      CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
+      REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC];
+    ALL_TAC] THEN
+  DISCH_TAC THEN REMOVE_THEN "row_op" (MP_TAC o SPECL
+   [`(lambda i. if i = l then row l A + --(A$l$k / A$k$k) % row k A
+                else row i (A:real^N^N)):real^N^N`;
+    `l:num`; `k:num`; `(A:real^N^N)$l$k / A$k$k`]) THEN
+  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
+  ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
+               VECTOR_MUL_COMPONENT; row; COND_COMPONENT] THEN
+  REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+  REAL_ARITH_TAC);; *)
+
+lemma INDUCT_MATRIX_ELEMENTARY: True .. (*
+ "!P:real^N^N->bool.
+        (!A B. P A \<and> P B ==> P(A ** B)) \<and>
+        (!A i. 1 \<le> i \<and> i \<le> dimindex(:N) \<and> row i A = 0 ==> P A) \<and>
+        (!A. (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
+                    1 \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
+                    ==> A$i$j = 0) ==> P A) \<and>
+        (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+               1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+               ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) \<and>
+        (!m n c. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+                 1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+                 ==> P(lambda i j. if i = m \<and> j = n then c
+                                   else if i = j then 1 else 0))
+        ==> !A. P A"
+qed   GEN_TAC THEN
+  DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN
+  DISCH_THEN(fun th ->
+    MATCH_MP_TAC INDUCT_MATRIX_ROW_OPERATIONS THEN MP_TAC th) THEN
+  REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN
+  DISCH_THEN(fun th -> X_GEN_TAC `A:real^N^N` THEN MP_TAC th) THEN
+  REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN
+  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN
+  UNDISCH_TAC `(P:real^N^N->bool) A` THENL
+   [REWRITE_TAC[GSYM IMP_CONJ]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN
+  DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC EQ_IMP THEN
+  AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
+  X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+  X_GEN_TAC `j:num` THEN STRIP_TAC THEN
+  ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul; row] THENL
+   [ASM_SIMP_TAC[mat; IN_DIMINDEX_SWAP; LAMBDA_BETA] THEN
+    ONCE_REWRITE_TAC[COND_RAND] THEN
+    SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; REAL_MUL_RID] THEN
+    COND_CASES_TAC THEN REWRITE_TAC[] THEN
+    RULE_ASSUM_TAC(REWRITE_RULE[swap; IN_NUMSEG]) THEN ASM_ARITH_TAC;
+    ALL_TAC] THEN
+  ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THENL
+   [ALL_TAC;
+    ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
+    REWRITE_TAC[REAL_MUL_LZERO] THEN
+    GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
+    ASM_SIMP_TAC[SUM_DELTA; LAMBDA_BETA; IN_NUMSEG; REAL_MUL_LID]] THEN
+  ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN
+  MATCH_MP_TAC EQ_TRANS THEN
+  EXISTS_TAC
+    `sum {m,n} (\<lambda>k. (if k = n then c else if m = k then 1 else 0) *
+                    (A:real^N^N)$k$j)` THEN
+  CONJ_TAC THENL
+   [MATCH_MP_TAC SUM_SUPERSET THEN
+    ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
+                 IN_NUMSEG; REAL_MUL_LZERO] THEN
+    ASM_ARITH_TAC;
+    ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
+    REAL_ARITH_TAC]);; *)
+
+lemma INDUCT_MATRIX_ELEMENTARY_ALT: True .. (*
+ "!P:real^N^N->bool.
+        (!A B. P A \<and> P B ==> P(A ** B)) \<and>
+        (!A i. 1 \<le> i \<and> i \<le> dimindex(:N) \<and> row i A = 0 ==> P A) \<and>
+        (!A. (!i j. 1 \<le> i \<and> i \<le> dimindex(:N) \<and>
+                    1 \<le> j \<and> j \<le> dimindex(:N) \<and> ~(i = j)
+                    ==> A$i$j = 0) ==> P A) \<and>
+        (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+               1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+               ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) \<and>
+        (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+               1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+               ==> P(lambda i j. if i = m \<and> j = n \/ i = j then 1 else 0))
+        ==> !A. P A"
+qed   GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC INDUCT_MATRIX_ELEMENTARY THEN
+  ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN
+  ASM_CASES_TAC `c = 0` THENL
+   [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
+        MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
+    ASM_SIMP_TAC[LAMBDA_BETA; COND_ID];
+    ALL_TAC] THEN
+  SUBGOAL_THEN
+   `(lambda i j. if i = m \<and> j = n then c else if i = j then 1 else 0) =
+  ((lambda i j. if i = j then if j = n then inv c else 1 else 0):real^N^N) **
+    ((lambda i j. if i = m \<and> j = n \/ i = j then 1 else 0):real^N^N) **
+    ((lambda i j. if i = j then if j = n then c else 1 else 0):real^N^N)`
+  SUBST1_TAC THENL
+   [ALL_TAC;
+    REPEAT(MATCH_MP_TAC(ASSUME `!A B:real^N^N. P A \<and> P B ==> P(A ** B)`) THEN
+           CONJ_TAC) THEN
+    ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN
+        MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN
+    ASM_SIMP_TAC[LAMBDA_BETA]] THEN
+  SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN
+  X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+  X_GEN_TAC `j:num` THEN STRIP_TAC THEN
+  ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_ARITH
+       `(if p then 1 else 0) * (if q then c else 0) =
+        if q then if p then c else 0 else 0`] THEN
+  REWRITE_TAC[REAL_ARITH
+   `(if p then x else 0) * y = (if p then x * y else 0)`] THEN
+  GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
+  ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN
+  ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
+  ASM_CASES_TAC `j:num = n` THEN ASM_REWRITE_TAC[REAL_MUL_LID; EQ_SYM_EQ] THEN
+  ASM_CASES_TAC `i:num = n` THEN
+  ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID; REAL_MUL_RZERO]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* The same thing in mapping form (might have been easier all along).        *)
+(* ------------------------------------------------------------------------- *)
+
+lemma INDUCT_LINEAR_ELEMENTARY: True .. (*
+ "!P. (!f g. linear f \<and> linear g \<and> P f \<and> P g ==> P(f o g)) \<and>
+       (!f i. linear f \<and> 1 \<le> i \<and> i \<le> dimindex(:N) \<and> (!x. (f x)$i = 0)
+              ==> P f) \<and>
+       (!c. P(\<lambda>x. lambda i. c i * x$i)) \<and>
+       (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+              1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+              ==> P(\<lambda>x. lambda i. x$swap(m,n) i)) \<and>
+       (!m n. 1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+              1 \<le> n \<and> n \<le> dimindex(:N) \<and> ~(m = n)
+              ==> P(\<lambda>x. lambda i. if i = m then x$m + x$n else x$i))
+       ==> !f:real^N->real^N. linear f ==> P f"
+qed   GEN_TAC THEN
+  MP_TAC(ISPEC `\A:real^N^N. P(\<lambda>x:real^N. A ** x):bool`
+    INDUCT_MATRIX_ELEMENTARY_ALT) THEN
+  REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL
+   [ALL_TAC;
+    DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_TAC THEN
+    FIRST_X_ASSUM(MP_TAC o SPEC `matrix(f:real^N->real^N)`) THEN
+    ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX]] THEN
+  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
+   [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `B:real^N^N`] THEN
+    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
+     [`\x:real^N. (A:real^N^N) ** x`; `\x:real^N. (B:real^N^N) ** x`]) THEN
+    ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN
+    REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC];
+    ALL_TAC] THEN
+  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
+   [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `m:num`] THEN
+    STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL
+     [`\x:real^N. (A:real^N^N) ** x`; `m:num`]) THEN
+    ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
+    DISCH_THEN MATCH_MP_TAC THEN
+    UNDISCH_TAC `row m (A:real^N^N) = 0` THEN
+    ASM_SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT; matrix_vector_mul;
+                 REAL_MUL_LZERO; SUM_0];
+    ALL_TAC] THEN
+  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL
+   [DISCH_TAC THEN X_GEN_TAC `A:real^N^N` THEN STRIP_TAC THEN
+    FIRST_X_ASSUM(MP_TAC o SPEC `\i. (A:real^N^N)$i$i`) THEN
+    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
+    ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA] THEN
+    MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
+    MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
+     `sum(1..dimindex(:N)) (\<lambda>j. if j = i then (A:real^N^N)$i$j * (x:real^N)$j
+                                else 0)` THEN
+    CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]; ALL_TAC] THEN
+    MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN
+    ASM_SIMP_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO];
+    ALL_TAC] THEN
+  MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN
+  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN
+  MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN
+  DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN
+  ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
+  ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA;
+               mat; IN_DIMINDEX_SWAP]
+  THENL
+   [ONCE_REWRITE_TAC[SWAP_GALOIS] THEN ONCE_REWRITE_TAC[COND_RAND] THEN
+    ONCE_REWRITE_TAC[COND_RATOR] THEN
+    SIMP_TAC[SUM_DELTA; REAL_MUL_LID; REAL_MUL_LZERO; IN_NUMSEG] THEN
+    REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN
+    COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC;
+    MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN
+    ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
+    ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN
+    GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN
+    ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_MUL_LID; IN_NUMSEG] THEN
+    MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
+     `sum {m,n} (\<lambda>j. if n = j \/ j = m then (x:real^N)$j else 0)` THEN
+    CONJ_TAC THENL
+     [SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN
+      ASM_REWRITE_TAC[REAL_ADD_RID];
+      CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN
+      ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM;
+                   IN_NUMSEG; REAL_MUL_LZERO] THEN
+      ASM_ARITH_TAC]]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Hence the effect of an arbitrary linear map on a gmeasurable set.          *)
+(* ------------------------------------------------------------------------- *)
+
+lemma LAMBDA_SWAP_GALOIS: True .. (*
+ "!x:real^N y:real^N.
+        1 \<le> m \<and> m \<le> dimindex(:N) \<and> 1 \<le> n \<and> n \<le> dimindex(:N)
+        ==> (x = (lambda i. y$swap(m,n) i) \<longleftrightarrow>
+             (lambda i. x$swap(m,n) i) = y)"
+qed   SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP] THEN
+  REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
+  DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+  FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
+  ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
+  ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]);; *)
+
+lemma LAMBDA_ADD_GALOIS: True .. (*
+ "!x:real^N y:real^N.
+        1 \<le> m \<and> m \<le> dimindex(:N) \<and> 1 \<le> n \<and> n \<le> dimindex(:N) \<and>
+        ~(m = n)
+        ==> (x = (lambda i. if i = m then y$m + y$n else y$i) \<longleftrightarrow>
+             (lambda i. if i = m then x$m - x$n else x$i) = y)"
+qed   SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
+  REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN
+  DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+  FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
+  FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN
+  ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN
+  REAL_ARITH_TAC);; *)
+
+lemma HAS_GMEASURE_SHEAR_INTERVAL: True .. (*
+ "!a b:real^N m n.
+        1 \<le> m \<and> m \<le> dimindex(:N) \<and>
+        1 \<le> n \<and> n \<le> dimindex(:N) \<and>
+        ~(m = n) \<and> ~({a..b} = {}) \<and>
+        0 \<le> a$n
+        ==> (IMAGE (\<lambda>x. (lambda i. if i = m then x$m + x$n else x$i))
+                   {a..b}:real^N->bool)
+            has_gmeasure gmeasure (interval [a,b])"
+qed   lemma lemma = prove
+   (`!s t u v:real^N->bool.
+          gmeasurable s \<and> gmeasurable t \<and> gmeasurable u \<and>
+          negligible(s \<inter> t) \<and> negligible(s \<inter> u) \<and>
+          negligible(t \<inter> u) \<and>
+          s \<union> t \<union> u = v
+          ==> v has_gmeasure (measure s) + (measure t) + (measure u)"
+qed     REPEAT STRIP_TAC THEN
+    ASM_SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE; GMEASURABLE_UNION] THEN
+    FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN
+    ASM_SIMP_TAC[MEASURE_UNION; GMEASURABLE_UNION] THEN
+    ASM_SIMP_TAC[MEASURE_EQ_0; UNION_OVER_INTER; MEASURE_UNION;
+                 GMEASURABLE_UNION; NEGLIGIBLE_INTER; GMEASURABLE_INTER] THEN
+    REAL_ARITH_TAC)
+  and lemma' = prove
+   (`!s t u a.
+          gmeasurable s \<and> gmeasurable t \<and>
+          s \<union> (IMAGE (\<lambda>x. a + x) t) = u \<and>
+          negligible(s \<inter> (IMAGE (\<lambda>x. a + x) t))
+          ==> gmeasure s + gmeasure t = gmeasure u"
+qed     REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN
+    ASM_SIMP_TAC[MEASURE_NEGLIGIBLE_UNION; GMEASURABLE_TRANSLATION;
+                 MEASURE_TRANSLATION]) in
+  REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN
+  SUBGOAL_THEN
+   `linear((\<lambda>x. lambda i. if i = m then x$m + x$n else x$i):real^N->real^N)`
+  ASSUME_TAC THENL
+   [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
+                 VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
+    ALL_TAC] THEN
+  MP_TAC(ISPECL
+   [`IMAGE (\<lambda>x. lambda i. if i = m then x$m + x$n else x$i)
+            (interval[a:real^N,b]):real^N->bool`;
+    `interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
+       {x:real^N | (basis m - basis n) dot x \<le> a$m}`;
+    `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
+       {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
+    `interval[a:real^N,
+              (lambda i. if i = m then (b:real^N)$m + b$n else b$i)]`]
+     lemma) THEN
+  ANTS_TAC THENL
+   [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
+                 CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
+                 CONVEX_INTER; GMEASURABLE_CONVEX; BOUNDED_INTER;
+                 BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
+    REWRITE_TAC[INTER] THEN
+    REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
+    ASM_SIMP_TAC[LAMBDA_ADD_GALOIS; UNWIND_THM1] THEN
+    ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
+                 DOT_BASIS; DOT_LSUB] THEN
+    ONCE_REWRITE_TAC[MESON[]
+       `(!i:num. P i) \<longleftrightarrow> P m \<and> (!i. ~(i = m) ==> P i)`] THEN
+    ASM_SIMP_TAC[] THEN
+    REWRITE_TAC[TAUT `(p \<and> x) \<and> (q \<and> x) \<and> r \<longleftrightarrow> x \<and> p \<and> q \<and> r`;
+                TAUT `(p \<and> x) \<and> q \<and> (r \<and> x) \<longleftrightarrow> x \<and> p \<and> q \<and> r`;
+                TAUT `((p \<and> x) \<and> q) \<and> (r \<and> x) \<and> s \<longleftrightarrow>
+                            x \<and> p \<and> q \<and> r \<and> s`;
+            TAUT `(a \<and> x \/ (b \<and> x) \<and> c \/ (d \<and> x) \<and> e \<longleftrightarrow> f \<and> x) \<longleftrightarrow>
+                  x ==> (a \/ b \<and> c \/ d \<and> e \<longleftrightarrow> f)`] THEN
+    ONCE_REWRITE_TAC[SET_RULE
+     `{x | P x \<and> Q x} = {x | P x} \<inter> {x | Q x}`] THEN
+    REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL
+     [ALL_TAC;
+      GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN
+      ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN
+    REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THEN
+    MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
+    MATCH_MP_TAC NEGLIGIBLE_SUBSET THENL
+     [EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`;
+      EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`;
+      EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`]
+    THEN (CONJ_TAC THENL
+      [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
+       REWRITE_TAC[VECTOR_SUB_EQ] THEN
+       ASM_MESON_TAC[BASIS_INJ];
+       ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
+                    NOT_IN_EMPTY] THEN
+       FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN
+       ASM_REAL_ARITH_TAC]);
+    ALL_TAC] THEN
+  ASM_SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE;
+               GMEASURABLE_LINEAR_IMAGE_INTERVAL;
+               GMEASURABLE_INTERVAL] THEN
+  MP_TAC(ISPECL
+   [`interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER
+       {x:real^N | (basis m - basis n) dot x \<le> a$m}`;
+    `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER
+       {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`;
+    `interval[a:real^N,
+              (lambda i. if i = m then (a:real^N)$m + b$n
+                         else (b:real^N)$i)]`;
+    `(lambda i. if i = m then (a:real^N)$m - (b:real^N)$m
+                else 0):real^N`]
+     lemma') THEN
+  ANTS_TAC THENL
+   [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL;
+                 CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE;
+                 CONVEX_INTER; GMEASURABLE_CONVEX; BOUNDED_INTER;
+                 BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN
+    REWRITE_TAC[INTER] THEN
+    REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN
+    ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = (lambda i. p i) + y \<longleftrightarrow>
+                                   x - (lambda i. p i) = y`] THEN
+    ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA;
+                 DOT_BASIS; DOT_LSUB; UNWIND_THM1;
+                 VECTOR_SUB_COMPONENT] THEN
+    ONCE_REWRITE_TAC[MESON[]
+       `(!i:num. P i) \<longleftrightarrow> P m \<and> (!i. ~(i = m) ==> P i)`] THEN
+    ASM_SIMP_TAC[REAL_SUB_RZERO] THEN CONJ_TAC THENL
+     [X_GEN_TAC `x:real^N` THEN
+      FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
+      FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
+      ASM_REWRITE_TAC[] THEN
+      ASM_CASES_TAC
+       `!i. ~(i = m)
+            ==> 1 \<le> i \<and> i \<le> dimindex (:N)
+                ==> (a:real^N)$i \<le> (x:real^N)$i \<and>
+                    x$i \<le> (b:real^N)$i` THEN
+      ASM_REWRITE_TAC[] THEN
+      FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN
+      ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC;
+      ONCE_REWRITE_TAC[TAUT `((a \<and> b) \<and> c) \<and> (d \<and> e) \<and> f \<longleftrightarrow>
+                             (b \<and> e) \<and> a \<and> c \<and> d \<and> f`] THEN
+      ONCE_REWRITE_TAC[SET_RULE
+       `{x | P x \<and> Q x} = {x | P x} \<inter> {x | Q x}`] THEN
+      MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN
+      MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+      EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`
+      THEN CONJ_TAC THENL
+       [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN
+        REWRITE_TAC[VECTOR_SUB_EQ] THEN
+        ASM_MESON_TAC[BASIS_INJ];
+        ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM;
+                     NOT_IN_EMPTY] THEN
+        FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
+        FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
+        ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]];
+    ALL_TAC] THEN
+  DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH
+   `a = b + c ==> a = x + b ==> x = c`) THEN
+  ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES;
+               LAMBDA_BETA] THEN
+  REPEAT(COND_CASES_TAC THENL
+   [ALL_TAC;
+    FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN
+    MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN
+    X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+    COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN
+    FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN
+    FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN
+    ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) THEN
+  SUBGOAL_THEN `1..dimindex(:N) = m INSERT ((1..dimindex(:N)) DELETE m)`
+  SUBST1_TAC THENL
+   [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN
+    ASM_ARITH_TAC;
+    ALL_TAC] THEN
+  SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG] THEN
+  ASM_SIMP_TAC[IN_DELETE] THEN
+  MATCH_MP_TAC(REAL_RING
+   `s1 = s3 \<and> s2 = s3
+    ==> ((bm + bn) - am) * s1 =
+        ((am + bn) - am) * s2 + (bm - am) * s3`) THEN
+  CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN
+  SIMP_TAC[IN_DELETE] THEN REAL_ARITH_TAC);; *)
+
+lemma HAS_GMEASURE_LINEAR_IMAGE: True .. (*
+ "!f:real^N->real^N s.
+        linear f \<and> gmeasurable s
+        ==> (IMAGE f s) has_gmeasure (abs(det(matrix f)) * gmeasure s)"
+qed   REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN
+  MATCH_MP_TAC INDUCT_LINEAR_ELEMENTARY THEN REPEAT CONJ_TAC THENL
+   [MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN
+    REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN
+    DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN
+    DISCH_THEN(CONJUNCTS_THEN2
+     (MP_TAC o SPEC `IMAGE (g:real^N->real^N) s`)
+     (MP_TAC o SPEC `s:real^N->bool`)) THEN
+    ASM_REWRITE_TAC[] THEN
+    GEN_REWRITE_TAC LAND_CONV [HAS_GMEASURE_MEASURABLE_MEASURE] THEN
+    STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_COMPOSE; DET_MUL; REAL_ABS_MUL] THEN
+    REWRITE_TAC[IMAGE_o; GSYM REAL_MUL_ASSOC];
+
+    MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `m:num`] THEN STRIP_TAC THEN
+    SUBGOAL_THEN `~(!x y. (f:real^N->real^N) x = f y ==> x = y)`
+    ASSUME_TAC THENL
+     [ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN
+      EXISTS_TAC `basis m:real^N` THEN
+      ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS];
+      ALL_TAC] THEN
+    MP_TAC(ISPEC `matrix f:real^N^N` INVERTIBLE_DET_NZ) THEN
+    ASM_SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE_INJECTIVE;
+                 MATRIX_WORKS; REAL_ABS_NUM; REAL_MUL_LZERO] THEN
+    DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[HAS_GMEASURE_0] THEN
+    ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE];
+
+    MAP_EVERY X_GEN_TAC [`c:num->real`; `s:real^N->bool`] THEN
+    DISCH_TAC THEN
+    FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[HAS_GMEASURE_MEASURE]) THEN
+    FIRST_ASSUM(MP_TAC o SPEC `c:num->real` o
+     MATCH_MP HAS_GMEASURE_STRETCH) THEN
+    MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN
+    AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN
+    SIMP_TAC[matrix; LAMBDA_BETA] THEN
+    W(MP_TAC o PART_MATCH (lhs o rand) DET_DIAGONAL o rand o snd) THEN
+    SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; REAL_MUL_RZERO] THEN
+    DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN
+    REWRITE_TAC[REAL_MUL_RID];
+
+    MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
+    MATCH_MP_TAC HAS_GMEASURE_LINEAR_SUFFICIENT THEN
+    ASM_SIMP_TAC[linear; LAMBDA_BETA; IN_DIMINDEX_SWAP; VECTOR_ADD_COMPONENT;
+                 VECTOR_MUL_COMPONENT; CART_EQ] THEN
+    MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
+    SUBGOAL_THEN `matrix (\<lambda>x:real^N. lambda i. x$swap (m,n) i):real^N^N =
+                  transp(lambda i j. (mat 1:real^N^N)$i$swap (m,n) j)`
+    SUBST1_TAC THENL
+     [ASM_SIMP_TAC[MATRIX_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP;
+                    matrix_vector_mul; CART_EQ; matrix; mat; basis;
+                    COND_COMPONENT; transp] THEN
+      REWRITE_TAC[EQ_SYM_EQ];
+      ALL_TAC] THEN
+    REWRITE_TAC[DET_TRANSP] THEN
+    W(MP_TAC o PART_MATCH (lhs o rand) DET_PERMUTE_COLUMNS o
+        rand o lhand o rand o snd) THEN
+    ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; ETA_AX] THEN
+    DISCH_THEN(K ALL_TAC) THEN
+    REWRITE_TAC[DET_I; REAL_ABS_SIGN; REAL_MUL_RID; REAL_MUL_LID] THEN
+    ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
+     [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_GMEASURE_EMPTY; MEASURE_EMPTY];
+      ALL_TAC] THEN
+    SUBGOAL_THEN
+     `~(IMAGE (\<lambda>x:real^N. lambda i. x$swap (m,n) i)
+              {a..b}:real^N->bool = {})`
+    MP_TAC THENL [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
+    SUBGOAL_THEN
+     `IMAGE (\<lambda>x:real^N. lambda i. x$swap (m,n) i)
+              {a..b}:real^N->bool =
+      interval[(lambda i. a$swap (m,n) i),
+               (lambda i. b$swap (m,n) i)]`
+    SUBST1_TAC THENL
+     [REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_IMAGE] THEN
+      ASM_SIMP_TAC[LAMBDA_SWAP_GALOIS; UNWIND_THM1] THEN
+      SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN EQ_TAC THEN
+      DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+      FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN
+      ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN
+      ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT];
+      ALL_TAC] THEN
+    REWRITE_TAC[HAS_GMEASURE_MEASURABLE_MEASURE; GMEASURABLE_INTERVAL] THEN
+    REWRITE_TAC[MEASURE_INTERVAL] THEN
+    ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM INTERVAL_NE_EMPTY] THEN
+    DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LAMBDA_BETA] THEN
+    ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; IN_DIMINDEX_SWAP] THEN
+    MP_TAC(ISPECL [`\i. (b - a:real^N)$i`; `swap(m:num,n)`; `1..dimindex(:N)`]
+                (GSYM PRODUCT_PERMUTE)) THEN
+    REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN
+    ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG];
+
+    MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN
+    MATCH_MP_TAC HAS_GMEASURE_LINEAR_SUFFICIENT THEN
+    MATCH_MP_TAC(TAUT `a \<and> (a ==> b) ==> a \<and> b`) THEN CONJ_TAC THENL
+     [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT;
+                   VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC;
+      DISCH_TAC] THEN
+    MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN
+    SUBGOAL_THEN
+      `det(matrix(\<lambda>x. lambda i. if i = m then (x:real^N)$m + x$n
+                                else x$i):real^N^N) = 1`
+    SUBST1_TAC THENL
+     [ASM_SIMP_TAC[matrix; basis; COND_COMPONENT; LAMBDA_BETA] THEN
+      FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
+       `~(m:num = n) ==> m < n \/ n < m`))
+      THENL
+       [W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhs o snd);
+        W(MP_TAC o PART_MATCH (lhs o rand) DET_LOWERTRIANGULAR o lhs o snd)]
+      THEN ASM_SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
+                        matrix; REAL_ADD_RID; COND_ID;
+                        PRODUCT_CONST_NUMSEG; REAL_POW_ONE] THEN
+      DISCH_THEN MATCH_MP_TAC THEN
+      REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN
+      ASM_ARITH_TAC;
+      ALL_TAC] THEN
+    REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN
+    ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL
+     [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_GMEASURE_EMPTY; MEASURE_EMPTY];
+      ALL_TAC] THEN
+    SUBGOAL_THEN
+     `IMAGE (\<lambda>x. lambda i. if i = m then x$m + x$n else x$i) (interval [a,b]) =
+      IMAGE (\<lambda>x:real^N. (lambda i. if i = m \/ i = n then a$n else 0) +
+                        x)
+            (IMAGE (\<lambda>x:real^N. lambda i. if i = m then x$m + x$n else x$i)
+                   (IMAGE (\<lambda>x. (lambda i. if i = n then --(a$n) else 0) + x)
+                          {a..b}))`
+    SUBST1_TAC THENL
+     [REWRITE_TAC[GSYM IMAGE_o] THEN AP_THM_TAC THEN AP_TERM_TAC THEN
+      ASM_SIMP_TAC[FUN_EQ_THM; o_THM; VECTOR_ADD_COMPONENT; LAMBDA_BETA;
+                   CART_EQ] THEN
+      MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN
+      STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN
+      ASM_CASES_TAC `i:num = n` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC;
+      ALL_TAC] THEN
+    MATCH_MP_TAC HAS_GMEASURE_TRANSLATION THEN
+    SUBGOAL_THEN
+     `measure{a..b} =
+      measure(IMAGE (\<lambda>x:real^N. (lambda i. if i = n then --(a$n) else 0) + x)
+                    {a..b}:real^N->bool)`
+    SUBST1_TAC THENL
+     [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_TRANSLATION THEN
+      REWRITE_TAC[MEASURABLE_INTERVAL];
+      ALL_TAC] THEN
+    SUBGOAL_THEN
+     `~(IMAGE (\<lambda>x:real^N. (lambda i. if i = n then --(a$n) else 0) + x)
+                    {a..b}:real^N->bool = {})`
+    MP_TAC THENL [ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN
+    ONCE_REWRITE_TAC[VECTOR_ARITH `c + x = 1 % x + c`] THEN
+    ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS] THEN
+    DISCH_TAC THEN MATCH_MP_TAC HAS_GMEASURE_SHEAR_INTERVAL THEN
+    ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN
+    REAL_ARITH_TAC]);; *)
+
+lemma GMEASURABLE_LINEAR_IMAGE: True .. (*
+ "!f:real^N->real^N s.
+        linear f \<and> gmeasurable s ==> gmeasurable(IMAGE f s)"
+qed   REPEAT GEN_TAC THEN
+  DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_LINEAR_IMAGE) THEN
+  SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
+
+lemma MEASURE_LINEAR_IMAGE: True .. (*
+ "!f:real^N->real^N s.
+        linear f \<and> gmeasurable s
+        ==> measure(IMAGE f s) = abs(det(matrix f)) * gmeasure s"
+qed   REPEAT GEN_TAC THEN
+  DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_LINEAR_IMAGE) THEN
+  SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
+
+lemma HAS_GMEASURE_LINEAR_IMAGE_SAME: True .. (*
+ "!f s. linear f \<and> gmeasurable s \<and> abs(det(matrix f)) = 1
+         ==> (IMAGE f s) has_gmeasure (measure s)"
+qed   MESON_TAC[HAS_GMEASURE_LINEAR_IMAGE; REAL_MUL_LID]);; *)
+
+lemma MEASURE_LINEAR_IMAGE_SAME: True .. (*
+ "!f:real^N->real^N s.
+        linear f \<and> gmeasurable s \<and> abs(det(matrix f)) = 1
+        ==> measure(IMAGE f s) = gmeasure s"
+qed   REPEAT GEN_TAC THEN
+  DISCH_THEN(MP_TAC o MATCH_MP HAS_GMEASURE_LINEAR_IMAGE_SAME) THEN
+  SIMP_TAC[HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* gmeasure of a standard simplex.                                            *)
+(* ------------------------------------------------------------------------- *)
+
+lemma CONGRUENT_IMAGE_STD_SIMPLEX: True .. (*
+ "!p. p permutes 1..dimindex(:N)
+       ==> {x:real^N | 0 \<le> x$(p 1) \<and> x$(p(dimindex(:N))) \<le> 1 \<and>
+                       (!i. 1 \<le> i \<and> i < dimindex(:N)
+                            ==> x$(p i) \<le> x$(p(i + 1)))} =
+           IMAGE (\<lambda>x:real^N. lambda i. sum(1..inverse p(i)) (\<lambda>j. x$j))
+                 {x | (!i. 1 \<le> i \<and> i \<le> dimindex (:N) ==> 0 \<le> x$i) \<and>
+                      sum (1..dimindex (:N)) (\<lambda>i. x$i) \<le> 1}"
+qed   REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
+   [ALL_TAC;
+    REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN
+    ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
+                 ARITH_RULE `i < n ==> i \<le> n \<and> i + 1 \<le> n`;
+                 ARITH_RULE `1 \<le> n + 1`; DIMINDEX_GE_1] THEN
+    STRIP_TAC THEN
+    FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
+    ASM_SIMP_TAC[SUM_SING_NUMSEG; DIMINDEX_GE_1; LE_REFL] THEN
+    REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 \<le> SUC n`] THEN
+    ASM_SIMP_TAC[REAL_LE_ADDR] THEN REPEAT STRIP_TAC THEN
+    FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN
+  REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN
+  STRIP_TAC THEN
+  EXISTS_TAC `(lambda i. if i = 1 then x$(p 1)
+                         else (x:real^N)$p(i) - x$p(i - 1)):real^N` THEN
+  ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL;
+               ARITH_RULE `i < n ==> i \<le> n \<and> i + 1 \<le> n`;
+               ARITH_RULE `1 \<le> n + 1`; DIMINDEX_GE_1; CART_EQ] THEN
+  REPEAT CONJ_TAC THENL
+   [X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+    SUBGOAL_THEN `1 \<le> inverse (p:num->num) i \<and>
+                  !x. x \<le> inverse p i ==> x \<le> dimindex(:N)`
+    ASSUME_TAC THENL
+     [ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE];
+      ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH]] THEN
+    SIMP_TAC[ARITH_RULE `2 \<le> n ==> ~(n = 1)`] THEN
+    GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV)
+                [GSYM REAL_MUL_LID] THEN
+    ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
+    REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
+    REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
+    FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE
+     `1 \<le> p ==> p = 1 \/ 2 \<le> p`) o CONJUNCT1) THEN
+    ASM_SIMP_TAC[ARITH] THEN
+    FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN
+    REWRITE_TAC[REAL_ADD_RID] THEN TRY REAL_ARITH_TAC THEN
+    ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE];
+
+    X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN
+    ASM_REWRITE_TAC[REAL_SUB_LE] THEN
+    FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN
+    ASM_SIMP_TAC[SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC;
+
+    SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH;
+             ARITH_RULE `2 \<le> n ==> ~(n = 1)`] THEN
+    GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o BINDER_CONV)
+                [GSYM REAL_MUL_LID] THEN
+    ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN
+    REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN
+    REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN
+    COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ADD_RID] THEN
+    ASM_REWRITE_TAC[REAL_ARITH `x + y - x:real = y`] THEN
+    ASM_MESON_TAC[DIMINDEX_GE_1;
+                  ARITH_RULE `1 \<le> n \<and> ~(2 \<le> n) ==> n = 1`]]);; *)
+
+lemma HAS_GMEASURE_IMAGE_STD_SIMPLEX: True .. (*
+ "!p. p permutes 1..dimindex(:N)
+       ==> {x:real^N | 0 \<le> x$(p 1) \<and> x$(p(dimindex(:N))) \<le> 1 \<and>
+                       (!i. 1 \<le> i \<and> i < dimindex(:N)
+                            ==> x$(p i) \<le> x$(p(i + 1)))}
+           has_gmeasure
+           (measure (convex hull
+             (0 INSERT {basis i:real^N | 1 \<le> i \<and> i \<le> dimindex(:N)})))"
+qed   REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONGRUENT_IMAGE_STD_SIMPLEX] THEN
+  ASM_SIMP_TAC[GSYM STD_SIMPLEX] THEN
+  MATCH_MP_TAC HAS_GMEASURE_LINEAR_IMAGE_SAME THEN
+  REPEAT CONJ_TAC THENL
+   [REWRITE_TAC[linear; CART_EQ] THEN
+    ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT;
+                 GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL] THEN
+    REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN
+    REPEAT STRIP_TAC THEN REWRITE_TAC[] THENL
+     [MATCH_MP_TAC VECTOR_ADD_COMPONENT;
+      MATCH_MP_TAC VECTOR_MUL_COMPONENT] THEN
+    ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE];
+    MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
+    MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
+    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
+    MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
+    REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
+    MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC
+     `abs(det
+       ((lambda i. ((lambda i j. if j \<le> i then 1 else 0):real^N^N)
+                   $inverse p i)
+        :real^N^N))` THEN
+    CONJ_TAC THENL
+     [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN
+      ASM_SIMP_TAC[matrix; LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT;
+                   LAMBDA_BETA_PERM; PERMUTES_INVERSE] THEN
+      X_GEN_TAC `i:num` THEN STRIP_TAC THEN
+      X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN
+      EXISTS_TAC `sum (1..inverse (p:num->num) i)
+                      (\<lambda>k. if k = j then 1 else 0)` THEN
+      CONJ_TAC THENL
+       [MATCH_MP_TAC SUM_EQ THEN
+        ASM_SIMP_TAC[IN_NUMSEG; PERMUTES_IN_IMAGE; basis] THEN
+        REPEAT STRIP_TAC THEN MATCH_MP_TAC LAMBDA_BETA THEN
+        ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; LE_TRANS;
+                      PERMUTES_INVERSE];
+        ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]];
+      ALL_TAC] THEN
+    ASM_SIMP_TAC[PERMUTES_INVERSE; DET_PERMUTE_ROWS; ETA_AX] THEN
+    REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SIGN; REAL_MUL_LID] THEN
+    MATCH_MP_TAC(REAL_ARITH `x = 1 ==> abs x = 1`) THEN
+    ASM_SIMP_TAC[DET_LOWERTRIANGULAR; GSYM NOT_LT; LAMBDA_BETA] THEN
+    REWRITE_TAC[LT_REFL; PRODUCT_CONST_NUMSEG; REAL_POW_ONE]]);; *)
+
+lemma HAS_GMEASURE_STD_SIMPLEX: True .. (*
+ "(convex hull (0:real^N INSERT {basis i | 1 \<le> i \<and> i \<le> dimindex(:N)}))
+   has_gmeasure inv((FACT(dimindex(:N))))"
+qed   lemma lemma = prove
+   (`!f:num->real. (!i. 1 \<le> i \<and> i < n ==> f i \<le> f(i + 1)) \<longleftrightarrow>
+                   (!i j. 1 \<le> i \<and> i \<le> j \<and> j \<le> n ==> f i \<le> f j)"
+qed     GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
+     [GEN_TAC THEN INDUCT_TAC THEN
+      SIMP_TAC[LE; REAL_LE_REFL] THEN
+      STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN
+      MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) j` THEN
+      ASM_SIMP_TAC[ARITH_RULE `SUC x \<le> y ==> x \<le> y`] THEN
+      REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC;
+      REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]) in
+  MP_TAC(ISPECL
+   [`\p. {x:real^N | 0 \<le> x$(p 1) \<and> x$(p(dimindex(:N))) \<le> 1 \<and>
+                     (!i. 1 \<le> i \<and> i < dimindex(:N)
+                          ==> x$(p i) \<le> x$(p(i + 1)))}`;
+    `{p | p permutes 1..dimindex(:N)}`]
+    HAS_GMEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN
+  ASM_SIMP_TAC[REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
+                            HAS_GMEASURE_IMAGE_STD_SIMPLEX; IN_ELIM_THM] THEN
+  ASM_SIMP_TAC[SUM_CONST; FINITE_PERMUTATIONS; FINITE_NUMSEG;
+               CARD_PERMUTATIONS; CARD_NUMSEG_1] THEN
+  ANTS_TAC THENL
+   [MAP_EVERY X_GEN_TAC [`p:num->num`; `q:num->num`] THEN STRIP_TAC THEN
+    SUBGOAL_THEN `?i. i \<in> 1..dimindex(:N) \<and> ~(p i:num = q i)` MP_TAC THENL
+     [ASM_MESON_TAC[permutes; FUN_EQ_THM]; ALL_TAC] THEN
+    GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN
+    REWRITE_TAC[TAUT `a ==> ~(b \<and> ~c) \<longleftrightarrow> a \<and> b ==> c`] THEN
+    REWRITE_TAC[IN_NUMSEG] THEN
+    DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN
+    MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN
+    EXISTS_TAC `{x:real^N | (basis(p(k:num)) - basis(q k)) dot x = 0}` THEN
+    CONJ_TAC THENL
+     [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN
+      MATCH_MP_TAC BASIS_NE THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG];
+      ALL_TAC] THEN
+    REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM; DOT_LSUB; VECTOR_SUB_EQ] THEN
+    ASM_SIMP_TAC[DOT_BASIS; GSYM IN_NUMSEG; PERMUTES_IN_IMAGE] THEN
+    SUBGOAL_THEN `?l. (q:num->num) l = p(k:num)` STRIP_ASSUME_TAC THENL
+     [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
+    SUBGOAL_THEN `1 \<le> l \<and> l \<le> dimindex(:N)` STRIP_ASSUME_TAC THENL
+     [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
+    SUBGOAL_THEN `k:num < l` ASSUME_TAC THENL
+     [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
+      ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
+      ALL_TAC] THEN
+    SUBGOAL_THEN `?m. (p:num->num) m = q(k:num)` STRIP_ASSUME_TAC THENL
+     [ASM_MESON_TAC[permutes]; ALL_TAC] THEN
+    SUBGOAL_THEN `1 \<le> m \<and> m \<le> dimindex(:N)` STRIP_ASSUME_TAC THENL
+     [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN
+    SUBGOAL_THEN `k:num < m` ASSUME_TAC THENL
+     [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN
+      ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG];
+      ALL_TAC] THEN
+    X_GEN_TAC `x:real^N` THEN REWRITE_TAC[lemma] THEN STRIP_TAC THEN
+    FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN
+    FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN
+    ASM_SIMP_TAC[LT_IMP_LE; IMP_IMP; REAL_LE_ANTISYM; REAL_SUB_0] THEN
+    MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN
+    ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; DOT_BASIS];
+    ALL_TAC] THEN
+  REWRITE_TAC[HAS_GMEASURE_MEASURABLE_MEASURE] THEN
+  DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN CONJ_TAC THENL
+   [MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
+    MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
+    ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
+    MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
+    REWRITE_TAC[GSYM numseg; FINITE_NUMSEG];
+    ALL_TAC] THEN
+  ASM_SIMP_TAC[REAL_FIELD `~(y = 0) ==> (x = inv y \<longleftrightarrow> y * x = 1)`;
+               REAL_OF_NUM_EQ; FACT_NZ] THEN
+  FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_TRANS THEN
+  EXISTS_TAC `measure(interval[0:real^N,1])` THEN CONJ_TAC THENL
+   [AP_TERM_TAC; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_UNIT]] THEN
+  REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL
+   [REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ;
+                RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN
+    SIMP_TAC[IMP_IMP; IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN
+    X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN
+    STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN
+    MATCH_MP_TAC REAL_LE_TRANS THENL
+     [EXISTS_TAC `(x:real^N)$(p 1)`;
+      EXISTS_TAC `(x:real^N)$(p(dimindex(:N)))`] THEN
+    ASM_REWRITE_TAC[] THEN
+    FIRST_ASSUM(MP_TAC o SPEC `i:num` o MATCH_MP PERMUTES_SURJECTIVE) THEN
+    ASM_MESON_TAC[LE_REFL; PERMUTES_IN_IMAGE; IN_NUMSEG];
+    ALL_TAC] THEN
+  REWRITE_TAC[SET_RULE `s \<subseteq> UNIONS(IMAGE f t) \<longleftrightarrow>
+                        !x. x \<in> s ==> ?y. y \<in> t \<and> x \<in> f y`] THEN
+  X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; IN_ELIM_THM] THEN
+  SIMP_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN
+  MP_TAC(ISPEC `\i j. ~((x:real^N)$j \<le> x$i)` TOPOLOGICAL_SORT) THEN
+  REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN
+  ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN
+  DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)`; `1..dimindex(:N)`]) THEN
+  REWRITE_TAC[HAS_SIZE_NUMSEG_1; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN
+  DISCH_THEN(X_CHOOSE_THEN `f:num->num` (CONJUNCTS_THEN2
+   (ASSUME_TAC o GSYM) ASSUME_TAC)) THEN
+  EXISTS_TAC `\i. if i \<in> 1..dimindex(:N) then f(i) else i` THEN
+  REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE
+    `1 \<le> i \<and> i \<le> j \<and> j \<le> n \<longleftrightarrow>
+     1 \<le> i \<and> 1 \<le> j \<and> i \<le> n \<and> j \<le> n \<and> i \<le> j`] THEN
+  ASM_SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN
+  CONJ_TAC THENL
+   [ALL_TAC;
+    ASM_MESON_TAC[LE_REFL; DIMINDEX_GE_1; LE_LT; REAL_LE_LT]] THEN
+  SIMP_TAC[PERMUTES_FINITE_SURJECTIVE; FINITE_NUMSEG] THEN
+  SIMP_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Hence the gmeasure of a general simplex.                                   *)
+(* ------------------------------------------------------------------------- *)
+
+lemma HAS_GMEASURE_SIMPLEX_0: True .. (*
+ "!l:(real^N)list.
+        LENGTH l = dimindex(:N)
+        ==> (convex hull (0 INSERT set_of_list l)) has_gmeasure
+            abs(det(vector l)) / (FACT(dimindex(:N)))"
+qed   REPEAT STRIP_TAC THEN
+  SUBGOAL_THEN
+   `0 INSERT (set_of_list l) =
+        IMAGE (\<lambda>x:real^N. transp(vector l:real^N^N) ** x)
+              (0 INSERT {basis i:real^N | 1 \<le> i \<and> i \<le> dimindex(:N)})`
+  SUBST1_TAC THENL
+   [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
+    REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF] THEN
+    REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO] THEN AP_TERM_TAC THEN
+    SIMP_TAC[matrix_vector_mul; vector; transp; LAMBDA_BETA; basis] THEN
+    ONCE_REWRITE_TAC[COND_RAND] THEN
+    SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN
+    REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN
+    ONCE_REWRITE_TAC[TAUT `a \<and> b \<and> c \<longleftrightarrow> ~(b \<and> c ==> ~a)`] THEN
+    X_GEN_TAC `y:real^N` THEN SIMP_TAC[LAMBDA_BETA; REAL_MUL_RID] THEN
+    SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN
+    REWRITE_TAC[NOT_IMP; REAL_MUL_RID; GSYM CART_EQ] THEN
+    ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL] THEN
+    EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THENL
+     [EXISTS_TAC `SUC i`; EXISTS_TAC `i - 1`] THEN
+    ASM_REWRITE_TAC[SUC_SUB1] THEN ASM_ARITH_TAC;
+    ALL_TAC] THEN
+  ASM_SIMP_TAC[GSYM CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN
+  SUBGOAL_THEN
+   `det(vector l:real^N^N) = det(matrix(\<lambda>x:real^N. transp(vector l) ** x))`
+  SUBST1_TAC THENL
+   [REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; DET_TRANSP]; ALL_TAC] THEN
+  REWRITE_TAC[real_div] THEN
+  ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
+                 HAS_GMEASURE_STD_SIMPLEX)] THEN
+  MATCH_MP_TAC HAS_GMEASURE_LINEAR_IMAGE THEN
+  REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN
+  MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
+  MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN
+  ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN
+  MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN
+  REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]);; *)
+
+lemma HAS_GMEASURE_SIMPLEX: True .. (*
+ "!a l:(real^N)list.
+        LENGTH l = dimindex(:N)
+        ==> (convex hull (set_of_list(CONS a l))) has_gmeasure
+            abs(det(vector(MAP (\<lambda>x. x - a) l))) / (FACT(dimindex(:N)))"
+qed   REPEAT STRIP_TAC THEN
+  MP_TAC(ISPEC `MAP (\<lambda>x:real^N. x - a) l` HAS_GMEASURE_SIMPLEX_0) THEN
+  ASM_REWRITE_TAC[LENGTH_MAP; set_of_list] THEN
+  DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP HAS_GMEASURE_TRANSLATION) THEN
+  REWRITE_TAC[GSYM CONVEX_HULL_TRANSLATION] THEN
+  MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN
+  REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; SET_OF_LIST_MAP] THEN
+  REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `a + x - a:real^N = x`;
+              SET_RULE `IMAGE (\<lambda>x. x) s = s`]);; *)
+
+lemma GMEASURABLE_SIMPLEX: True .. (*
+ "!l. gmeasurable(convex hull (set_of_list l))"
+qed   GEN_TAC THEN
+  MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
+  MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN
+  MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_SET_OF_LIST]);; *)
+
+lemma MEASURE_SIMPLEX: True .. (*
+ "!a l:(real^N)list.
+        LENGTH l = dimindex(:N)
+        ==> measure(convex hull (set_of_list(CONS a l))) =
+            abs(det(vector(MAP (\<lambda>x. x - a) l))) / (FACT(dimindex(:N)))"
+qed   MESON_TAC[HAS_GMEASURE_SIMPLEX; HAS_GMEASURE_MEASURABLE_MEASURE]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Area of a triangle.                                                       *)
+(* ------------------------------------------------------------------------- *)
+
+lemma HAS_GMEASURE_TRIANGLE: True .. (*
+ "!a b c:real^2.
+        convex hull {a,b,c} has_gmeasure
+        abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / 2"
+qed   REPEAT STRIP_TAC THEN
+  MP_TAC(ISPECL [`a:real^2`; `[b;c]:(real^2)list`] HAS_GMEASURE_SIMPLEX) THEN
+  REWRITE_TAC[LENGTH; DIMINDEX_2; ARITH; set_of_list; MAP] THEN
+  CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_2; VECTOR_2] THEN
+  SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH]);; *)
+
+lemma GMEASURABLE_TRIANGLE: True .. (*
+ "!a b c:real^N. gmeasurable(convex hull {a,b,c})"
+qed   REPEAT GEN_TAC THEN
+  MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
+  MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
+  REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; *)
+
+lemma MEASURE_TRIANGLE: True .. (*
+ "!a b c:real^2.
+        measure(convex hull {a,b,c}) =
+        abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / 2"
+qed   REWRITE_TAC[REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
+               HAS_GMEASURE_TRIANGLE]);; *)
+
+(* ------------------------------------------------------------------------- *)
+(* Volume of a tetrahedron.                                                  *)
+(* ------------------------------------------------------------------------- *)
+
+lemma HAS_GMEASURE_TETRAHEDRON: True .. (*
+ "!a b c d:real^3.
+        convex hull {a,b,c,d} has_gmeasure
+        abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
+            (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
+            (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
+            (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
+            (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
+            (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) /
+           6"
+qed   REPEAT STRIP_TAC THEN
+  MP_TAC(ISPECL [`a:real^3`; `[b;c;d]:(real^3)list`] HAS_GMEASURE_SIMPLEX) THEN
+  REWRITE_TAC[LENGTH; DIMINDEX_3; ARITH; set_of_list; MAP] THEN
+  CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_3; VECTOR_3] THEN
+  SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH]);; *)
+
+lemma GMEASURABLE_TETRAHEDRON: True .. (*
+ "!a b c d:real^N. gmeasurable(convex hull {a,b,c,d})"
+qed   REPEAT GEN_TAC THEN
+  MATCH_MP_TAC GMEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN
+  MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN
+  REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; *)
+
+lemma MEASURE_TETRAHEDRON: True .. (*
+ "!a b c d:real^3.
+        measure(convex hull {a,b,c,d}) =
+        abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) +
+            (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) +
+            (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) -
+            (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) -
+            (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) -
+            (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / 6"
+qed   REWRITE_TAC[REWRITE_RULE[HAS_GMEASURE_MEASURABLE_MEASURE]
+               HAS_GMEASURE_TETRAHEDRON]);; *)
+
+end
--- a/src/HOL/Multivariate_Analysis/Integration.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Multivariate_Analysis/Integration.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -5287,10 +5287,10 @@
     qed finally show ?case . qed qed
 
 lemma nonnegative_absolutely_integrable: fixes f::"'n::ordered_euclidean_space \<Rightarrow> 'm::ordered_euclidean_space"
-  assumes "\<forall>x\<in>s. \<forall>i. 0 \<le> f(x)$$i" "f integrable_on s"
+  assumes "\<forall>x\<in>s. \<forall>i<DIM('m). 0 \<le> f(x)$$i" "f integrable_on s"
   shows "f absolutely_integrable_on s"
   unfolding absolutely_integrable_abs_eq apply rule defer
-  apply(rule integrable_eq[of _ f]) using assms by auto
+  apply(rule integrable_eq[of _ f]) using assms apply-apply(subst euclidean_eq) by auto
 
 lemma absolutely_integrable_integrable_bound: fixes f::"'n::ordered_euclidean_space \<Rightarrow> 'm::ordered_euclidean_space"
   assumes "\<forall>x\<in>s. norm(f x) \<le> g x" "f integrable_on s" "g integrable_on s"
--- a/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Multivariate_Analysis/Multivariate_Analysis.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -1,5 +1,5 @@
 theory Multivariate_Analysis
-imports Integration Fashoda
+imports Fashoda Gauge_Measure
 begin
 
 end
--- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -5105,6 +5105,60 @@
   shows "open {x::'a::euclidean_space. x$$i  > a}"
   using open_halfspace_gt[of a "(basis i)::'a"] unfolding euclidean_component_def .
 
+text{* Instantiation for intervals on @{text ordered_euclidean_space} *}
+
+lemma eucl_lessThan_eq_halfspaces:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "{..<a} = (\<Inter>i<DIM('a). {x. x $$ i < a $$ i})"
+ by (auto simp: eucl_less[where 'a='a])
+
+lemma eucl_greaterThan_eq_halfspaces:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "{a<..} = (\<Inter>i<DIM('a). {x. a $$ i < x $$ i})"
+ by (auto simp: eucl_less[where 'a='a])
+
+lemma eucl_atMost_eq_halfspaces:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "{.. a} = (\<Inter>i<DIM('a). {x. x $$ i \<le> a $$ i})"
+ by (auto simp: eucl_le[where 'a='a])
+
+lemma eucl_atLeast_eq_halfspaces:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "{a ..} = (\<Inter>i<DIM('a). {x. a $$ i \<le> x $$ i})"
+ by (auto simp: eucl_le[where 'a='a])
+
+lemma open_eucl_lessThan[simp, intro]:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "open {..< a}"
+  by (auto simp: eucl_lessThan_eq_halfspaces open_halfspace_component_lt)
+
+lemma open_eucl_greaterThan[simp, intro]:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "open {a <..}"
+  by (auto simp: eucl_greaterThan_eq_halfspaces open_halfspace_component_gt)
+
+lemma closed_eucl_atMost[simp, intro]:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "closed {.. a}"
+  unfolding eucl_atMost_eq_halfspaces
+proof (safe intro!: closed_INT)
+  fix i :: nat
+  have "- {x::'a. x $$ i \<le> a $$ i} = {x. a $$ i < x $$ i}" by auto
+  then show "closed {x::'a. x $$ i \<le> a $$ i}"
+    by (simp add: closed_def open_halfspace_component_gt)
+qed
+
+lemma closed_eucl_atLeast[simp, intro]:
+  fixes a :: "'a\<Colon>ordered_euclidean_space"
+  shows "closed {a ..}"
+  unfolding eucl_atLeast_eq_halfspaces
+proof (safe intro!: closed_INT)
+  fix i :: nat
+  have "- {x::'a. a $$ i \<le> x $$ i} = {x. x $$ i < a $$ i}" by auto
+  then show "closed {x::'a. a $$ i \<le> x $$ i}"
+    by (simp add: closed_def open_halfspace_component_lt)
+qed
+
 text{* This gives a simple derivation of limit component bounds.                 *}
 
 lemma Lim_component_le: fixes f :: "'a \<Rightarrow> 'b::euclidean_space"
--- a/src/HOL/Probability/Borel.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Probability/Borel.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -1,242 +1,199 @@
-header {*Borel Sets*}
+(* Author: Armin Heller, Johannes Hoelzl, TU Muenchen *)
+
+header {*Borel spaces*}
 
 theory Borel
-  imports Measure
+  imports Sigma_Algebra Positive_Infinite_Real Multivariate_Analysis
 begin
 
-text{*From the Hurd/Coble measure theory development, translated by Lawrence Paulson.*}
-
-definition borel_space where
-  "borel_space = sigma (UNIV::real set) (range (\<lambda>a::real. {x. x \<le> a}))"
+section "Generic Borel spaces"
 
-definition borel_measurable where
-  "borel_measurable a = measurable a borel_space"
+definition "borel_space = sigma (UNIV::'a::topological_space set) open"
+abbreviation "borel_measurable M \<equiv> measurable M borel_space"
 
-definition indicator_fn where
-  "indicator_fn s = (\<lambda>x. if x \<in> s then 1 else (0::real))"
+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>
-    sigma_algebra M \<and>
-    (\<forall>s \<in> sets (sigma UNIV (range (\<lambda>a::real. {x. x \<le> a}))).
-      f -` s \<inter> space M \<in> sets M)"
-apply (auto simp add: borel_measurable_def measurable_def borel_space_def) 
-apply (metis PowD UNIV_I Un_commute sigma_algebra_sigma subset_Pow_Union subset_UNIV subset_Un_eq) 
-done
-
-lemma (in sigma_algebra) borel_measurable_const:
-   "(\<lambda>x. c) \<in> borel_measurable M"
-  by (auto simp add: in_borel_measurable prems)
-
-lemma (in sigma_algebra) borel_measurable_indicator:
-  assumes a: "a \<in> sets M"
-  shows "indicator_fn a \<in> borel_measurable M"
-apply (auto simp add: in_borel_measurable indicator_fn_def prems)
-apply (metis Diff_eq Int_commute a compl_sets) 
-done
+    (\<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 Collect_eq: "{w \<in> X. f w \<le> a} = {w. f w \<le> a} \<inter> X"
-  by (metis Collect_conj_eq Collect_mem_eq Int_commute)
+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 (in measure_space) borel_measurable_le_iff:
-   "f \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w \<le> a} \<in> sets M)"
-proof 
-  assume f: "f \<in> borel_measurable M"
-  { fix a
-    have "{w \<in> space M. f w \<le> a} \<in> sets M" using f
-      apply (auto simp add: in_borel_measurable sigma_def Collect_eq)
-      apply (drule_tac x="{x. x \<le> a}" in bspec, auto)
-      apply (metis equalityE rangeI subsetD sigma_sets.Basic)  
-      done
-    }
-  thus "\<forall>a. {w \<in> space M. f w \<le> a} \<in> sets M" by blast
-next
-  assume "\<forall>a. {w \<in> space M. f w \<le> a} \<in> sets M"
-  thus "f \<in> borel_measurable M" 
-    apply (simp add: borel_measurable_def borel_space_def Collect_eq) 
-    apply (rule measurable_sigma, auto) 
-    done
+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 Collect_less_le:
-     "{w \<in> X. f w < g w} = (\<Union>n. {w \<in> X. f w \<le> g w - inverse(real(Suc n))})"
-  proof auto
-    fix w
-    assume w: "f w < g w"
-    hence nz: "g w - f w \<noteq> 0"
-      by arith
-    with w have "real(Suc(natceiling(inverse(g w - f w)))) > inverse(g w - f w)"
-      by (metis lessI order_le_less_trans real_natceiling_ge real_of_nat_less_iff)       hence "inverse(real(Suc(natceiling(inverse(g w - f w)))))
-             < inverse(inverse(g w - f w))" 
-      by (metis less_iff_diff_less_0 less_imp_inverse_less linorder_neqE_linordered_idom nz positive_imp_inverse_positive order_antisym less_le w)
-    hence "inverse(real(Suc(natceiling(inverse(g w - f w))))) < g w - f w"
-      by (metis inverse_inverse_eq order_less_le_trans order_refl)
-    thus "\<exists>n. f w \<le> g w - inverse(real(Suc n))" using w
-      by (rule_tac x="natceiling(inverse(g w - f w))" in exI, auto)
-  next
-    fix w n
-    assume le: "f w \<le> g w - inverse(real(Suc n))"
-    hence "0 < inverse(real(Suc n))"
-      by simp
-    thus "f w < g w" using le
-      by arith 
-  qed
-
-
-lemma (in sigma_algebra) sigma_le_less:
-  assumes M: "!!a::real. {w \<in> space M. f w \<le> a} \<in> sets M"
-  shows "{w \<in> space M. f w < a} \<in> sets M"
+lemma borel_space_closed[simp]:
+  assumes "closed A" shows "A \<in> sets borel_space"
 proof -
-  show ?thesis using Collect_less_le [of "space M" f "\<lambda>x. a"]
-    by (auto simp add: countable_UN M) 
+  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) sigma_less_ge:
-  assumes M: "!!a::real. {w \<in> space M. f w < a} \<in> sets M"
-  shows "{w \<in> space M. a \<le> f w} \<in> sets M"
-proof -
-  have "{w \<in> space M. a \<le> f w} = space M - {w \<in> space M. f w < a}"
-    by auto
-  thus ?thesis using M
-    by auto
-qed
-
-lemma (in sigma_algebra) sigma_ge_gr:
-  assumes M: "!!a::real. {w \<in> space M. a \<le> f w} \<in> sets M"
-  shows "{w \<in> space M. a < f w} \<in> sets M"
-proof -
-  show ?thesis using Collect_less_le [of "space M" "\<lambda>x. a" f]
-    by (auto simp add: countable_UN le_diff_eq M) 
+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) sigma_gr_le:
-  assumes M: "!!a::real. {w \<in> space M. a < f w} \<in> sets M"
-  shows "{w \<in> space M. f w \<le> a} \<in> sets M"
-proof -
-  have "{w \<in> space M. f w \<le> a} = space M - {w \<in> space M. a < f w}" 
-    by auto
-  thus ?thesis
-    by (simp add: M compl_sets)
-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 (in measure_space) borel_measurable_gr_iff:
-   "f \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a < f w} \<in> sets M)"
-proof (auto simp add: borel_measurable_le_iff sigma_gr_le) 
-  fix u
-  assume M: "\<forall>a. {w \<in> space M. f w \<le> a} \<in> sets M"
-  have "{w \<in> space M. u < f w} = space M - {w \<in> space M. f w \<le> u}"
-    by auto
-  thus "{w \<in> space M. u < f w} \<in> sets M"
-    by (force simp add: compl_sets countable_UN M)
-qed
+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 measure_space) borel_measurable_less_iff:
-   "f \<in> borel_measurable M = (\<forall>a. {w \<in> space M. f w < a} \<in> sets M)"
-proof (auto simp add: borel_measurable_le_iff sigma_le_less) 
-  fix u
-  assume M: "\<forall>a. {w \<in> space M. f w < a} \<in> sets M"
-  have "{w \<in> space M. f w \<le> u} = space M - {w \<in> space M. u < f w}"
-    by auto
-  thus "{w \<in> space M. f w \<le> u} \<in> sets M"
-    using Collect_less_le [of "space M" "\<lambda>x. u" f] 
-    by (force simp add: compl_sets countable_UN le_diff_eq sigma_less_ge M)
-qed
+lemma (in sigma_algebra) borel_measurable_indicator:
+  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 measure_space) borel_measurable_ge_iff:
-   "f \<in> borel_measurable M = (\<forall>a. {w \<in> space M. a \<le> f w} \<in> sets M)"
-proof (auto simp add: borel_measurable_less_iff sigma_le_less sigma_ge_gr sigma_gr_le) 
-  fix u
-  assume M: "\<forall>a. {w \<in> space M. f w < a} \<in> sets M"
-  have "{w \<in> space M. u \<le> f w} = space M - {w \<in> space M. f w < u}"
-    by auto
-  thus "{w \<in> space M. u \<le> f w} \<in> sets M"
-    by (force simp add: compl_sets countable_UN M)
+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 measure_space) affine_borel_measurable:
-  assumes g: "g \<in> borel_measurable M"
-  shows "(\<lambda>x. a + (g x) * b) \<in> borel_measurable M"
-proof (cases rule: linorder_cases [of b 0])
-  case equal thus ?thesis
-    by (simp add: borel_measurable_const)
-next
-  case less
-    {
-      fix w c
-      have "a + g w * b \<le> c \<longleftrightarrow> g w * b \<le> c - a"
-        by auto
-      also have "... \<longleftrightarrow> (c-a)/b \<le> g w" using less
-        by (metis divide_le_eq less less_asym)
-      finally have "a + g w * b \<le> c \<longleftrightarrow> (c-a)/b \<le> g w" .
-    }
-    hence "\<And>w c. a + g w * b \<le> c \<longleftrightarrow> (c-a)/b \<le> g w" .
-    thus ?thesis using less g
-      by (simp add: borel_measurable_ge_iff [of g]) 
-         (simp add: borel_measurable_le_iff)
-next
-  case greater
-    hence 0: "\<And>x c. (g x * b \<le> c - a) \<longleftrightarrow> (g x \<le> (c - a) / b)"
-      by (metis mult_imp_le_div_pos le_divide_eq) 
-    have 1: "\<And>x c. (a + g x * b \<le> c) \<longleftrightarrow> (g x * b \<le> c - a)"
-      by auto
-    from greater g
-    show ?thesis
-      by (simp add: borel_measurable_le_iff 0 1) 
-qed
+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)
 
-definition
-  nat_to_rat_surj :: "nat \<Rightarrow> rat" where
- "nat_to_rat_surj n = (let (i,j) = prod_decode n
-                       in Fract (int_decode i) (int_decode j))"
+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 nat_to_rat_surj: "surj nat_to_rat_surj"
-proof (auto simp add: surj_def nat_to_rat_surj_def) 
-  fix y
-  show "\<exists>x. y = (\<lambda>(i, j). Fract (int_decode i) (int_decode j)) (prod_decode x)"
-  proof (cases y)
-    case (Fract a b)
-      obtain i where i: "int_decode i = a" using surj_int_decode
-        by (metis surj_def) 
-      obtain j where j: "int_decode j = b" using surj_int_decode
-        by (metis surj_def)
-      obtain n where n: "prod_decode n = (i,j)" using surj_prod_decode
-        by (metis surj_def)
+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)
 
-      from Fract i j n show ?thesis
-        by (metis prod.cases)
-  qed
-qed
+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 rats_enumeration: "\<rat> = range (of_rat o nat_to_rat_surj)" 
-  using nat_to_rat_surj
-  by (auto simp add: image_def surj_def) (metis Rats_cases) 
+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 measure_space) borel_measurable_less_borel_measurable:
+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\<in>\<rat>. {w \<in> space M. f w < r} \<inter> {w \<in> space M. r < g w })"
-    by (auto simp add: Rats_dense_in_real)
-  thus ?thesis using f g 
-    by (simp add: borel_measurable_less_iff [of f]  
-                  borel_measurable_gr_iff [of g]) 
-       (blast intro: gen_countable_UN [OF rats_enumeration])
+        (\<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 measure_space) borel_measurable_leq_borel_measurable:
+
+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 add: borel_measurable_less_borel_measurable compl_sets)
+  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 measure_space) borel_measurable_eq_borel_measurable:
+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"
@@ -244,40 +201,512 @@
   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 (simp add: borel_measurable_leq_borel_measurable Int) 
+  thus ?thesis using f g by auto
 qed
 
-lemma (in measure_space) borel_measurable_neq_borel_measurable:
+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 (simp add: borel_measurable_eq_borel_measurable compl_sets) 
+  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 measure_space) borel_measurable_add_borel_measurable:
+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
+
+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:"!!a. {w \<in> space M. a \<le> f w + g w} = {w \<in> space M. a + (g w) * -1 \<le> f w}"
+  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 "!!a. (\<lambda>w. a + (g w) * -1) \<in> borel_measurable M"
-    by (rule affine_borel_measurable [OF g]) 
-  hence "!!a. {w \<in> space M. (\<lambda>w. a + (g w) * -1)(w) \<le> f w} \<in> sets M" using f
-    by (rule borel_measurable_leq_borel_measurable) 
-  hence "!!a. {w \<in> space M. a \<le> f w + g w} \<in> sets M"
-    by (simp add: 1) 
-  thus ?thesis
-    by (simp add: borel_measurable_ge_iff) 
+  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 measure_space) borel_measurable_square:
+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 -
@@ -286,21 +715,21 @@
     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} = {}" 
+      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) 
+        by (rule empty_sets)
       finally show ?thesis .
     next
       case equal
-      hence "{w \<in> space M. (f w)\<twosuperior> \<le> a} = 
+      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_le_iff)
-        apply (simp add: borel_measurable_ge_iff)
+        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
@@ -309,329 +738,536 @@
         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}" 
+             {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_ge_iff)
-        apply (simp add: borel_measurable_le_iff)
+        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_le_iff) 
+  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]) 
+by (simp add: power2_eq_square ring_distribs diff_divide_distrib [symmetric])
 
-
-lemma (in measure_space) borel_measurable_uminus_borel_measurable:
+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) 
+  also have "... \<in> borel_measurable M"
+    by (fast intro: affine_borel_measurable g)
   finally show ?thesis .
 qed
 
-lemma (in measure_space) borel_measurable_times_borel_measurable:
+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"
-    by (fast intro: affine_borel_measurable borel_measurable_square 
-                    borel_measurable_add_borel_measurable f g) 
-  have "(\<lambda>x. -((f x + -g x) ^ 2 * inverse 4)) = 
+    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" 
-    by (fast intro: affine_borel_measurable borel_measurable_square 
-                    borel_measurable_add_borel_measurable 
-                    borel_measurable_uminus_borel_measurable f g)
+  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 apply (simp add: borel_measurable_add_borel_measurable) 
-    done
+    apply (simp add: times_eq_sum_squares diff_minus)
+    using 1 2 by simp
 qed
 
-lemma (in measure_space) borel_measurable_diff_borel_measurable:
+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
-  by (fast intro: borel_measurable_add_borel_measurable 
-                  borel_measurable_uminus_borel_measurable f g)
+  unfolding diff_minus using assms by fast
 
-lemma (in measure_space) borel_measurable_setsum_borel_measurable:
-  assumes s: "finite s"
-  shows "(!!i. i \<in> s ==> f i \<in> borel_measurable M) \<Longrightarrow> (\<lambda>x. setsum (\<lambda>i. f i x) s) \<in> borel_measurable M" using s
-proof (induct s)
-  case empty
-  thus ?case
-    by (simp add: borel_measurable_const)
-next
-  case (insert x s)
-  thus ?case
-    by (auto simp add: borel_measurable_add_borel_measurable) 
-qed
+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 measure_space) borel_measurable_cong:
-  assumes "\<And> w. w \<in> space M \<Longrightarrow> f w = g w"
-  shows "f \<in> borel_measurable M \<longleftrightarrow> g \<in> borel_measurable M"
-using assms unfolding in_borel_measurable by (simp cong: vimage_inter_cong)
-
-lemma (in measure_space) borel_measurable_inverse:
+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_ge_iff
-proof (safe, rule linorder_cases)
-  fix a :: real assume "0 < a"
-  { fix w
-    from `0 < a` have "a \<le> inverse (f w) \<longleftrightarrow> 0 < f w \<and> f w \<le> 1 / a"
-      by (metis inverse_eq_divide inverse_inverse_eq le_imp_inverse_le
-                less_le_trans zero_less_divide_1_iff) }
-  hence "{w \<in> space M. a \<le> inverse (f w)} =
-    {w \<in> space M. 0 < f w} \<inter> {w \<in> space M. f w \<le> 1 / a}" by auto
-  with Int assms[unfolded borel_measurable_gr_iff]
-    assms[unfolded borel_measurable_le_iff]
-  show "{w \<in> space M. a \<le> inverse (f w)} \<in> sets M" by simp
-next
-  fix a :: real assume "0 = a"
-  { fix w have "a \<le> inverse (f w) \<longleftrightarrow> 0 \<le> f w"
-      unfolding `0 = a`[symmetric] by auto }
-  thus "{w \<in> space M. a \<le> inverse (f w)} \<in> sets M"
-    using assms[unfolded borel_measurable_ge_iff] by simp
-next
-  fix a :: real assume "a < 0"
-  { fix w
-    from `a < 0` have "a \<le> inverse (f w) \<longleftrightarrow> f w \<le> 1 / a \<or> 0 \<le> f w"
-      apply (cases "0 \<le> f w")
-      apply (metis inverse_eq_divide linorder_not_le xt1(8) xt1(9)
-                   zero_le_divide_1_iff)
-      apply (metis inverse_eq_divide inverse_inverse_eq inverse_le_imp_le_neg
-                   linorder_not_le order_refl order_trans)
-      done }
-  hence "{w \<in> space M. a \<le> inverse (f w)} =
-    {w \<in> space M. f w \<le> 1 / a} \<union> {w \<in> space M. 0 \<le> f w}" by auto
-  with Un assms[unfolded borel_measurable_ge_iff]
-    assms[unfolded borel_measurable_le_iff]
-  show "{w \<in> space M. a \<le> inverse (f w)} \<in> sets M" by simp
+  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 measure_space) borel_measurable_divide:
+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_borel_measurable assms)+
+  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 (in measure_space) borel_measurable_vimage:
-  assumes borel: "f \<in> borel_measurable M"
-  shows "f -` {X} \<inter> space M \<in> sets M"
-proof -
-  have "{w \<in> space M. f w = X} = {w. f w = X} \<inter> space M" by auto
-  with borel_measurable_eq_borel_measurable[OF borel borel_measurable_const, of X]
-  show ?thesis unfolding vimage_def by simp
+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
 
-section "Monotone convergence"
-
-definition mono_convergent where
-  "mono_convergent u f s \<equiv>
-        (\<forall>x\<in>s. incseq (\<lambda>n. u n x)) \<and>
-        (\<forall>x \<in> s. (\<lambda>i. u i x) ----> f x)"
-
-definition "upclose f g x = max (f x) (g x)"
+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
 
-primrec mon_upclose where
-"mon_upclose 0 u = u 0" |
-"mon_upclose (Suc n) u = upclose (u (Suc n)) (mon_upclose n u)"
-
-lemma mono_convergentD:
-  assumes "mono_convergent u f s" and "x \<in> s"
-  shows "incseq (\<lambda>n. u n x)" and "(\<lambda>i. u i x) ----> f x"
-  using assms unfolding mono_convergent_def by auto
+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 mono_convergentI:
-  assumes "\<And>x. x \<in> s \<Longrightarrow> incseq (\<lambda>n. u n x)"
-  assumes "\<And>x. x \<in> s \<Longrightarrow> (\<lambda>i. u i x) ----> f x"
-  shows "mono_convergent u f s"
-  using assms unfolding mono_convergent_def by 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: expand_fun_eq 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 measure_space) mono_convergent_borel_measurable:
-  assumes u: "!!n. u n \<in> borel_measurable M"
-  assumes mc: "mono_convergent u f (space M)"
-  shows "f \<in> borel_measurable M"
-proof -
-  {
-    fix a
-    have 1: "!!w. w \<in> space M & f w <= a \<longleftrightarrow> w \<in> space M & (\<forall>i. u i w <= a)"
+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 w i
-        assume w: "w \<in> space M" and f: "f w \<le> a"
-        hence "u i w \<le> f w"
-          by (auto intro: SEQ.incseq_le
-                   simp add: mc [unfolded mono_convergent_def])
-        thus "u i w \<le> a" using f
+        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 w 
-        assume w: "w \<in> space M" and u: "\<forall>i. u i w \<le> a"
-        thus "f w \<le> a"
-          by (metis LIMSEQ_le_const2 mc [unfolded mono_convergent_def])
+        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
-    have "{w \<in> space M. f w \<le> a} = {w \<in> space M. (\<forall>i. u i w <= a)}"
-      by (simp add: 1)
-    also have "... = (\<Inter>i. {w \<in> space M. u i w \<le> a})" 
-      by auto
-    also have "...  \<in> sets M" using u
-      by (auto simp add: borel_measurable_le_iff intro: countable_INT) 
-    finally have "{w \<in> space M. f w \<le> a} \<in> sets M" .
-  }
-  thus ?thesis 
-    by (auto simp add: borel_measurable_le_iff) 
-qed
-
-lemma mono_convergent_le:
-  assumes "mono_convergent u f s" and "t \<in> s"
-  shows "u n t \<le> f t"
-using mono_convergentD[OF assms] by (auto intro!: incseq_le)
-
-lemma mon_upclose_ex:
-  fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> ('b\<Colon>linorder)"
-  shows "\<exists>n \<le> m. mon_upclose m u x = u n x"
-proof (induct m)
-  case (Suc m)
-  then obtain n where "n \<le> m" and *: "mon_upclose m u x = u n x" by blast
-  thus ?case
-  proof (cases "u n x \<le> u (Suc m) x")
-    case True with min_max.sup_absorb1 show ?thesis
-      by (auto simp: * upclose_def intro!: exI[of _ "Suc m"])
-  next
-    case False
-     with min_max.sup_absorb2 `n \<le> m` show ?thesis
-       by (auto simp: * upclose_def intro!: exI[of _ n] min_max.sup_absorb2)
+      with a show ?thesis by auto
+    qed simp
   qed
-qed simp
-
-lemma mon_upclose_all:
-  fixes u :: "nat \<Rightarrow> 'a \<Rightarrow> ('b\<Colon>linorder)"
-  assumes "m \<le> n"
-  shows "u m x \<le> mon_upclose n u x"
-using assms proof (induct n)
-  case 0 thus ?case by auto
 next
-  case (Suc n)
-  show ?case
-  proof (cases "m = Suc n")
-    case True thus ?thesis by (simp add: upclose_def)
-  next
-    case False
-    hence "m \<le> n" using `m \<le> Suc n` by simp
-    from Suc.hyps[OF this]
-    show ?thesis by (auto simp: upclose_def intro!: min_max.le_supI2)
+  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 mono_convergent_limit:
-  fixes f :: "'a \<Rightarrow> real"
-  assumes "mono_convergent u f s" and "x \<in> s" and "0 < r"
-  shows "\<exists>N. \<forall>n\<ge>N. f x - u n x < r"
-proof -
-  from LIMSEQ_D[OF mono_convergentD(2)[OF assms(1,2)] `0 < r`]
-  obtain N where "\<And>n. N \<le> n \<Longrightarrow> \<bar> u n x - f x \<bar> < r" by auto
-  with mono_convergent_le[OF assms(1,2)] `0 < r`
-  show ?thesis by (auto intro!: exI[of _ N])
-qed
-
-lemma mon_upclose_le_mono_convergent:
-  assumes mc: "\<And>n. mono_convergent (\<lambda>m. u m n) (f n) s" and "x \<in> s"
-  and "incseq (\<lambda>n. f n x)"
-  shows "mon_upclose n (u n) x <= f n x"
-proof -
-  obtain m where *: "mon_upclose n (u n) x = u n m x" and "m \<le> n"
-    using mon_upclose_ex[of n "u n" x] by auto
-  note this(1)
-  also have "u n m x \<le> f m x" using mono_convergent_le[OF assms(1,2)] .
-  also have "... \<le> f n x" using assms(3) `m \<le> n` unfolding incseq_def by auto
-  finally show ?thesis .
-qed
-
-lemma mon_upclose_mono_convergent:
-  assumes mc_u: "\<And>n. mono_convergent (\<lambda>m. u m n) (f n) s"
-  and mc_f: "mono_convergent f h s"
-  shows "mono_convergent (\<lambda>n. mon_upclose n (u n)) h s"
-proof (rule mono_convergentI)
-  fix x assume "x \<in> s"
-  show "incseq (\<lambda>n. mon_upclose n (u n) x)" unfolding incseq_def
-  proof safe
-    fix m n :: nat assume "m \<le> n"
-    obtain i where mon: "mon_upclose m (u m) x = u m i x" and "i \<le> m"
-      using mon_upclose_ex[of m "u m" x] by auto
-    hence "i \<le> n" using `m \<le> n` by auto
+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 .
 
-    note mon
-    also have "u m i x \<le> u n i x"
-      using mono_convergentD(1)[OF mc_u `x \<in> s`] `m \<le> n`
-      unfolding incseq_def by auto
-    also have "u n i x \<le> mon_upclose n (u n) x"
-      using mon_upclose_all[OF `i \<le> n`, of "u n" x] .
-    finally show "mon_upclose m (u m) x \<le> mon_upclose n (u n) x" .
-  qed
-
-  show "(\<lambda>i. mon_upclose i (u i) x) ----> h x"
-  proof (rule LIMSEQ_I)
-    fix r :: real assume "0 < r"
-    hence "0 < r / 2" by auto
-    from mono_convergent_limit[OF mc_f `x \<in> s` this]
-    obtain N where f_h: "\<And>n. N \<le> n \<Longrightarrow> h x - f n x < r / 2" by auto
-
-    from mono_convergent_limit[OF mc_u `x \<in> s` `0 < r / 2`]
-    obtain N' where u_f: "\<And>n. N' \<le> n \<Longrightarrow> f N x - u n N x < r / 2" by auto
+  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
 
-    show "\<exists>N. \<forall>n\<ge>N. norm (mon_upclose n (u n) x - h x) < r"
-    proof (rule exI[of _ "max N N'"], safe)
-      fix n assume "max N N' \<le> n"
-      hence "N \<le> n" and "N' \<le> n" by auto
-      hence "u n N x \<le> mon_upclose n (u n) x"
-        using mon_upclose_all[of N n "u n" x] by auto
-      moreover
-      from add_strict_mono[OF u_f[OF `N' \<le> n`] f_h[OF order_refl]]
-      have "h x - u n N x < r" by auto
-      ultimately have "h x - mon_upclose n (u n) x < r" by auto
-      moreover
-      obtain i where "mon_upclose n (u n) x = u n i x"
-        using mon_upclose_ex[of n "u n"] by blast
-      with mono_convergent_le[OF mc_u `x \<in> s`, of n i]
-           mono_convergent_le[OF mc_f `x \<in> s`, of i]
-      have "mon_upclose n (u n) x \<le> h x" by auto
-      ultimately
-      show "norm (mon_upclose n (u n) x - h x) < r" by auto
-     qed
+    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 mono_conv_outgrow:
-  assumes "incseq x" "x ----> y" "z < y"
-  shows "\<exists>b. \<forall> a \<ge> b. z < x a"
-using assms
+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 -
-  from assms have "y - z > 0" by simp
-  hence A: "\<exists>n. (\<forall> m \<ge> n. \<bar> x m + - y \<bar> < y - z)" using assms
-    unfolding incseq_def LIMSEQ_def dist_real_def diff_minus
-    by simp
-  have "\<forall>m. x m \<le> y" using incseq_le assms by auto
-  hence B: "\<forall>m. \<bar> x m + - y \<bar> = y - x m"
-    by (metis abs_if abs_minus_add_cancel less_iff_diff_less_0 linorder_not_le diff_minus)
-  from A B show ?thesis by auto
+  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: expand_fun_eq 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: expand_fun_eq 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 'b=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
 
 end
--- a/src/HOL/Probability/Caratheodory.thy	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Probability/Caratheodory.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -1,43 +1,28 @@
 header {*Caratheodory Extension Theorem*}
 
 theory Caratheodory
-  imports Sigma_Algebra SeriesPlus
+  imports Sigma_Algebra Positive_Infinite_Real
 begin
 
 text{*From the Hurd/Coble measure theory development, translated by Lawrence Paulson.*}
 
 subsection {* Measure Spaces *}
 
-text {*A measure assigns a nonnegative real to every measurable set. 
-       It is countably additive for disjoint sets.*}
-
-record 'a measure_space = "'a algebra" +
-  measure:: "'a set \<Rightarrow> real"
-
-definition
-  disjoint_family_on  where
-  "disjoint_family_on A S \<longleftrightarrow> (\<forall>m\<in>S. \<forall>n\<in>S. m \<noteq> n \<longrightarrow> A m \<inter> A n = {})"
-
-abbreviation
-  "disjoint_family A \<equiv> disjoint_family_on A UNIV"
-
-definition
-  positive  where
-  "positive M f \<longleftrightarrow> f {} = (0::real) & (\<forall>x \<in> sets M. 0 \<le> f x)"
+definition "positive f \<longleftrightarrow> f {} = (0::pinfreal)" -- "Positive is enforced by the type"
 
 definition
   additive  where
-  "additive M f \<longleftrightarrow> 
-    (\<forall>x \<in> sets M. \<forall>y \<in> sets M. x \<inter> y = {} 
+  "additive M f \<longleftrightarrow>
+    (\<forall>x \<in> sets M. \<forall>y \<in> sets M. x \<inter> y = {}
     \<longrightarrow> f (x \<union> y) = f x + f y)"
 
 definition
   countably_additive  where
-  "countably_additive M f \<longleftrightarrow> 
-    (\<forall>A. range A \<subseteq> sets M \<longrightarrow> 
+  "countably_additive M f \<longleftrightarrow>
+    (\<forall>A. range A \<subseteq> sets M \<longrightarrow>
          disjoint_family A \<longrightarrow>
-         (\<Union>i. A i) \<in> sets M \<longrightarrow> 
-         (\<lambda>n. f (A n))  sums  f (\<Union>i. A i))"
+         (\<Union>i. A i) \<in> sets M \<longrightarrow>
+         (\<Sum>\<^isub>\<infinity> n. f (A n)) = f (\<Union>i. A i))"
 
 definition
   increasing  where
@@ -45,90 +30,58 @@
 
 definition
   subadditive  where
-  "subadditive M f \<longleftrightarrow> 
-    (\<forall>x \<in> sets M. \<forall>y \<in> sets M. x \<inter> y = {} 
+  "subadditive M f \<longleftrightarrow>
+    (\<forall>x \<in> sets M. \<forall>y \<in> sets M. x \<inter> y = {}
     \<longrightarrow> f (x \<union> y) \<le> f x + f y)"
 
 definition
   countably_subadditive  where
-  "countably_subadditive M f \<longleftrightarrow> 
-    (\<forall>A. range A \<subseteq> sets M \<longrightarrow> 
+  "countably_subadditive M f \<longleftrightarrow>
+    (\<forall>A. range A \<subseteq> sets M \<longrightarrow>
          disjoint_family A \<longrightarrow>
-         (\<Union>i. A i) \<in> sets M \<longrightarrow> 
-         summable (f o A) \<longrightarrow>
-         f (\<Union>i. A i) \<le> suminf (\<lambda>n. f (A n)))"
+         (\<Union>i. A i) \<in> sets M \<longrightarrow>
+         f (\<Union>i. A i) \<le> psuminf (\<lambda>n. f (A n)))"
 
 definition
   lambda_system where
-  "lambda_system M f = 
+  "lambda_system M f =
     {l. l \<in> sets M & (\<forall>x \<in> sets M. f (l \<inter> x) + f ((space M - l) \<inter> x) = f x)}"
 
 definition
   outer_measure_space where
-  "outer_measure_space M f  \<longleftrightarrow> 
-     positive M f & increasing M f & countably_subadditive M f"
+  "outer_measure_space M f  \<longleftrightarrow>
+     positive f \<and> increasing M f \<and> countably_subadditive M f"
 
 definition
   measure_set where
   "measure_set M f X =
-     {r . \<exists>A. range A \<subseteq> sets M & disjoint_family A & X \<subseteq> (\<Union>i. A i) & (f \<circ> A) sums r}"
-
+     {r . \<exists>A. range A \<subseteq> sets M \<and> disjoint_family A \<and> X \<subseteq> (\<Union>i. A i) \<and> (\<Sum>\<^isub>\<infinity> i. f (A i)) = r}"
 
 locale measure_space = sigma_algebra +
-  assumes positive: "!!a. a \<in> sets M \<Longrightarrow> 0 \<le> measure M a"
-      and empty_measure [simp]: "measure M {} = (0::real)"
-      and ca: "countably_additive M (measure M)"
-
-subsection {* Basic Lemmas *}
-
-lemma positive_imp_0: "positive M f \<Longrightarrow> f {} = 0"
-  by (simp add: positive_def) 
-
-lemma positive_imp_pos: "positive M f \<Longrightarrow> x \<in> sets M \<Longrightarrow> 0 \<le> f x"
-  by (simp add: positive_def) 
+  fixes \<mu> :: "'a set \<Rightarrow> pinfreal"
+  assumes empty_measure [simp]: "\<mu> {} = 0"
+      and ca: "countably_additive M \<mu>"
 
 lemma increasingD:
      "increasing M f \<Longrightarrow> x \<subseteq> y \<Longrightarrow> x\<in>sets M \<Longrightarrow> y\<in>sets M \<Longrightarrow> f x \<le> f y"
   by (auto simp add: increasing_def)
 
 lemma subadditiveD:
-     "subadditive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x\<in>sets M \<Longrightarrow> y\<in>sets M 
+     "subadditive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x\<in>sets M \<Longrightarrow> y\<in>sets M
       \<Longrightarrow> f (x \<union> y) \<le> f x + f y"
   by (auto simp add: subadditive_def)
 
 lemma additiveD:
-     "additive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x\<in>sets M \<Longrightarrow> y\<in>sets M 
+     "additive M f \<Longrightarrow> x \<inter> y = {} \<Longrightarrow> x\<in>sets M \<Longrightarrow> y\<in>sets M
       \<Longrightarrow> f (x \<union> y) = f x + f y"
   by (auto simp add: additive_def)
 
 lemma countably_additiveD:
   "countably_additive M f \<Longrightarrow> range A \<subseteq> sets M \<Longrightarrow> disjoint_family A
-   \<Longrightarrow> (\<Union>i. A i) \<in> sets M \<Longrightarrow> (\<lambda>n. f (A n))  sums  f (\<Union>i. A i)"
+   \<Longrightarrow> (\<Union>i. A i) \<in> sets M \<Longrightarrow> (\<Sum>\<^isub>\<infinity> n. f (A n)) = f (\<Union>i. A i)"
   by (simp add: countably_additive_def)
 
-lemma Int_Diff_disjoint: "A \<inter> B \<inter> (A - B) = {}"
-  by blast
-
-lemma Int_Diff_Un: "A \<inter> B \<union> (A - B) = A"
-  by blast
-
-lemma disjoint_family_subset:
-     "disjoint_family A \<Longrightarrow> (!!x. B x \<subseteq> A x) \<Longrightarrow> disjoint_family B"
-  by (force simp add: disjoint_family_on_def)
-
-subsection {* A Two-Element Series *}
-
-definition binaryset :: "'a set \<Rightarrow> 'a set \<Rightarrow> nat \<Rightarrow> 'a set "
-  where "binaryset A B = (\<lambda>\<^isup>x. {})(0 := A, Suc 0 := B)"
-
-lemma range_binaryset_eq: "range(binaryset A B) = {A,B,{}}"
-  apply (simp add: binaryset_def)
-  apply (rule set_ext)
-  apply (auto simp add: image_iff)
-  done
-
-lemma UN_binaryset_eq: "(\<Union>i. binaryset A B i) = A \<union> B"
-  by (simp add: UNION_eq_Union_image range_binaryset_eq)
+section "Extend binary sets"
 
 lemma LIMSEQ_binaryset:
   assumes f: "f {} = 0"
@@ -153,17 +106,31 @@
 lemma binaryset_sums:
   assumes f: "f {} = 0"
   shows  "(\<lambda>n. f (binaryset A B n)) sums (f A + f B)"
-    by (simp add: sums_def LIMSEQ_binaryset [where f=f, OF f]) 
+    by (simp add: sums_def LIMSEQ_binaryset [where f=f, OF f])
 
 lemma suminf_binaryset_eq:
      "f {} = 0 \<Longrightarrow> suminf (\<lambda>n. f (binaryset A B n)) = f A + f B"
   by (metis binaryset_sums sums_unique)
 
+lemma binaryset_psuminf:
+  assumes "f {} = 0"
+  shows "(\<Sum>\<^isub>\<infinity> n. f (binaryset A B n)) = f A + f B" (is "?suminf = ?sum")
+proof -
+  have *: "{..<2} = {0, 1::nat}" by auto
+  have "\<forall>n\<ge>2. f (binaryset A B n) = 0"
+    unfolding binaryset_def
+    using assms by auto
+  hence "?suminf = (\<Sum>N<2. f (binaryset A B N))"
+    by (rule psuminf_finite)
+  also have "... = ?sum" unfolding * binaryset_def
+    by simp
+  finally show ?thesis .
+qed
 
 subsection {* Lambda Systems *}
 
 lemma (in algebra) lambda_system_eq:
-    "lambda_system M f = 
+    "lambda_system M f =
         {l. l \<in> sets M & (\<forall>x \<in> sets M. f (x \<inter> l) + f (x - l) = f x)}"
 proof -
   have [simp]: "!!l x. l \<in> sets M \<Longrightarrow> x \<in> sets M \<Longrightarrow> (space M - l) \<inter> x = x - l"
@@ -173,28 +140,28 @@
 qed
 
 lemma (in algebra) lambda_system_empty:
-    "positive M f \<Longrightarrow> {} \<in> lambda_system M f"
-  by (auto simp add: positive_def lambda_system_eq) 
+  "positive f \<Longrightarrow> {} \<in> lambda_system M f"
+  by (auto simp add: positive_def lambda_system_eq)
 
 lemma lambda_system_sets:
     "x \<in> lambda_system M f \<Longrightarrow> x \<in> sets M"
   by (simp add:  lambda_system_def)
 
 lemma (in algebra) lambda_system_Compl:
-  fixes f:: "'a set \<Rightarrow> real"
+  fixes f:: "'a set \<Rightarrow> pinfreal"
   assumes x: "x \<in> lambda_system M f"
   shows "space M - x \<in> lambda_system M f"
   proof -
     have "x \<subseteq> space M"
       by (metis sets_into_space lambda_system_sets x)
     hence "space M - (space M - x) = x"
-      by (metis double_diff equalityE) 
+      by (metis double_diff equalityE)
     with x show ?thesis
-      by (force simp add: lambda_system_def)
+      by (force simp add: lambda_system_def ac_simps)
   qed
 
 lemma (in algebra) lambda_system_Int:
-  fixes f:: "'a set \<Rightarrow> real"
+  fixes f:: "'a set \<Rightarrow> pinfreal"
   assumes xl: "x \<in> lambda_system M f" and yl: "y \<in> lambda_system M f"
   shows "x \<inter> y \<in> lambda_system M f"
   proof -
@@ -213,42 +180,42 @@
         ultimately
         have ey: "f (u - x \<inter> y) = f (u \<inter> y - x) + f (u - y)" using fy
           by force
-        have "f (u \<inter> (x \<inter> y)) + f (u - x \<inter> y) 
+        have "f (u \<inter> (x \<inter> y)) + f (u - x \<inter> y)
               = (f (u \<inter> (x \<inter> y)) + f (u \<inter> y - x)) + f (u - y)"
-          by (simp add: ey) 
+          by (simp add: ey ac_simps)
         also have "... =  (f ((u \<inter> y) \<inter> x) + f (u \<inter> y - x)) + f (u - y)"
-          by (simp add: Int_ac) 
+          by (simp add: Int_ac)
         also have "... = f (u \<inter> y) + f (u - y)"
           using fx [THEN bspec, of "u \<inter> y"] Int y u
           by force
         also have "... = f u"
-          by (metis fy u) 
+          by (metis fy u)
         finally show "f (u \<inter> (x \<inter> y)) + f (u - x \<inter> y) = f u" .
       qed
   qed
 
 
 lemma (in algebra) lambda_system_Un:
-  fixes f:: "'a set \<Rightarrow> real"
+  fixes f:: "'a set \<Rightarrow> pinfreal"
   assumes xl: "x \<in> lambda_system M f" and yl: "y \<in> lambda_system M f"
   shows "x \<union> y \<in> lambda_system M f"
 proof -
   have "(space M - x) \<inter> (space M - y) \<in> sets M"
-    by (metis Diff_Un Un compl_sets lambda_system_sets xl yl) 
+    by (metis Diff_Un Un compl_sets lambda_system_sets xl yl)
   moreover
   have "x \<union> y = space M - ((space M - x) \<inter> (space M - y))"
     by auto  (metis subsetD lambda_system_sets sets_into_space xl yl)+
   ultimately show ?thesis
-    by (metis lambda_system_Compl lambda_system_Int xl yl) 
+    by (metis lambda_system_Compl lambda_system_Int xl yl)
 qed
 
 lemma (in algebra) lambda_system_algebra:
-    "positive M f \<Longrightarrow> algebra (M (|sets := lambda_system M f|))"
-  apply (auto simp add: algebra_def) 
+  "positive f \<Longrightarrow> algebra (M (|sets := lambda_system M f|))"
+  apply (auto simp add: algebra_def)
   apply (metis lambda_system_sets set_mp sets_into_space)
   apply (metis lambda_system_empty)
   apply (metis lambda_system_Compl)
-  apply (metis lambda_system_Un) 
+  apply (metis lambda_system_Un)
   done
 
 lemma (in algebra) lambda_system_strong_additive:
@@ -259,19 +226,13 @@
     have "z \<inter> x = (z \<inter> (x \<union> y)) \<inter> x" using disj by blast
     moreover
     have "z \<inter> y = (z \<inter> (x \<union> y)) - x" using disj by blast
-    moreover 
+    moreover
     have "(z \<inter> (x \<union> y)) \<in> sets M"
-      by (metis Int Un lambda_system_sets xl yl z) 
+      by (metis Int Un lambda_system_sets xl yl z)
     ultimately show ?thesis using xl yl
       by (simp add: lambda_system_eq)
   qed
 
-lemma (in algebra) Int_space_eq1 [simp]: "x \<in> sets M \<Longrightarrow> space M \<inter> x = x"
-  by (metis Int_absorb1 sets_into_space)
-
-lemma (in algebra) Int_space_eq2 [simp]: "x \<in> sets M \<Longrightarrow> x \<inter> space M = x"
-  by (metis Int_absorb2 sets_into_space)
-
 lemma (in algebra) lambda_system_additive:
      "additive (M (|sets := lambda_system M f|)) f"
   proof (auto simp add: additive_def)
@@ -279,14 +240,14 @@
     assume disj: "x \<inter> y = {}"
        and xl: "x \<in> lambda_system M f" and yl: "y \<in> lambda_system M f"
     hence  "x \<in> sets M" "y \<in> sets M" by (blast intro: lambda_system_sets)+
-    thus "f (x \<union> y) = f x + f y" 
+    thus "f (x \<union> y) = f x + f y"
       using lambda_system_strong_additive [OF top disj xl yl]
       by (simp add: Un)
   qed
 
 
 lemma (in algebra) countably_subadditive_subadditive:
-  assumes f: "positive M f" and cs: "countably_subadditive M f"
+  assumes f: "positive f" and cs: "countably_subadditive M f"
   shows  "subadditive M f"
 proof (auto simp add: subadditive_def)
   fix x y
@@ -295,159 +256,80 @@
     by (auto simp add: disjoint_family_on_def binaryset_def)
   hence "range (binaryset x y) \<subseteq> sets M \<longrightarrow>
          (\<Union>i. binaryset x y i) \<in> sets M \<longrightarrow>
-         summable (f o (binaryset x y)) \<longrightarrow>
-         f (\<Union>i. binaryset x y i) \<le> suminf (\<lambda>n. f (binaryset x y n))"
+         f (\<Union>i. binaryset x y i) \<le> (\<Sum>\<^isub>\<infinity> n. f (binaryset x y n))"
     using cs by (simp add: countably_subadditive_def)
   hence "{x,y,{}} \<subseteq> sets M \<longrightarrow> x \<union> y \<in> sets M \<longrightarrow>
-         summable (f o (binaryset x y)) \<longrightarrow>
-         f (x \<union> y) \<le> suminf (\<lambda>n. f (binaryset x y n))"
+         f (x \<union> y) \<le> (\<Sum>\<^isub>\<infinity> n. f (binaryset x y n))"
     by (simp add: range_binaryset_eq UN_binaryset_eq)
-  thus "f (x \<union> y) \<le>  f x + f y" using f x y binaryset_sums
-    by (auto simp add: Un sums_iff positive_def o_def)
-qed
-
-
-definition disjointed :: "(nat \<Rightarrow> 'a set) \<Rightarrow> nat \<Rightarrow> 'a set "
-  where "disjointed A n = A n - (\<Union>i\<in>{0..<n}. A i)"
-
-lemma finite_UN_disjointed_eq: "(\<Union>i\<in>{0..<n}. disjointed A i) = (\<Union>i\<in>{0..<n}. A i)"
-proof (induct n)
-  case 0 show ?case by simp
-next
-  case (Suc n)
-  thus ?case by (simp add: atLeastLessThanSuc disjointed_def)
+  thus "f (x \<union> y) \<le>  f x + f y" using f x y
+    by (auto simp add: Un o_def binaryset_psuminf positive_def)
 qed
 
-lemma UN_disjointed_eq: "(\<Union>i. disjointed A i) = (\<Union>i. A i)"
-  apply (rule UN_finite2_eq [where k=0])
-  apply (simp add: finite_UN_disjointed_eq)
-  done
-
-lemma less_disjoint_disjointed: "m<n \<Longrightarrow> disjointed A m \<inter> disjointed A n = {}"
-  by (auto simp add: disjointed_def)
-
-lemma disjoint_family_disjointed: "disjoint_family (disjointed A)"
-  by (simp add: disjoint_family_on_def)
-     (metis neq_iff Int_commute less_disjoint_disjointed)
-
-lemma disjointed_subset: "disjointed A n \<subseteq> A n"
-  by (auto simp add: disjointed_def)
-
-
-lemma (in algebra) UNION_in_sets:
-  fixes A:: "nat \<Rightarrow> 'a set"
-  assumes A: "range A \<subseteq> sets M "
-  shows  "(\<Union>i\<in>{0..<n}. A i) \<in> sets M"
-proof (induct n)
-  case 0 show ?case by simp
-next
-  case (Suc n) 
-  thus ?case
-    by (simp add: atLeastLessThanSuc) (metis A Un UNIV_I image_subset_iff)
-qed
-
-lemma (in algebra) range_disjointed_sets:
-  assumes A: "range A \<subseteq> sets M "
-  shows  "range (disjointed A) \<subseteq> sets M"
-proof (auto simp add: disjointed_def) 
-  fix n
-  show "A n - (\<Union>i\<in>{0..<n}. A i) \<in> sets M" using UNION_in_sets
-    by (metis A Diff UNIV_I image_subset_iff)
-qed
-
-lemma sigma_algebra_disjoint_iff: 
-     "sigma_algebra M \<longleftrightarrow> 
-      algebra M &
-      (\<forall>A. range A \<subseteq> sets M \<longrightarrow> disjoint_family A \<longrightarrow> 
-           (\<Union>i::nat. A i) \<in> sets M)"
-proof (auto simp add: sigma_algebra_iff)
-  fix A :: "nat \<Rightarrow> 'a set"
-  assume M: "algebra M"
-     and A: "range A \<subseteq> sets M"
-     and UnA: "\<forall>A. range A \<subseteq> sets M \<longrightarrow>
-               disjoint_family A \<longrightarrow> (\<Union>i::nat. A i) \<in> sets M"
-  hence "range (disjointed A) \<subseteq> sets M \<longrightarrow>
-         disjoint_family (disjointed A) \<longrightarrow>
-         (\<Union>i. disjointed A i) \<in> sets M" by blast
-  hence "(\<Union>i. disjointed A i) \<in> sets M"
-    by (simp add: algebra.range_disjointed_sets M A disjoint_family_disjointed) 
-  thus "(\<Union>i::nat. A i) \<in> sets M" by (simp add: UN_disjointed_eq)
-qed
-
-
 lemma (in algebra) additive_sum:
   fixes A:: "nat \<Rightarrow> 'a set"
-  assumes f: "positive M f" and ad: "additive M f"
+  assumes f: "positive f" and ad: "additive M f"
       and A: "range A \<subseteq> sets M"
       and disj: "disjoint_family A"
-  shows  "setsum (f o A) {0..<n} = f (\<Union>i\<in>{0..<n}. A i)"
+  shows  "setsum (f \<circ> A) {0..<n} = f (\<Union>i\<in>{0..<n}. A i)"
 proof (induct n)
-  case 0 show ?case using f by (simp add: positive_def) 
+  case 0 show ?case using f by (simp add: positive_def)
 next
-  case (Suc n) 
-  have "A n \<inter> (\<Union>i\<in>{0..<n}. A i) = {}" using disj 
+  case (Suc n)
+  have "A n \<inter> (\<Union>i\<in>{0..<n}. A i) = {}" using disj
     by (auto simp add: disjoint_family_on_def neq_iff) blast
-  moreover 
-  have "A n \<in> sets M" using A by blast 
+  moreover
+  have "A n \<in> sets M" using A by blast
   moreover have "(\<Union>i\<in>{0..<n}. A i) \<in> sets M"
     by (metis A UNION_in_sets atLeast0LessThan)
-  moreover 
+  moreover
   ultimately have "f (A n \<union> (\<Union>i\<in>{0..<n}. A i)) = f (A n) + f(\<Union>i\<in>{0..<n}. A i)"
-    using ad UNION_in_sets A by (auto simp add: additive_def) 
+    using ad UNION_in_sets A by (auto simp add: additive_def)
   with Suc.hyps show ?case using ad
-    by (auto simp add: atLeastLessThanSuc additive_def) 
+    by (auto simp add: atLeastLessThanSuc additive_def)
 qed
 
 
 lemma countably_subadditiveD:
   "countably_subadditive M f \<Longrightarrow> range A \<subseteq> sets M \<Longrightarrow> disjoint_family A \<Longrightarrow>
-   (\<Union>i. A i) \<in> sets M \<Longrightarrow> summable (f o A) \<Longrightarrow> f (\<Union>i. A i) \<le> suminf (f o A)" 
+   (\<Union>i. A i) \<in> sets M \<Longrightarrow> f (\<Union>i. A i) \<le> psuminf (f o A)"
   by (auto simp add: countably_subadditive_def o_def)
 
-lemma (in algebra) increasing_additive_summable:
-  fixes A:: "nat \<Rightarrow> 'a set"
-  assumes f: "positive M f" and ad: "additive M f"
+lemma (in algebra) increasing_additive_bound:
+  fixes A:: "nat \<Rightarrow> 'a set" and  f :: "'a set \<Rightarrow> pinfreal"
+  assumes f: "positive f" and ad: "additive M f"
       and inc: "increasing M f"
       and A: "range A \<subseteq> sets M"
       and disj: "disjoint_family A"
-  shows  "summable (f o A)"
-proof (rule pos_summable) 
-  fix n
-  show "0 \<le> (f \<circ> A) n" using f A
-    by (force simp add: positive_def)
-  next
-  fix n
-  have "setsum (f \<circ> A) {0..<n} = f (\<Union>i\<in>{0..<n}. A i)"
-    by (rule additive_sum [OF f ad A disj]) 
+  shows  "psuminf (f \<circ> A) \<le> f (space M)"
+proof (safe intro!: psuminf_bound)
+  fix N
+  have "setsum (f \<circ> A) {0..<N} = f (\<Union>i\<in>{0..<N}. A i)"
+    by (rule additive_sum [OF f ad A disj])
   also have "... \<le> f (space M)" using space_closed A
-    by (blast intro: increasingD [OF inc] UNION_in_sets top) 
-  finally show "setsum (f \<circ> A) {0..<n} \<le> f (space M)" .
+    by (blast intro: increasingD [OF inc] UNION_in_sets top)
+  finally show "setsum (f \<circ> A) {..<N} \<le> f (space M)" by (simp add: atLeast0LessThan)
 qed
 
-lemma lambda_system_positive:
-     "positive M f \<Longrightarrow> positive (M (|sets := lambda_system M f|)) f"
-  by (simp add: positive_def lambda_system_def) 
-
 lemma lambda_system_increasing:
    "increasing M f \<Longrightarrow> increasing (M (|sets := lambda_system M f|)) f"
-  by (simp add: increasing_def lambda_system_def) 
+  by (simp add: increasing_def lambda_system_def)
 
 lemma (in algebra) lambda_system_strong_sum:
-  fixes A:: "nat \<Rightarrow> 'a set"
-  assumes f: "positive M f" and a: "a \<in> sets M"
+  fixes A:: "nat \<Rightarrow> 'a set" and f :: "'a set \<Rightarrow> pinfreal"
+  assumes f: "positive f" and a: "a \<in> sets M"
       and A: "range A \<subseteq> lambda_system M f"
       and disj: "disjoint_family A"
   shows  "(\<Sum>i = 0..<n. f (a \<inter>A i)) = f (a \<inter> (\<Union>i\<in>{0..<n}. A i))"
 proof (induct n)
-  case 0 show ?case using f by (simp add: positive_def) 
+  case 0 show ?case using f by (simp add: positive_def)
 next
-  case (Suc n) 
+  case (Suc n)
   have 2: "A n \<inter> UNION {0..<n} A = {}" using disj
-    by (force simp add: disjoint_family_on_def neq_iff) 
+    by (force simp add: disjoint_family_on_def neq_iff)
   have 3: "A n \<in> lambda_system M f" using A
     by blast
   have 4: "UNION {0..<n} A \<in> lambda_system M f"
-    using A algebra.UNION_in_sets [OF local.lambda_system_algebra [OF f]] 
+    using A algebra.UNION_in_sets [OF local.lambda_system_algebra, of f, OF f]
     by simp
   from Suc.hyps show ?case
     by (simp add: atLeastLessThanSuc lambda_system_strong_additive [OF a 2 3 4])
@@ -458,89 +340,77 @@
   assumes oms: "outer_measure_space M f"
       and A: "range A \<subseteq> lambda_system M f"
       and disj: "disjoint_family A"
-  shows  "(\<Union>i. A i) \<in> lambda_system M f & (f \<circ> A)  sums  f (\<Union>i. A i)"
+  shows  "(\<Union>i. A i) \<in> lambda_system M f \<and> psuminf (f \<circ> A) = f (\<Union>i. A i)"
 proof -
-  have pos: "positive M f" and inc: "increasing M f" 
-   and csa: "countably_subadditive M f" 
+  have pos: "positive f" and inc: "increasing M f"
+   and csa: "countably_subadditive M f"
     by (metis oms outer_measure_space_def)+
   have sa: "subadditive M f"
-    by (metis countably_subadditive_subadditive csa pos) 
-  have A': "range A \<subseteq> sets (M(|sets := lambda_system M f|))" using A 
+    by (metis countably_subadditive_subadditive csa pos)
+  have A': "range A \<subseteq> sets (M(|sets := lambda_system M f|))" using A
     by simp
   have alg_ls: "algebra (M(|sets := lambda_system M f|))"
-    by (rule lambda_system_algebra [OF pos]) 
+    by (rule lambda_system_algebra) (rule pos)
   have A'': "range A \<subseteq> sets M"
      by (metis A image_subset_iff lambda_system_sets)
-  have sumfA: "summable (f \<circ> A)" 
-    by (metis algebra.increasing_additive_summable [OF alg_ls]
-          lambda_system_positive lambda_system_additive lambda_system_increasing
-          A' oms outer_measure_space_def disj)
+
   have U_in: "(\<Union>i. A i) \<in> sets M"
     by (metis A'' countable_UN)
-  have U_eq: "f (\<Union>i. A i) = suminf (f o A)" 
+  have U_eq: "f (\<Union>i. A i) = psuminf (f o A)"
     proof (rule antisym)
-      show "f (\<Union>i. A i) \<le> suminf (f \<circ> A)"
-        by (rule countably_subadditiveD [OF csa A'' disj U_in sumfA]) 
-      show "suminf (f \<circ> A) \<le> f (\<Union>i. A i)"
-        by (rule suminf_le [OF sumfA]) 
+      show "f (\<Union>i. A i) \<le> psuminf (f \<circ> A)"
+        by (rule countably_subadditiveD [OF csa A'' disj U_in])
+      show "psuminf (f \<circ> A) \<le> f (\<Union>i. A i)"
+        by (rule psuminf_bound, unfold atLeast0LessThan[symmetric])
            (metis algebra.additive_sum [OF alg_ls] pos disj UN_Un Un_UNIV_right
-                  lambda_system_positive lambda_system_additive 
-                  subset_Un_eq increasingD [OF inc] A' A'' UNION_in_sets U_in) 
+                  lambda_system_additive subset_Un_eq increasingD [OF inc]
+                  A' A'' UNION_in_sets U_in)
     qed
   {
-    fix a 
-    assume a [iff]: "a \<in> sets M" 
+    fix a
+    assume a [iff]: "a \<in> sets M"
     have "f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i)) = f a"
     proof -
-      have summ: "summable (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A)" using pos A'' 
-        apply -
-        apply (rule summable_comparison_test [OF _ sumfA]) 
-        apply (rule_tac x="0" in exI) 
-        apply (simp add: positive_def) 
-        apply (auto simp add: )
-        apply (subst abs_of_nonneg)
-        apply (metis A'' Int UNIV_I a image_subset_iff)
-        apply (blast intro:  increasingD [OF inc])
-        done
       show ?thesis
       proof (rule antisym)
         have "range (\<lambda>i. a \<inter> A i) \<subseteq> sets M" using A''
           by blast
-        moreover 
+        moreover
         have "disjoint_family (\<lambda>i. a \<inter> A i)" using disj
-          by (auto simp add: disjoint_family_on_def) 
-        moreover 
+          by (auto simp add: disjoint_family_on_def)
+        moreover
         have "a \<inter> (\<Union>i. A i) \<in> sets M"
           by (metis Int U_in a)
-        ultimately 
-        have "f (a \<inter> (\<Union>i. A i)) \<le> suminf (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A)"
-          using countably_subadditiveD [OF csa, of "(\<lambda>i. a \<inter> A i)"] summ
-          by (simp add: o_def) 
-        moreover 
-        have "suminf (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A)  \<le> f a - f (a - (\<Union>i. A i))"
-          proof (rule suminf_le [OF summ])
+        ultimately
+        have "f (a \<inter> (\<Union>i. A i)) \<le> psuminf (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A)"
+          using countably_subadditiveD [OF csa, of "(\<lambda>i. a \<inter> A i)"]
+          by (simp add: o_def)
+        hence "f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i)) \<le>
+            psuminf (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A) + f (a - (\<Union>i. A i))"
+          by (rule add_right_mono)
+        moreover
+        have "psuminf (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A) + f (a - (\<Union>i. A i)) \<le> f a"
+          proof (safe intro!: psuminf_bound_add)
             fix n
             have UNION_in: "(\<Union>i\<in>{0..<n}. A i) \<in> sets M"
-              by (metis A'' UNION_in_sets) 
+              by (metis A'' UNION_in_sets)
             have le_fa: "f (UNION {0..<n} A \<inter> a) \<le> f a" using A''
               by (blast intro: increasingD [OF inc] A'' UNION_in_sets)
             have ls: "(\<Union>i\<in>{0..<n}. A i) \<in> lambda_system M f"
-              using algebra.UNION_in_sets [OF lambda_system_algebra [OF pos]]
-              by (simp add: A) 
-            hence eq_fa: "f (a \<inter> (\<Union>i\<in>{0..<n}. A i)) + f (a - (\<Union>i\<in>{0..<n}. A i)) = f a"
+              using algebra.UNION_in_sets [OF lambda_system_algebra [of f, OF pos]]
+              by (simp add: A)
+            hence eq_fa: "f a = f (a \<inter> (\<Union>i\<in>{0..<n}. A i)) + f (a - (\<Union>i\<in>{0..<n}. A i))"
               by (simp add: lambda_system_eq UNION_in)
             have "f (a - (\<Union>i. A i)) \<le> f (a - (\<Union>i\<in>{0..<n}. A i))"
-              by (blast intro: increasingD [OF inc] UNION_eq_Union_image 
+              by (blast intro: increasingD [OF inc] UNION_eq_Union_image
                                UNION_in U_in)
-            thus "setsum (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A) {0..<n} \<le> f a - f (a - (\<Union>i. A i))"
-              using eq_fa
-              by (simp add: suminf_le [OF summ] lambda_system_strong_sum pos 
-                            a A disj)
+            thus "setsum (f \<circ> (\<lambda>i. a \<inter> i) \<circ> A) {..<n} + f (a - (\<Union>i. A i)) \<le> f a"
+              by (simp add: lambda_system_strong_sum pos A disj eq_fa add_left_mono atLeast0LessThan[symmetric])
           qed
-        ultimately show "f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i)) \<le> f a" 
-          by arith
+        ultimately show "f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i)) \<le> f a"
+          by (rule order_trans)
       next
-        have "f a \<le> f (a \<inter> (\<Union>i. A i) \<union> (a - (\<Union>i. A i)))" 
+        have "f a \<le> f (a \<inter> (\<Union>i. A i) \<union> (a - (\<Union>i. A i)))"
           by (blast intro:  increasingD [OF inc] U_in)
         also have "... \<le>  f (a \<inter> (\<Union>i. A i)) + f (a - (\<Union>i. A i))"
           by (blast intro: subadditiveD [OF sa] U_in)
@@ -549,68 +419,54 @@
      qed
   }
   thus  ?thesis
-    by (simp add: lambda_system_eq sums_iff U_eq U_in sumfA)
+    by (simp add: lambda_system_eq sums_iff U_eq U_in)
 qed
 
 lemma (in sigma_algebra) caratheodory_lemma:
   assumes oms: "outer_measure_space M f"
-  shows "measure_space (|space = space M, sets = lambda_system M f, measure = f|)"
+  shows "measure_space (|space = space M, sets = lambda_system M f|) f"
 proof -
-  have pos: "positive M f" 
+  have pos: "positive f"
     by (metis oms outer_measure_space_def)
-  have alg: "algebra (|space = space M, sets = lambda_system M f, measure = f|)"
-    using lambda_system_algebra [OF pos]
-    by (simp add: algebra_def) 
-  then moreover 
-  have "sigma_algebra (|space = space M, sets = lambda_system M f, measure = f|)"
+  have alg: "algebra (|space = space M, sets = lambda_system M f|)"
+    using lambda_system_algebra [of f, OF pos]
+    by (simp add: algebra_def)
+  then moreover
+  have "sigma_algebra (|space = space M, sets = lambda_system M f|)"
     using lambda_system_caratheodory [OF oms]
-    by (simp add: sigma_algebra_disjoint_iff) 
-  moreover 
-  have "measure_space_axioms (|space = space M, sets = lambda_system M f, measure = f|)" 
+    by (simp add: sigma_algebra_disjoint_iff)
+  moreover
+  have "measure_space_axioms (|space = space M, sets = lambda_system M f|) f"
     using pos lambda_system_caratheodory [OF oms]
-    by (simp add: measure_space_axioms_def positive_def lambda_system_sets 
-                  countably_additive_def o_def) 
-  ultimately 
+    by (simp add: measure_space_axioms_def positive_def lambda_system_sets
+                  countably_additive_def o_def)
+  ultimately
   show ?thesis
-    by intro_locales (auto simp add: sigma_algebra_def) 
+    by intro_locales (auto simp add: sigma_algebra_def)
 qed
 
 
 lemma (in algebra) inf_measure_nonempty:
-  assumes f: "positive M f" and b: "b \<in> sets M" and a: "a \<subseteq> b"
+  assumes f: "positive f" and b: "b \<in> sets M" and a: "a \<subseteq> b"
   shows "f b \<in> measure_set M f a"
 proof -
-  have "(f \<circ> (\<lambda>i. {})(0 := b)) sums setsum (f \<circ> (\<lambda>i. {})(0 := b)) {0..<1::nat}"
-    by (rule series_zero)  (simp add: positive_imp_0 [OF f]) 
-  also have "... = f b" 
+  have "psuminf (f \<circ> (\<lambda>i. {})(0 := b)) = setsum (f \<circ> (\<lambda>i. {})(0 := b)) {..<1::nat}"
+    by (rule psuminf_finite) (simp add: f[unfolded positive_def])
+  also have "... = f b"
     by simp
-  finally have "(f \<circ> (\<lambda>i. {})(0 := b)) sums f b" .
-  thus ?thesis using a
-    by (auto intro!: exI [of _ "(\<lambda>i. {})(0 := b)"] 
-             simp add: measure_set_def disjoint_family_on_def b split_if_mem2) 
-qed  
-
-lemma (in algebra) inf_measure_pos0:
-     "positive M f \<Longrightarrow> x \<in> measure_set M f a \<Longrightarrow> 0 \<le> x"
-apply (auto simp add: positive_def measure_set_def sums_iff intro!: suminf_ge_zero)
-apply blast
-done
-
-lemma (in algebra) inf_measure_pos:
-  shows "positive M f \<Longrightarrow> x \<subseteq> space M \<Longrightarrow> 0 \<le> Inf (measure_set M f x)"
-apply (rule Inf_greatest)
-apply (metis emptyE inf_measure_nonempty top)
-apply (metis inf_measure_pos0) 
-done
+  finally have "psuminf (f \<circ> (\<lambda>i. {})(0 := b)) = f b" .
+  thus ?thesis using a b
+    by (auto intro!: exI [of _ "(\<lambda>i. {})(0 := b)"]
+             simp: measure_set_def disjoint_family_on_def split_if_mem2 comp_def)
+qed
 
 lemma (in algebra) additive_increasing:
-  assumes posf: "positive M f" and addf: "additive M f" 
+  assumes posf: "positive f" and addf: "additive M f"
   shows "increasing M f"
-proof (auto simp add: increasing_def) 
+proof (auto simp add: increasing_def)
   fix x y
   assume xy: "x \<in> sets M" "y \<in> sets M" "x \<subseteq> y"
-  have "f x \<le> f x + f (y-x)" using posf
-    by (simp add: positive_def) (metis Diff xy(1,2))
+  have "f x \<le> f x + f (y-x)" ..
   also have "... = f (x \<union> (y-x))" using addf
     by (auto simp add: additive_def) (metis Diff_disjoint Un_Diff_cancel Diff xy(1,2))
   also have "... = f y"
@@ -619,42 +475,42 @@
 qed
 
 lemma (in algebra) countably_additive_additive:
-  assumes posf: "positive M f" and ca: "countably_additive M f" 
+  assumes posf: "positive f" and ca: "countably_additive M f"
   shows "additive M f"
-proof (auto simp add: additive_def) 
+proof (auto simp add: additive_def)
   fix x y
   assume x: "x \<in> sets M" and y: "y \<in> sets M" and "x \<inter> y = {}"
   hence "disjoint_family (binaryset x y)"
-    by (auto simp add: disjoint_family_on_def binaryset_def) 
-  hence "range (binaryset x y) \<subseteq> sets M \<longrightarrow> 
-         (\<Union>i. binaryset x y i) \<in> sets M \<longrightarrow> 
-         f (\<Union>i. binaryset x y i) = suminf (\<lambda>n. f (binaryset x y n))"
+    by (auto simp add: disjoint_family_on_def binaryset_def)
+  hence "range (binaryset x y) \<subseteq> sets M \<longrightarrow>
+         (\<Union>i. binaryset x y i) \<in> sets M \<longrightarrow>
+         f (\<Union>i. binaryset x y i) = (\<Sum>\<^isub>\<infinity> n. f (binaryset x y n))"
     using ca
-    by (simp add: countably_additive_def) (metis UN_binaryset_eq sums_unique) 
-  hence "{x,y,{}} \<subseteq> sets M \<longrightarrow> x \<union> y \<in> sets M \<longrightarrow> 
-         f (x \<union> y) = suminf (\<lambda>n. f (binaryset x y n))"
+    by (simp add: countably_additive_def)
+  hence "{x,y,{}} \<subseteq> sets M \<longrightarrow> x \<union> y \<in> sets M \<longrightarrow>
+         f (x \<union> y) = (\<Sum>\<^isub>\<infinity> n. f (binaryset x y n))"
     by (simp add: range_binaryset_eq UN_binaryset_eq)
   thus "f (x \<union> y) = f x + f y" using posf x y
-    by (simp add: Un suminf_binaryset_eq positive_def)
-qed 
- 
+    by (auto simp add: Un binaryset_psuminf positive_def)
+qed
+
 lemma (in algebra) inf_measure_agrees:
-  assumes posf: "positive M f" and ca: "countably_additive M f" 
-      and s: "s \<in> sets M"  
+  assumes posf: "positive f" and ca: "countably_additive M f"
+      and s: "s \<in> sets M"
   shows "Inf (measure_set M f s) = f s"
-proof (rule Inf_eq) 
+  unfolding Inf_pinfreal_def
+proof (safe intro!: Greatest_equality)
   fix z
   assume z: "z \<in> measure_set M f s"
-  from this obtain A where 
+  from this obtain A where
     A: "range A \<subseteq> sets M" and disj: "disjoint_family A"
-    and "s \<subseteq> (\<Union>x. A x)" and sm: "summable (f \<circ> A)"
-    and si: "suminf (f \<circ> A) = z"
-    by (auto simp add: measure_set_def sums_iff) 
+    and "s \<subseteq> (\<Union>x. A x)" and si: "psuminf (f \<circ> A) = z"
+    by (auto simp add: measure_set_def comp_def)
   hence seq: "s = (\<Union>i. A i \<inter> s)" by blast
   have inc: "increasing M f"
     by (metis additive_increasing ca countably_additive_additive posf)
-  have sums: "(\<lambda>i. f (A i \<inter> s)) sums f (\<Union>i. A i \<inter> s)"
-    proof (rule countably_additiveD [OF ca]) 
+  have sums: "psuminf (\<lambda>i. f (A i \<inter> s)) = f (\<Union>i. A i \<inter> s)"
+    proof (rule countably_additiveD [OF ca])
       show "range (\<lambda>n. A n \<inter> s) \<subseteq> sets M" using A s
         by blast
       show "disjoint_family (\<lambda>n. A n \<inter> s)" using disj
@@ -662,228 +518,184 @@
       show "(\<Union>i. A i \<inter> s) \<in> sets M" using A s
         by (metis UN_extend_simps(4) s seq)
     qed
-  hence "f s = suminf (\<lambda>i. f (A i \<inter> s))"
+  hence "f s = psuminf (\<lambda>i. f (A i \<inter> s))"
     using seq [symmetric] by (simp add: sums_iff)
-  also have "... \<le> suminf (f \<circ> A)" 
-    proof (rule summable_le [OF _ _ sm]) 
-      show "\<forall>n. f (A n \<inter> s) \<le> (f \<circ> A) n" using A s
-        by (force intro: increasingD [OF inc]) 
-      show "summable (\<lambda>i. f (A i \<inter> s))" using sums
-        by (simp add: sums_iff) 
+  also have "... \<le> psuminf (f \<circ> A)"
+    proof (rule psuminf_le)
+      fix n show "f (A n \<inter> s) \<le> (f \<circ> A) n" using A s
+        by (force intro: increasingD [OF inc])
     qed
-  also have "... = z" by (rule si) 
+  also have "... = z" by (rule si)
   finally show "f s \<le> z" .
 next
   fix y
-  assume y: "!!u. u \<in> measure_set M f s \<Longrightarrow> y \<le> u"
+  assume y: "\<forall>u \<in> measure_set M f s. y \<le> u"
   thus "y \<le> f s"
-    by (blast intro: inf_measure_nonempty [OF posf s subset_refl])
+    by (blast intro: inf_measure_nonempty [of f, OF posf s subset_refl])
 qed
 
 lemma (in algebra) inf_measure_empty:
-  assumes posf: "positive M f"
+  assumes posf: "positive f"
   shows "Inf (measure_set M f {}) = 0"
 proof (rule antisym)
-  show "0 \<le> Inf (measure_set M f {})"
-    by (metis empty_subsetI inf_measure_pos posf) 
   show "Inf (measure_set M f {}) \<le> 0"
-    by (metis Inf_lower empty_sets inf_measure_pos0 inf_measure_nonempty posf
-              positive_imp_0 subset_refl) 
-qed
+    by (metis complete_lattice_class.Inf_lower empty_sets inf_measure_nonempty[OF posf] subset_refl posf[unfolded positive_def])
+qed simp
 
 lemma (in algebra) inf_measure_positive:
-  "positive M f \<Longrightarrow> 
-   positive (| space = space M, sets = Pow (space M) |)
-                  (\<lambda>x. Inf (measure_set M f x))"
-  by (simp add: positive_def inf_measure_empty inf_measure_pos) 
+  "positive f \<Longrightarrow>
+   positive (\<lambda>x. Inf (measure_set M f x))"
+  by (simp add: positive_def inf_measure_empty) 
 
 lemma (in algebra) inf_measure_increasing:
-  assumes posf: "positive M f"
+  assumes posf: "positive f"
   shows "increasing (| space = space M, sets = Pow (space M) |)
                     (\<lambda>x. Inf (measure_set M f x))"
-apply (auto simp add: increasing_def) 
-apply (rule Inf_greatest, metis emptyE inf_measure_nonempty top posf)
-apply (rule Inf_lower) 
+apply (auto simp add: increasing_def)
+apply (rule complete_lattice_class.Inf_greatest)
+apply (rule complete_lattice_class.Inf_lower)
 apply (clarsimp simp add: measure_set_def, rule_tac x=A in exI, blast)
-apply (blast intro: inf_measure_pos0 posf)
 done
 
 
 lemma (in algebra) inf_measure_le:
-  assumes posf: "positive M f" and inc: "increasing M f" 
-      and x: "x \<in> {r . \<exists>A. range A \<subseteq> sets M & s \<subseteq> (\<Union>i. A i) & (f \<circ> A) sums r}"
+  assumes posf: "positive f" and inc: "increasing M f"
+      and x: "x \<in> {r . \<exists>A. range A \<subseteq> sets M \<and> s \<subseteq> (\<Union>i. A i) \<and> psuminf (f \<circ> A) = r}"
   shows "Inf (measure_set M f s) \<le> x"
 proof -
   from x
-  obtain A where A: "range A \<subseteq> sets M" and ss: "s \<subseteq> (\<Union>i. A i)" 
-             and sm: "summable (f \<circ> A)" and xeq: "suminf (f \<circ> A) = x"
-    by (auto simp add: sums_iff)
+  obtain A where A: "range A \<subseteq> sets M" and ss: "s \<subseteq> (\<Union>i. A i)"
+             and xeq: "psuminf (f \<circ> A) = x"
+    by auto
   have dA: "range (disjointed A) \<subseteq> sets M"
     by (metis A range_disjointed_sets)
-  have "\<forall>n. \<bar>(f o disjointed A) n\<bar> \<le> (f \<circ> A) n"
-    proof (auto)
-      fix n
-      have "\<bar>f (disjointed A n)\<bar> = f (disjointed A n)" using posf dA
-        by (auto simp add: positive_def image_subset_iff)
-      also have "... \<le> f (A n)" 
-        by (metis increasingD [OF inc] UNIV_I dA image_subset_iff disjointed_subset A)
-      finally show "\<bar>f (disjointed A n)\<bar> \<le> f (A n)" .
-    qed
-  from Series.summable_le2 [OF this sm]
-  have sda:  "summable (f o disjointed A)"  
-             "suminf (f o disjointed A) \<le> suminf (f \<circ> A)"
-    by blast+
-  hence ley: "suminf (f o disjointed A) \<le> x"
-    by (metis xeq) 
-  from sda have "(f \<circ> disjointed A) sums suminf (f \<circ> disjointed A)"
-    by (simp add: sums_iff) 
-  hence y: "suminf (f o disjointed A) \<in> measure_set M f s"
+  have "\<forall>n.(f o disjointed A) n \<le> (f \<circ> A) n" unfolding comp_def
+    by (metis increasingD [OF inc] UNIV_I dA image_subset_iff disjointed_subset A comp_def)
+  hence sda: "psuminf (f o disjointed A) \<le> psuminf (f \<circ> A)"
+    by (blast intro: psuminf_le)
+  hence ley: "psuminf (f o disjointed A) \<le> x"
+    by (metis xeq)
+  hence y: "psuminf (f o disjointed A) \<in> measure_set M f s"
     apply (auto simp add: measure_set_def)
-    apply (rule_tac x="disjointed A" in exI) 
-    apply (simp add: disjoint_family_disjointed UN_disjointed_eq ss dA)
+    apply (rule_tac x="disjointed A" in exI)
+    apply (simp add: disjoint_family_disjointed UN_disjointed_eq ss dA comp_def)
     done
   show ?thesis
-    by (blast intro: y order_trans [OF _ ley] inf_measure_pos0 posf)
+    by (blast intro: y order_trans [OF _ ley] posf complete_lattice_class.Inf_lower)
 qed
 
 lemma (in algebra) inf_measure_close:
-  assumes posf: "positive M f" and e: "0 < e" and ss: "s \<subseteq> (space M)"
-  shows "\<exists>A l. range A \<subseteq> sets M & disjoint_family A & s \<subseteq> (\<Union>i. A i) & 
-               (f \<circ> A) sums l & l \<le> Inf (measure_set M f s) + e"
-proof -
-  have " measure_set M f s \<noteq> {}" 
-    by (metis emptyE ss inf_measure_nonempty [OF posf top])
-  hence "\<exists>l \<in> measure_set M f s. l < Inf (measure_set M f s) + e" 
-    by (rule Inf_close [OF _ e])
-  thus ?thesis 
-    by (auto simp add: measure_set_def, rule_tac x=" A" in exI, auto)
+  assumes posf: "positive f" and e: "0 < e" and ss: "s \<subseteq> (space M)"
+  shows "\<exists>A. range A \<subseteq> sets M \<and> disjoint_family A \<and> s \<subseteq> (\<Union>i. A i) \<and>
+               psuminf (f \<circ> A) \<le> Inf (measure_set M f s) + e"
+proof (cases "Inf (measure_set M f s) = \<omega>")
+  case False
+  obtain l where "l \<in> measure_set M f s" "l \<le> Inf (measure_set M f s) + e"
+    using Inf_close[OF False e] by auto
+  thus ?thesis
+    by (auto intro!: exI[of _ l] simp: measure_set_def comp_def)
+next
+  case True
+  have "measure_set M f s \<noteq> {}"
+    by (metis emptyE ss inf_measure_nonempty [of f, OF posf top])
+  then obtain l where "l \<in> measure_set M f s" by auto
+  moreover from True have "l \<le> Inf (measure_set M f s) + e" by simp
+  ultimately show ?thesis
+    by (auto intro!: exI[of _ l] simp: measure_set_def comp_def)
 qed
 
 lemma (in algebra) inf_measure_countably_subadditive:
-  assumes posf: "positive M f" and inc: "increasing M f" 
+  assumes posf: "positive f" and inc: "increasing M f"
   shows "countably_subadditive (| space = space M, sets = Pow (space M) |)
                   (\<lambda>x. Inf (measure_set M f x))"
-proof (auto simp add: countably_subadditive_def o_def, rule field_le_epsilon)
-  fix A :: "nat \<Rightarrow> 'a set" and e :: real
-    assume A: "range A \<subseteq> Pow (space M)"
-       and disj: "disjoint_family A"
-       and sb: "(\<Union>i. A i) \<subseteq> space M"
-       and sum1: "summable (\<lambda>n. Inf (measure_set M f (A n)))"
-       and e: "0 < e"
-    have "!!n. \<exists>B l. range B \<subseteq> sets M \<and> disjoint_family B \<and> A n \<subseteq> (\<Union>i. B i) \<and>
-                    (f o B) sums l \<and>
-                    l \<le> Inf (measure_set M f (A n)) + e * (1/2)^(Suc n)"
-      apply (rule inf_measure_close [OF posf])
-      apply (metis e half mult_pos_pos zero_less_power) 
-      apply (metis UNIV_I UN_subset_iff sb)
-      done
-    hence "\<exists>BB ll. \<forall>n. range (BB n) \<subseteq> sets M \<and> disjoint_family (BB n) \<and>
-                       A n \<subseteq> (\<Union>i. BB n i) \<and> (f o BB n) sums ll n \<and>
-                       ll n \<le> Inf (measure_set M f (A n)) + e * (1/2)^(Suc n)"
-      by (rule choice2)
-    then obtain BB ll
-      where BB: "!!n. (range (BB n) \<subseteq> sets M)"
-        and disjBB: "!!n. disjoint_family (BB n)" 
-        and sbBB: "!!n. A n \<subseteq> (\<Union>i. BB n i)"
-        and BBsums: "!!n. (f o BB n) sums ll n"
-        and ll: "!!n. ll n \<le> Inf (measure_set M f (A n)) + e * (1/2)^(Suc n)"
-      by auto blast
-    have llpos: "!!n. 0 \<le> ll n"
-        by (metis BBsums sums_iff o_apply posf positive_imp_pos suminf_ge_zero 
-              range_subsetD BB) 
-    have sll: "summable ll &
-               suminf ll \<le> suminf (\<lambda>n. Inf (measure_set M f (A n))) + e"
-      proof -
-        have "(\<lambda>n. e * (1/2)^(Suc n)) sums (e*1)"
-          by (rule sums_mult [OF power_half_series]) 
-        hence sum0: "summable (\<lambda>n. e * (1 / 2) ^ Suc n)"
-          and eqe:  "(\<Sum>n. e * (1 / 2) ^ n / 2) = e"
-          by (auto simp add: sums_iff) 
-        have 0: "suminf (\<lambda>n. Inf (measure_set M f (A n))) +
-                 suminf (\<lambda>n. e * (1/2)^(Suc n)) =
-                 suminf (\<lambda>n. Inf (measure_set M f (A n)) + e * (1/2)^(Suc n))"
-          by (rule suminf_add [OF sum1 sum0]) 
-        have 1: "\<forall>n. \<bar>ll n\<bar> \<le> Inf (measure_set M f (A n)) + e * (1/2) ^ Suc n"
-          by (metis ll llpos abs_of_nonneg)
-        have 2: "summable (\<lambda>n. Inf (measure_set M f (A n)) + e*(1/2)^(Suc n))"
-          by (rule summable_add [OF sum1 sum0]) 
-        have "suminf ll \<le> (\<Sum>n. Inf (measure_set M f (A n)) + e*(1/2) ^ Suc n)"
-          using Series.summable_le2 [OF 1 2] by auto
-        also have "... = (\<Sum>n. Inf (measure_set M f (A n))) + 
-                         (\<Sum>n. e * (1 / 2) ^ Suc n)"
-          by (metis 0) 
-        also have "... = (\<Sum>n. Inf (measure_set M f (A n))) + e"
-          by (simp add: eqe) 
-        finally show ?thesis using  Series.summable_le2 [OF 1 2] by auto
-      qed
-    def C \<equiv> "(split BB) o prod_decode"
-    have C: "!!n. C n \<in> sets M"
-      apply (rule_tac p="prod_decode n" in PairE)
-      apply (simp add: C_def)
-      apply (metis BB subsetD rangeI)  
-      done
-    have sbC: "(\<Union>i. A i) \<subseteq> (\<Union>i. C i)"
-      proof (auto simp add: C_def)
-        fix x i
-        assume x: "x \<in> A i"
-        with sbBB [of i] obtain j where "x \<in> BB i j"
-          by blast        
-        thus "\<exists>i. x \<in> split BB (prod_decode i)"
-          by (metis prod_encode_inverse prod.cases)
-      qed 
-    have "(f \<circ> C) = (f \<circ> (\<lambda>(x, y). BB x y)) \<circ> prod_decode"
-      by (rule ext)  (auto simp add: C_def) 
-    also have "... sums suminf ll" 
-      proof (rule suminf_2dimen)
-        show "\<And>m n. 0 \<le> (f \<circ> (\<lambda>(x, y). BB x y)) (m, n)" using posf BB 
-          by (force simp add: positive_def)
-        show "\<And>m. (\<lambda>n. (f \<circ> (\<lambda>(x, y). BB x y)) (m, n)) sums ll m"using BBsums BB
-          by (force simp add: o_def)
-        show "summable ll" using sll
-          by auto
-      qed
-    finally have Csums: "(f \<circ> C) sums suminf ll" .
-    have "Inf (measure_set M f (\<Union>i. A i)) \<le> suminf ll"
-      apply (rule inf_measure_le [OF posf inc], auto)
-      apply (rule_tac x="C" in exI)
-      apply (auto simp add: C sbC Csums) 
-      done
-    also have "... \<le> (\<Sum>n. Inf (measure_set M f (A n))) + e" using sll
-      by blast
-    finally show "Inf (measure_set M f (\<Union>i. A i)) \<le> 
-          (\<Sum>n. Inf (measure_set M f (A n))) + e" .
+  unfolding countably_subadditive_def o_def
+proof (safe, simp, rule pinfreal_le_epsilon)
+  fix A :: "nat \<Rightarrow> 'a set" and e :: pinfreal
+
+  let "?outer n" = "Inf (measure_set M f (A n))"
+  assume A: "range A \<subseteq> Pow (space M)"
+     and disj: "disjoint_family A"
+     and sb: "(\<Union>i. A i) \<subseteq> space M"
+     and e: "0 < e"
+  hence "\<exists>BB. \<forall>n. range (BB n) \<subseteq> sets M \<and> disjoint_family (BB n) \<and>
+                   A n \<subseteq> (\<Union>i. BB n i) \<and>
+                   psuminf (f o BB n) \<le> ?outer n + e * (1/2)^(Suc n)"
+    apply (safe intro!: choice inf_measure_close [of f, OF posf _])
+    using e sb by (cases e, auto simp add: not_le mult_pos_pos)
+  then obtain BB
+    where BB: "\<And>n. (range (BB n) \<subseteq> sets M)"
+      and disjBB: "\<And>n. disjoint_family (BB n)"
+      and sbBB: "\<And>n. A n \<subseteq> (\<Union>i. BB n i)"
+      and BBle: "\<And>n. psuminf (f o BB n) \<le> ?outer n + e * (1/2)^(Suc n)"
+    by auto blast
+  have sll: "(\<Sum>\<^isub>\<infinity> n. psuminf (f o BB n)) \<le> psuminf ?outer + e"
+    proof -
+      have "(\<Sum>\<^isub>\<infinity> n. psuminf (f o BB n)) \<le> (\<Sum>\<^isub>\<infinity> n. ?outer n + e*(1/2) ^ Suc n)"
+        by (rule psuminf_le[OF BBle])
+      also have "... = psuminf ?outer + e"
+        using psuminf_half_series by simp
+      finally show ?thesis .
+    qed
+  def C \<equiv> "(split BB) o prod_decode"
+  have C: "!!n. C n \<in> sets M"
+    apply (rule_tac p="prod_decode n" in PairE)
+    apply (simp add: C_def)
+    apply (metis BB subsetD rangeI)
+    done
+  have sbC: "(\<Union>i. A i) \<subseteq> (\<Union>i. C i)"
+    proof (auto simp add: C_def)
+      fix x i
+      assume x: "x \<in> A i"
+      with sbBB [of i] obtain j where "x \<in> BB i j"
+        by blast
+      thus "\<exists>i. x \<in> split BB (prod_decode i)"
+        by (metis prod_encode_inverse prod.cases)
+    qed
+  have "(f \<circ> C) = (f \<circ> (\<lambda>(x, y). BB x y)) \<circ> prod_decode"
+    by (rule ext)  (auto simp add: C_def)
+  moreover have "psuminf ... = (\<Sum>\<^isub>\<infinity> n. psuminf (f o BB n))" using BBle
+    by (force intro!: psuminf_2dimen simp: o_def)
+  ultimately have Csums: "psuminf (f \<circ> C) = (\<Sum>\<^isub>\<infinity> n. psuminf (f o BB n))" by simp
+  have "Inf (measure_set M f (\<Union>i. A i)) \<le> (\<Sum>\<^isub>\<infinity> n. psuminf (f o BB n))"
+    apply (rule inf_measure_le [OF posf(1) inc], auto)
+    apply (rule_tac x="C" in exI)
+    apply (auto simp add: C sbC Csums)
+    done
+  also have "... \<le> (\<Sum>\<^isub>\<infinity>n. Inf (measure_set M f (A n))) + e" using sll
+    by blast
+  finally show "Inf (measure_set M f (\<Union>i. A i)) \<le> psuminf ?outer + e" .
 qed
 
 lemma (in algebra) inf_measure_outer:
-  "positive M f \<Longrightarrow> increasing M f 
+  "\<lbrakk> positive f ; increasing M f \<rbrakk>
    \<Longrightarrow> outer_measure_space (| space = space M, sets = Pow (space M) |)
                           (\<lambda>x. Inf (measure_set M f x))"
-  by (simp add: outer_measure_space_def inf_measure_positive
-                inf_measure_increasing inf_measure_countably_subadditive) 
+  by (simp add: outer_measure_space_def inf_measure_empty
+                inf_measure_increasing inf_measure_countably_subadditive positive_def)
 
 (*MOVE UP*)
 
 lemma (in algebra) algebra_subset_lambda_system:
-  assumes posf: "positive M f" and inc: "increasing M f" 
+  assumes posf: "positive f" and inc: "increasing M f"
       and add: "additive M f"
   shows "sets M \<subseteq> lambda_system (| space = space M, sets = Pow (space M) |)
                                 (\<lambda>x. Inf (measure_set M f x))"
-proof (auto dest: sets_into_space 
-            simp add: algebra.lambda_system_eq [OF algebra_Pow]) 
+proof (auto dest: sets_into_space
+            simp add: algebra.lambda_system_eq [OF algebra_Pow])
   fix x s
   assume x: "x \<in> sets M"
      and s: "s \<subseteq> space M"
-  have [simp]: "!!x. x \<in> sets M \<Longrightarrow> s \<inter> (space M - x) = s-x" using s 
+  have [simp]: "!!x. x \<in> sets M \<Longrightarrow> s \<inter> (space M - x) = s-x" using s
     by blast
   have "Inf (measure_set M f (s\<inter>x)) + Inf (measure_set M f (s-x))
         \<le> Inf (measure_set M f s)"
-    proof (rule field_le_epsilon) 
-      fix e :: real
+    proof (rule pinfreal_le_epsilon)
+      fix e :: pinfreal
       assume e: "0 < e"
-      from inf_measure_close [OF posf e s]
-      obtain A l where A: "range A \<subseteq> sets M" and disj: "disjoint_family A"
-                   and sUN: "s \<subseteq> (\<Union>i. A i)" and fsums: "(f \<circ> A) sums l"
-                   and l: "l \<le> Inf (measure_set M f s) + e"
+      from inf_measure_close [of f, OF posf e s]
+      obtain A where A: "range A \<subseteq> sets M" and disj: "disjoint_family A"
+                 and sUN: "s \<subseteq> (\<Union>i. A i)"
+                 and l: "psuminf (f \<circ> A) \<le> Inf (measure_set M f s) + e"
         by auto
       have [simp]: "!!x. x \<in> sets M \<Longrightarrow>
                       (f o (\<lambda>z. z \<inter> (space M - x)) o A) = (f o (\<lambda>z. z - x) o A)"
@@ -891,104 +703,87 @@
       have  [simp]: "!!n. f (A n \<inter> x) + f (A n - x) = f (A n)"
         by (subst additiveD [OF add, symmetric])
            (auto simp add: x range_subsetD [OF A] Int_Diff_Un Int_Diff_disjoint)
-      have fsumb: "summable (f \<circ> A)"
-        by (metis fsums sums_iff) 
       { fix u
         assume u: "u \<in> sets M"
-        have [simp]: "\<And>n. \<bar>f (A n \<inter> u)\<bar> \<le> f (A n)"
-          by (simp add: positive_imp_pos [OF posf]  increasingD [OF inc] 
-                        u Int  range_subsetD [OF A]) 
-        have 1: "summable (f o (\<lambda>z. z\<inter>u) o A)" 
-          by (rule summable_comparison_test [OF _ fsumb]) simp
-        have 2: "Inf (measure_set M f (s\<inter>u)) \<le> suminf (f o (\<lambda>z. z\<inter>u) o A)"
-          proof (rule Inf_lower) 
-            show "suminf (f \<circ> (\<lambda>z. z \<inter> u) \<circ> A) \<in> measure_set M f (s \<inter> u)"
-              apply (simp add: measure_set_def) 
-              apply (rule_tac x="(\<lambda>z. z \<inter> u) o A" in exI) 
-              apply (auto simp add: disjoint_family_subset [OF disj])
-              apply (blast intro: u range_subsetD [OF A]) 
+        have [simp]: "\<And>n. f (A n \<inter> u) \<le> f (A n)"
+          by (simp add: increasingD [OF inc] u Int range_subsetD [OF A])
+        have 2: "Inf (measure_set M f (s \<inter> u)) \<le> psuminf (f \<circ> (\<lambda>z. z \<inter> u) \<circ> A)"
+          proof (rule complete_lattice_class.Inf_lower)
+            show "psuminf (f \<circ> (\<lambda>z. z \<inter> u) \<circ> A) \<in> measure_set M f (s \<inter> u)"
+              apply (simp add: measure_set_def)
+              apply (rule_tac x="(\<lambda>z. z \<inter> u) o A" in exI)
+              apply (auto simp add: disjoint_family_subset [OF disj] o_def)
+              apply (blast intro: u range_subsetD [OF A])
               apply (blast dest: subsetD [OF sUN])
-              apply (metis 1 o_assoc sums_iff) 
               done
-          next
-            show "\<And>x. x \<in> measure_set M f (s \<inter> u) \<Longrightarrow> 0 \<le> x"
-              by (blast intro: inf_measure_pos0 [OF posf]) 
-            qed
-          note 1 2
+          qed
       } note lesum = this
-      have sum1: "summable (f o (\<lambda>z. z\<inter>x) o A)"
-        and inf1: "Inf (measure_set M f (s\<inter>x)) \<le> suminf (f o (\<lambda>z. z\<inter>x) o A)"
-        and sum2: "summable (f o (\<lambda>z. z \<inter> (space M - x)) o A)"
-        and inf2: "Inf (measure_set M f (s \<inter> (space M - x))) 
-                   \<le> suminf (f o (\<lambda>z. z \<inter> (space M - x)) o A)"
+      have inf1: "Inf (measure_set M f (s\<inter>x)) \<le> psuminf (f o (\<lambda>z. z\<inter>x) o A)"
+        and inf2: "Inf (measure_set M f (s \<inter> (space M - x)))
+                   \<le> psuminf (f o (\<lambda>z. z \<inter> (space M - x)) o A)"
         by (metis Diff lesum top x)+
       hence "Inf (measure_set M f (s\<inter>x)) + Inf (measure_set M f (s-x))
-           \<le> suminf (f o (\<lambda>s. s\<inter>x) o A) + suminf (f o (\<lambda>s. s-x) o A)"
-        by (simp add: x)
-      also have "... \<le> suminf (f o A)" using suminf_add [OF sum1 sum2] 
-        by (simp add: x) (simp add: o_def) 
+           \<le> psuminf (f o (\<lambda>s. s\<inter>x) o A) + psuminf (f o (\<lambda>s. s-x) o A)"
+        by (simp add: x add_mono)
+      also have "... \<le> psuminf (f o A)"
+        by (simp add: x psuminf_add[symmetric] o_def)
       also have "... \<le> Inf (measure_set M f s) + e"
-        by (metis fsums l sums_unique) 
+        by (rule l)
       finally show "Inf (measure_set M f (s\<inter>x)) + Inf (measure_set M f (s-x))
         \<le> Inf (measure_set M f s) + e" .
     qed
-  moreover 
+  moreover
   have "Inf (measure_set M f s)
        \<le> Inf (measure_set M f (s\<inter>x)) + Inf (measure_set M f (s-x))"
     proof -
     have "Inf (measure_set M f s) = Inf (measure_set M f ((s\<inter>x) \<union> (s-x)))"
       by (metis Un_Diff_Int Un_commute)
-    also have "... \<le> Inf (measure_set M f (s\<inter>x)) + Inf (measure_set M f (s-x))" 
-      apply (rule subadditiveD) 
-      apply (iprover intro: algebra.countably_subadditive_subadditive algebra_Pow 
+    also have "... \<le> Inf (measure_set M f (s\<inter>x)) + Inf (measure_set M f (s-x))"
+      apply (rule subadditiveD)
+      apply (iprover intro: algebra.countably_subadditive_subadditive algebra_Pow
                inf_measure_positive inf_measure_countably_subadditive posf inc)
-      apply (auto simp add: subsetD [OF s])  
+      apply (auto simp add: subsetD [OF s])
       done
     finally show ?thesis .
     qed
-  ultimately 
+  ultimately
   show "Inf (measure_set M f (s\<inter>x)) + Inf (measure_set M f (s-x))
         = Inf (measure_set M f s)"
     by (rule order_antisym)
 qed
 
 lemma measure_down:
-     "measure_space N \<Longrightarrow> sigma_algebra M \<Longrightarrow> sets M \<subseteq> sets N \<Longrightarrow>
-      (measure M = measure N) \<Longrightarrow> measure_space M"
-  by (simp add: measure_space_def measure_space_axioms_def positive_def 
-                countably_additive_def) 
+     "measure_space N \<mu> \<Longrightarrow> sigma_algebra M \<Longrightarrow> sets M \<subseteq> sets N \<Longrightarrow>
+      (\<nu> = \<mu>) \<Longrightarrow> measure_space M \<nu>"
+  by (simp add: measure_space_def measure_space_axioms_def positive_def
+                countably_additive_def)
      blast
 
 theorem (in algebra) caratheodory:
-  assumes posf: "positive M f" and ca: "countably_additive M f" 
-  shows "\<exists>MS :: 'a measure_space. 
-             (\<forall>s \<in> sets M. measure MS s = f s) \<and>
-             ((|space = space MS, sets = sets MS|) = sigma (space M) (sets M)) \<and>
-             measure_space MS" 
+  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>"
   proof -
     have inc: "increasing M f"
-      by (metis additive_increasing ca countably_additive_additive posf) 
+      by (metis additive_increasing ca countably_additive_additive posf)
     let ?infm = "(\<lambda>x. Inf (measure_set M f x))"
     def ls \<equiv> "lambda_system (|space = space M, sets = Pow (space M)|) ?infm"
-    have mls: "measure_space (|space = space M, sets = ls, measure = ?infm|)"
+    have mls: "measure_space \<lparr>space = space M, sets = ls\<rparr> ?infm"
       using sigma_algebra.caratheodory_lemma
               [OF sigma_algebra_Pow  inf_measure_outer [OF posf inc]]
       by (simp add: ls_def)
-    hence sls: "sigma_algebra (|space = space M, sets = ls, measure = ?infm|)"
-      by (simp add: measure_space_def) 
-    have "sets M \<subseteq> ls" 
+    hence sls: "sigma_algebra (|space = space M, sets = ls|)"
+      by (simp add: measure_space_def)
+    have "sets M \<subseteq> ls"
       by (simp add: ls_def)
          (metis ca posf inc countably_additive_additive algebra_subset_lambda_system)
-    hence sgs_sb: "sigma_sets (space M) (sets M) \<subseteq> ls" 
+    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 (|space = space M, 
-                          sets = sigma_sets (space M) (sets M),
-                          measure = ?infm|)"
-      by (rule measure_down [OF mls], rule sigma_algebra_sigma_sets) 
+    have "measure_space (sigma (space M) (sets M)) ?infm"
+      unfolding sigma_def
+      by (rule measure_down [OF mls], rule sigma_algebra_sigma_sets)
          (simp_all add: sgs_sb space_closed)
-    thus ?thesis
-      by (force simp add: sigma_def inf_measure_agrees [OF posf ca]) 
-qed
+    thus ?thesis using inf_measure_agrees [OF posf ca] by (auto intro!: exI[of _ ?infm])
+  qed
 
 end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Probability/Euclidean_Lebesgue.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -0,0 +1,213 @@
+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 expand_fun_eq 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)]) ..
+    (*unfolding image_iff defer apply(rule) using u(2) by smt*)
+  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	Mon Aug 23 17:46:13 2010 +0200
+++ b/src/HOL/Probability/Information.thy	Mon Aug 23 19:35:57 2010 +0200
@@ -1,7 +1,12 @@
 theory Information
-imports Probability_Space Product_Measure Convex
+imports Probability_Space Product_Measure Convex Radon_Nikodym
 begin
 
+lemma real_of_pinfreal_inverse[simp]:
+  fixes X :: pinfreal
+  shows "real (inverse X) = 1 / real X"
+  by (cases X) (auto simp: inverse_eq_divide)
+
 section "Convex theory"
 
 lemma log_setsum:
@@ -41,7 +46,7 @@
       assume *: "s - {i. a i = 0} = {}"
       hence "setsum a (s - {i. a i = 0}) = 0" by (simp add: * setsum_empty)
       with sum_1 show False by simp
-qed
+    qed
 
     fix i assume "i \<in> s - {i. a i = 0}"
     hence "i \<in> s" "a i \<noteq> 0" by simp_all
@@ -50,133 +55,6 @@
   ultimately show ?thesis by simp
 qed
 
-section "Information theory"
-
-lemma (in finite_prob_space) sum_over_space_distrib:
-  "(\<Sum>x\<in>X`space M. distribution X {x}) = 1"
-  unfolding distribution_def prob_space[symmetric] using finite_space
-  by (subst measure_finitely_additive'')
-     (auto simp add: disjoint_family_on_def sets_eq_Pow intro!: arg_cong[where f=prob])
-
-locale finite_information_space = finite_prob_space +
-  fixes b :: real assumes b_gt_1: "1 < b"
-
-definition
-  "KL_divergence b M X Y =
-    measure_space.integral (M\<lparr>measure := X\<rparr>)
-                           (\<lambda>x. log b ((measure_space.RN_deriv (M \<lparr>measure := Y\<rparr> ) X) x))"
-
-lemma (in finite_prob_space) distribution_mono:
-  assumes "\<And>t. \<lbrakk> t \<in> space M ; X t \<in> x \<rbrakk> \<Longrightarrow> Y t \<in> y"
-  shows "distribution X x \<le> distribution Y y"
-  unfolding distribution_def
-  using assms by (auto simp: sets_eq_Pow intro!: measure_mono)
-
-lemma (in prob_space) distribution_remove_const:
-  shows "joint_distribution X (\<lambda>x. ()) {(x, ())} = distribution X {x}"
-  and "joint_distribution (\<lambda>x. ()) X {((), x)} = distribution X {x}"
-  and "joint_distribution X (\<lambda>x. (Y x, ())) {(x, y, ())} = joint_distribution X Y {(x, y)}"
-  and "joint_distribution X (\<lambda>x. ((), Y x)) {(x, (), y)} = joint_distribution X Y {(x, y)}"
-  and "distribution (\<lambda>x. ()) {()} = 1"
-  unfolding prob_space[symmetric]
-  by (auto intro!: arg_cong[where f=prob] simp: distribution_def)
-
-
-context finite_information_space
-begin
-
-lemma distribution_mono_gt_0:
-  assumes gt_0: "0 < distribution X x"
-  assumes *: "\<And>t. \<lbrakk> t \<in> space M ; X t \<in> x \<rbrakk> \<Longrightarrow> Y t \<in> y"
-  shows "0 < distribution Y y"
-  by (rule less_le_trans[OF gt_0 distribution_mono]) (rule *)
-
-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")
-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
-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
-
-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 positive_distribution}]
-
-  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
-
-      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
-
-  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
-*}
-
-simproc_setup mult_log ("distribution X x * log b (A * B)" |
-                        "distribution X x * log b (A / B)") = {* K mult_log_simproc *}
-
-end
-
-lemma KL_divergence_eq_finite:
-  assumes u: "finite_measure_space (M\<lparr>measure := u\<rparr>)"
-  assumes v: "finite_measure_space (M\<lparr>measure := v\<rparr>)"
-  assumes u_0: "\<And>x. \<lbrakk> x \<in> space M ; v {x} = 0 \<rbrakk> \<Longrightarrow> u {x} = 0"
-  shows "KL_divergence b M u v = (\<Sum>x\<in>space M. u {x} * log b (u {x} / v {x}))" (is "_ = ?sum")
-proof (simp add: KL_divergence_def, subst finite_measure_space.integral_finite_singleton, simp_all add: u)
-  have ms_u: "measure_space (M\<lparr>measure := u\<rparr>)"
-    using u unfolding finite_measure_space_def by simp
-
-  show "(\<Sum>x \<in> space M. log b (measure_space.RN_deriv (M\<lparr>measure := v\<rparr>) u x) * u {x}) = ?sum"
-    apply (rule setsum_cong[OF refl])
-    apply simp
-    apply (safe intro!: arg_cong[where f="log b"] )
-    apply (subst finite_measure_space.RN_deriv_finite_singleton)
-    using assms ms_u by auto
-qed
-
 lemma log_setsum_divide:
   assumes "finite S" and "S \<noteq> {}" and "1 < b"
   assumes "(\<Sum>x\<in>S. g x) = 1"
@@ -227,47 +105,235 @@
   finally show ?thesis .
 qed
 
-lemma KL_divergence_positive_finite:
-  assumes u: "finite_prob_space (M\<lparr>measure := u\<rparr>)"
-  assumes v: "finite_prob_space (M\<lparr>measure := v\<rparr>)"
-  assumes u_0: "\<And>x. \<lbrakk> x \<in> space M ; v {x} = 0 \<rbrakk> \<Longrightarrow> u {x} = 0"
-  and "1 < b"
-  shows "0 \<le> KL_divergence b M u v"
+lemma (in finite_prob_space) sum_over_space_distrib:
+  "(\<Sum>x\<in>X`space M. distribution X {x}) = 1"
+  unfolding distribution_def measure_space_1[symmetric] using finite_space
+  by (subst measure_finitely_additive'')
+     (auto simp add: disjoint_family_on_def sets_eq_Pow intro!: arg_cong[where f=\<mu>])
+
+lemma (in finite_prob_space) sum_over_space_real_distribution:
+  "(\<Sum>x\<in>X`space M. real (distribution X {x})) = 1"
+  unfolding distribution_def prob_space[symmetric] using finite_space
+  by (subst real_finite_measure_finite_Union[symmetric])
+     (auto simp add: disjoint_family_on_def sets_eq_Pow intro!: arg_cong[where f=prob])
+
+section "Information theory"
+
+definition
+  "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)))"
+
+locale finite_information_space = finite_prob_space +
+  fixes b :: real assumes b_gt_1: "1 < b"
+
+lemma (in finite_prob_space) distribution_mono:
+  assumes "\<And>t. \<lbrakk> t \<in> space M ; X t \<in> x \<rbrakk> \<Longrightarrow> Y t \<in> y"
+  shows "distribution X x \<le> distribution Y y"
+  unfolding distribution_def
+  using assms by (auto simp: sets_eq_Pow intro!: measure_mono)
+
+lemma (in prob_space) distribution_remove_const:
+  shows "joint_distribution X (\<lambda>x. ()) {(x, ())} = distribution X {x}"
+  and "joint_distribution (\<lambda>x. ()) X {((), x)} = distribution X {x}"
+  and "joint_distribution X (\<lambda>x. (Y x, ())) {(x, y, ())} = joint_distribution X Y {(x, y)}"
+  and "joint_distribution X (\<lambda>x. ((), Y x)) {(x, (), y)} = joint_distribution X Y {(x, y)}"
+  and "distribution (\<lambda>x. ()) {()} = 1"
+  unfolding measure_space_1[symmetric]
+  by (auto intro!: arg_cong[where f="\<mu>"] simp: distribution_def)
+
+context finite_information_space
+begin
+
+lemma distribution_mono_gt_0:
+  assumes gt_0: "0 < distribution X x"
+  assumes *: "\<And>t. \<lbrakk> t \<in> space M ; X t \<in> x \<rbrakk> \<Longrightarrow> Y t \<in> y"
+  shows "0 < distribution Y y"
+  by (rule less_le_trans[OF gt_0 distribution_mono]) (rule *)
+
+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")
 proof -
-  interpret u: finite_prob_space "M\<lparr>measure := u\<rparr>" using u .
-  interpret v: finite_prob_space "M\<lparr>measure := v\<rparr>" using v .
+  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
+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
+
+lemma (in finite_information_space) distribution_finite:
+  "distribution X A \<noteq> \<omega>"
+  using measure_finite[of "X -` A \<inter> space M"]
+  unfolding distribution_def sets_eq_Pow by auto
+
+lemma (in finite_information_space) real_distribution_gt_0[simp]:
+  "0 < real (distribution Y y) \<longleftrightarrow>  0 < distribution Y y"
+  using assms by (auto intro!: real_pinfreal_pos distribution_finite)
 
-  have *: "space M \<noteq> {}" using u.not_empty by simp
+lemma real_distribution_mult_pos_pos:
+  assumes "0 < distribution Y y"
+  and "0 < distribution X x"
+  shows "0 < real (distribution Y y * distribution X x)"
+  unfolding real_of_pinfreal_mult[symmetric]
+  using assms by (auto intro!: mult_pos_pos)
+
+lemma real_distribution_divide_pos_pos:
+  assumes "0 < distribution Y y"
+  and "0 < distribution X x"
+  shows "0 < real (distribution Y y / distribution X x)"
+  unfolding divide_pinfreal_def real_of_pinfreal_mult[symmetric]
+  using assms distribution_finite[of X x] by (cases "distribution X x") (auto intro!: mult_pos_pos)
+
+lemma real_distribution_mult_inverse_pos_pos:
+  assumes "0 < distribution Y y"
+  and "0 < distribution X x"
+  shows "0 < real (distribution Y y * inverse (distribution X x))"
+  unfolding divide_pinfreal_def real_of_pinfreal_mult[symmetric]
+  using assms distribution_finite[of X x] by (cases "distribution X x") (auto intro!: mult_pos_pos)
+
+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}))
 
-  have "- (KL_divergence b M u v) \<le> log b (\<Sum>x\<in>space M. v {x})"
-  proof (subst KL_divergence_eq_finite, safe intro!: log_setsum_divide *)
-    show "finite_measure_space (M\<lparr>measure := u\<rparr>)"
-      "finite_measure_space (M\<lparr>measure := v\<rparr>)"
-       using u v unfolding finite_prob_space_eq by simp_all
+  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
+
+      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
 
-     show "finite (space M)" using u.finite_space by simp
-     show "1 < b" by fact
-     show "(\<Sum>x\<in>space M. u {x}) = 1" using u.sum_over_space_eq_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
+*}
+
+simproc_setup mult_log ("real (distribution X x) * log b (A * B)" |
+                        "real (distribution X x) * log b (A / B)") = {* K mult_log_simproc *}
+
+end
+
+lemma (in finite_measure_space) absolutely_continuousI:
+  assumes "finite_measure_space M \<nu>"
+  assumes v: "\<And>x. \<lbrakk> x \<in> space M ; \<mu> {x} = 0 \<rbrakk> \<Longrightarrow> \<nu> {x} = 0"
+  shows "absolutely_continuous \<nu>"
+proof (unfold absolutely_continuous_def sets_eq_Pow, safe)
+  fix N assume "\<mu> N = 0" "N \<subseteq> space M"
+
+  interpret v: finite_measure_space M \<nu> by fact
 
-     fix x assume x: "x \<in> space M"
-     thus pos: "0 \<le> u {x}" "0 \<le> v {x}"
-       using u.positive u.sets_eq_Pow v.positive v.sets_eq_Pow by simp_all
+  have "\<nu> N = \<nu> (\<Union>x\<in>N. {x})" by simp
+  also have "\<dots> = (\<Sum>x\<in>N. \<nu> {x})"
+  proof (rule v.measure_finitely_additive''[symmetric])
+    show "finite N" using `N \<subseteq> space M` finite_space by (auto intro: finite_subset)
+    show "disjoint_family_on (\<lambda>i. {i}) N" unfolding disjoint_family_on_def by auto
+    fix x assume "x \<in> N" thus "{x} \<in> sets M" using `N \<subseteq> space M` sets_eq_Pow by auto
+  qed
+  also have "\<dots> = 0"
+  proof (safe intro!: setsum_0')
+    fix x assume "x \<in> N"
+    hence "\<mu> {x} \<le> \<mu> N" using sets_eq_Pow `N \<subseteq> space M` by (auto intro!: measure_mono)
+    hence "\<mu> {x} = 0" using `\<mu> N = 0` by simp
+    thus "\<nu> {x} = 0" using v[of x] `x \<in> N` `N \<subseteq> space M` by auto
+  qed
+  finally show "\<nu> N = 0" .
+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"
+  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])
+qed
 
-     { assume "v {x} = 0" from u_0[OF x this] show "u {x} = 0" . }
-     { assume "0 < u {x}"
-       hence "v {x} \<noteq> 0" using u_0[OF x] by auto
-       with pos show "0 < v {x}" by simp }
+lemma (in finite_prob_space) finite_sum_over_space_eq_1:
+  "(\<Sum>x\<in>space M. real (\<mu> {x})) = 1"
+  using sum_over_space_eq_1 finite_measure by (simp add: real_of_pinfreal_setsum sets_eq_Pow)
+
+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"
+  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
+
+  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
+
+    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 measure_finite[of "{x}"] sets_eq_Pow x
+          by (cases "\<mu> {x}") simp_all }
+    qed auto
   qed
-  thus "0 \<le> KL_divergence b M u v" using v.sum_over_space_eq_1 by simp
+  thus "0 \<le> KL_divergence b M \<nu> \<mu>" using finite_sum_over_space_eq_1 by simp
 qed
 
 definition (in prob_space)
-  "mutual_information b s1 s2 X Y \<equiv>
-    let prod_space =
-      prod_measure_space (\<lparr>space = space s1, sets = sets s1, measure = distribution X\<rparr>)
-                         (\<lparr>space = space s2, sets = sets s2, measure = distribution Y\<rparr>)
-    in
-      KL_divergence b prod_space (joint_distribution X Y) (measure prod_space)"
+  "mutual_information b S T X Y =
+    KL_divergence b (prod_measure_space S T)
+      (joint_distribution X Y)
+      (prod_measure S (distribution X) T (distribution Y))"
 
 abbreviation (in finite_information_space)
   finite_mutual_information ("\<I>'(_ ; _')") where
@@ -275,20 +341,18 @@
     \<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_measure_space) measure_spaceI: "measure_space M"
-  by unfold_locales
-
 lemma prod_measure_times_finite:
-  assumes fms: "finite_measure_space M" "finite_measure_space M'" and a: "a \<in> space M \<times> space M'"
-  shows "prod_measure M M' {a} = measure M {fst a} * measure M' {snd a}"
+  assumes fms: "finite_measure_space M \<mu>" "finite_measure_space N \<nu>" and a: "a \<in> space M \<times> space N"
+  shows "prod_measure M \<mu> N \<nu> {a} = \<mu> {fst a} * \<nu> {snd a}"
 proof (cases a)
   case (Pair b c)
   hence a_eq: "{a} = {b} \<times> {c}" by simp
 
-  with fms[THEN finite_measure_space.measure_spaceI]
-    fms[THEN finite_measure_space.sets_eq_Pow] a Pair
-  show ?thesis unfolding a_eq
-    by (subst prod_measure_times) simp_all
+  interpret M: finite_measure_space M \<mu> by fact
+  interpret N: finite_measure_space N \<nu> by fact
+
+  from finite_measure_space.finite_prod_measure_times[OF fms, of "{b}" "{c}"] M.sets_eq_Pow N.sets_eq_Pow a Pair
+  show ?thesis unfolding a_eq by simp
 qed
 
 lemma setsum_cartesian_product':
@@ -296,44 +360,44 @@
   unfolding setsum_cartesian_product by simp
 
 lemma (in finite_information_space)
-  assumes MX: "finite_prob_space \<lparr> space = space MX, sets = sets MX, measure = distribution X\<rparr>"
-    (is "finite_prob_space ?MX")
-  assumes MY: "finite_prob_space \<lparr> space = space MY, sets = sets MY, measure = distribution Y\<rparr>"
-    (is "finite_prob_space ?MY")
+  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:
     "mutual_information b MX MY X Y = (\<Sum> (x,y) \<in> space MX \<times> space MY.
-      joint_distribution X Y {(x,y)} *
-      log b (joint_distribution X Y {(x,y)} /
-      (distribution X {x} * distribution Y {y})))"
+      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")
   and mutual_information_positive_generic:
     "0 \<le> mutual_information b MX MY X Y" (is "?positive")
 proof -
-  let ?P = "prod_measure_space ?MX ?MY"
-  let ?measure = "joint_distribution X Y"
-  let ?P' = "measure_update (\<lambda>_. ?measure) ?P"
+  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" using MX .
-  moreover interpret Y: finite_prob_space "?MY" using MY .
-  ultimately have ms_X: "measure_space ?MX"
-    and ms_Y: "measure_space ?MY" by unfold_locales
+  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> .
 
-  have fms_P: "finite_measure_space ?P"
-      by (rule finite_measure_space_finite_prod_measure) fact+
-
-  have fms_P': "finite_measure_space ?P'"
+  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)
+      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 x_in_MX: "{fst x} \<in> sets MX" using X.sets_eq_Pow
+    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 "measure ?P {x} = 0"
-    with prod_measure_times[OF ms_X ms_Y, of "{fst x}" "{snd x}"] x_in_MX
+    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)
 
@@ -342,33 +406,34 @@
   note measure_0 = this
 
   show ?equality
-    unfolding Let_def mutual_information_def using fms_P fms_P' measure_0 MX MY
-    by (subst KL_divergence_eq_finite)
-       (simp_all add: prod_measure_space_def prod_measure_times_finite
-         finite_prob_space_eq setsum_cartesian_product')
+    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])
 
   show ?positive
     unfolding Let_def mutual_information_def using measure_0 b_gt_1
-  proof (safe intro!: KL_divergence_positive_finite, simp_all)
-    from ms_X ms_Y X.top Y.top X.prob_space Y.prob_space
-    have "measure ?P (space ?P) = 1"
-      by (simp add: prod_measure_space_def, subst prod_measure_times, simp_all)
-    with fms_P show "finite_prob_space ?P"
+  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.prob_space Y.prob_space Y.not_empty X_space Y_space
-    have "measure ?P' (space ?P') = 1" unfolding prob_space[symmetric]
-      by (auto simp add: prod_measure_space_def distribution_def vimage_Times comp_def
-        intro!: arg_cong[where f=prob])
-    with fms_P' show "finite_prob_space ?P'"
+    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
 qed
 
 lemma (in finite_information_space) mutual_information_eq:
   "\<I>(X;Y) = (\<Sum> (x,y) \<in> X ` space M \<times> Y ` space M.
-    distribution (\<lambda>x. (X x, Y x)) {(x,y)} * log b (distribution (\<lambda>x. (X x, Y x)) {(x,y)} /
-                                                   (distribution X {x} * distribution Y {y})))"
+    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)
 
 lemma (in finite_information_space) mutual_information_positive: "0 \<le> \<I>(X;Y)"
@@ -383,18 +448,19 @@
 
 lemma (in finite_information_space) joint_distribution_remove[simp]:
     "joint_distribution X X {(x, x)} = distribution X {x}"
-  unfolding distribution_def by (auto intro!: arg_cong[where f=prob])
+  unfolding distribution_def by (auto intro!: arg_cong[where f="\<mu>"])
 
 lemma (in finite_information_space) entropy_eq:
-  "\<H>(X) = -(\<Sum> x \<in> X ` space M. distribution X {x} * log b (distribution X {x}))"
+  "\<H>(X) = -(\<Sum> x \<in> X ` space M. real (distribution X {x}) * log b (real (distribution X {x})))"
 proof -
   { fix f
-  { fix x y
-    have "(\<lambda>x. (X x, X x)) -` {(x, y)} = (if x = y then X -` {x} else {})" by auto
-      hence "distribution (\<lambda>x. (X x, X x))  {(x,y)} * f x y = (if x = y then distribution X {x} * f x y else 0)"
-      unfolding distribution_def by auto }
-    hence "(\<Sum>(x, y) \<in> X ` space M \<times> X ` space M. joint_distribution X X {(x, y)} * f x y) =
-      (\<Sum>x \<in> X ` space M. distribution X {x} * f x x)"
+    { fix x y
+      have "(\<lambda>x. (X x, X x)) -` {(x, y)} = (if x = y then X -` {x} else {})" by auto
+        hence "real (distribution (\<lambda>x. (X x, X x))  {(x,y)}) * f x y =
+            (if x = y then real (distribution X {x}) * f x y else 0)"
+        unfolding distribution_def by auto }
+    hence "(\<Sum>(x, y) \<in> X ` space M \<times> X ` space M. real (joint_distribution X X {(x, y)}) * f x y) =
+      (\<Sum>x \<in> X ` space M. real (distribution X {x}) * f x x)"
       unfolding setsum_cartesian_product' by (simp add: setsum_cases finite_space) }
   note remove_cartesian_product = this
 
@@ -407,13 +473,9 @@
   unfolding entropy_def using mutual_information_positive .
 
 definition (in prob_space)
-  "conditional_mutual_information b s1 s2 s3 X Y Z \<equiv>
-    let prod_space =
-      prod_measure_space \<lparr>space = space s2, sets = sets s2, measure = distribution Y\<rparr>
-                         \<lparr>space = space s3, sets = sets s3, measure = distribution Z\<rparr>
-    in
-      mutual_information b s1 prod_space X (\<lambda>x. (Y x, Z x)) -
-      mutual_information b s1 s3 X Z"
+  "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 M3 X Z"
 
 abbreviation (in finite_information_space)
   finite_conditional_mutual_information ("\<I>'( _ ; _ | _ ')") where
@@ -441,19 +503,37 @@
   "(\<Sum>z \<in> Z`space M. joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)}) = joint_distribution X Y {(x, y)}"
   by (auto intro!: inj_onI setsum_distribution_gen)
 
+lemma (in finite_information_space) setsum_real_distribution_gen:
+  assumes "Z -` {c} \<inter> space M = (\<Union>x \<in> X`space M. Y -` {f x}) \<inter> space M"
+  and "inj_on f (X`space M)"
+  shows "(\<Sum>x \<in> X`space M. real (distribution Y {f x})) = real (distribution Z {c})"
+  unfolding distribution_def assms
+  using finite_space assms
+  by (subst real_finite_measure_finite_Union[symmetric])
+     (auto simp add: disjoint_family_on_def sets_eq_Pow inj_on_def
+        intro!: arg_cong[where f=prob])
+
+lemma (in finite_information_space) setsum_real_distribution:
+  "(\<Sum>x \<in> X`space M. real (joint_distribution X Y {(x, y)})) = real (distribution Y {y})"
+  "(\<Sum>y \<in> Y`space M. real (joint_distribution X Y {(x, y)})) = real (distribution X {x})"
+  "(\<Sum>x \<in> X`space M. real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)})) = real (joint_distribution Y Z {(y, z)})"
+  "(\<Sum>y \<in> Y`space M. real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)})) = real (joint_distribution X Z {(x, z)})"
+  "(\<Sum>z \<in> Z`space M. real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, y, z)})) = real (joint_distribution X Y {(x, y)})"
+  by (auto intro!: inj_onI setsum_real_distribution_gen)
+
 lemma (in finite_information_space) conditional_mutual_information_eq_sum:
    "\<I>(X ; Y | Z) =
      (\<Sum>(x, y, z)\<in>X ` space M \<times> (\<lambda>x. (Y x, Z x)) ` space M.
-             distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)} *
-             log b (distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)}/
-        distribution (\<lambda>x. (Y x, Z x)) {(y, z)})) -
+             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 (distribution (\<lambda>x. (Y x, Z x)) {(y, z)}))) -
      (\<Sum>(x, z)\<in>X ` space M \<times> Z ` space M.
-        distribution (\<lambda>x. (X x, Z x)) {(x,z)} * log b (distribution (\<lambda>x. (X x, Z x)) {(x,z)} / distribution Z {z}))"
+        real (distribution (\<lambda>x. (X x, Z x)) {(x,z)}) * log b (real (distribution (\<lambda>x. (X x, Z x)) {(x,z)}) / real (distribution Z {z})))"
   (is "_ = ?rhs")
 proof -
   have setsum_product:
-    "\<And>f x. (\<Sum>v\<in>(\<lambda>x. (Y x, Z x)) ` space M. joint_distribution X (\<lambda>x. (Y x, Z x)) {(x,v)} * f v)
-      = (\<Sum>v\<in>Y ` space M \<times> Z ` space M. joint_distribution X (\<lambda>x. (Y x, Z x)) {(x,v)} * f v)"
+    "\<And>f x. (\<Sum>v\<in>(\<lambda>x. (Y x, Z x)) ` space M. real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x,v)}) * f v)
+      = (\<Sum>v\<in>Y ` space M \<times> Z ` space M. real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x,v)}) * f v)"
   proof (safe intro!: setsum_mono_zero_cong_left imageI)
     fix x y z f
     assume *: "(Y y, Z z) \<notin> (\<lambda>x. (Y x, Z x)) ` space M" and "y \<in> space M" "z \<in> space M"
@@ -463,31 +543,32 @@
       have "(Y y, Z z) \<in> (\<lambda>x. (Y x, Z x)) ` space M" using eq[symmetric] x' by auto
       thus "x' \<in> {}" using * by auto
     qed
-    thus "joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, Y y, Z z)} * f (Y y) (Z z) = 0"
+    thus "real (joint_distribution X (\<lambda>x. (Y x, Z x)) {(x, Y y, Z z)}) * f (Y y) (Z z) = 0"
       unfolding distribution_def by simp
   qed (simp add: finite_space)
 
   thus ?thesis
     unfolding conditional_mutual_information_def Let_def mutual_information_eq
-    apply (subst mutual_information_eq_generic)
-    by (auto simp add: prod_measure_space_def sigma_prod_sets_finite finite_space
+    by (subst mutual_information_eq_generic)
+       (auto simp: prod_measure_space_def sigma_prod_sets_finite finite_space sigma_def
         finite_prob_space_of_images finite_product_prob_space_of_images
         setsum_cartesian_product' setsum_product setsum_subtractf setsum_addf
-        setsum_left_distrib[symmetric] setsum_distribution
+        setsum_left_distrib[symmetric] setsum_real_distribution
       cong: setsum_cong)
 qed
 
 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.
-             distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)} *
-             log b (distribution (\<lambda>x. (X x, Y x, Z x)) {(x, y, z)}/
-    (joint_distribution X Z {(x, z)} * joint_distribution Y Z {(y,z)} / distribution Z {z})))"
+             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}))))"
   unfolding conditional_mutual_information_def Let_def mutual_information_eq
-    apply (subst mutual_information_eq_generic)
-  by (auto simp add: prod_measure_space_def sigma_prod_sets_finite finite_space
-      finite_prob_space_of_images finite_product_prob_space_of_images
+  by (subst mutual_information_eq_generic)
+     (auto simp add: prod_measure_space_def sigma_prod_sets_finite finite_space
+      finite_prob_space_of_images finite_product_prob_space_of_images sigma_def
       setsum_cartesian_product' setsum_product setsum_subtractf setsum_addf
-      setsum_left_distrib[symmetric] setsum_distribution setsum_commute[where A="Y`space M"]
+      setsum_left_distrib[symmetric] setsum_real_distribution setsum_commute[where A="Y`space M"]
+      real_of_pinfreal_mult[symmetric]
     cong: setsum_cong)
 
 lemma (in finite_information_space) conditional_mutual_information_eq_mutual_information:
@@ -500,14 +581,30 @@
     by (simp add: setsum_cartesian_product' distribution_remove_const)
 qed
 
+lemma (in finite_prob_space) distribution_finite:
+  "distribution X A \<noteq> \<omega>"
+  by (auto simp: sets_eq_Pow distribution_def intro!: measure_finite)
+
+lemma (in finite_prob_space) real_distribution_order:
+  shows "r \<le> real (joint_distribution X Y {(x, y)}) \<Longrightarrow> r \<le> real (distribution X {x})"
+  and "r \<le> real (joint_distribution X Y {(x, y)}) \<Longrightarrow> r \<le> real (distribution Y {y})"
+  and "r < real (joint_distribution X Y {(x, y)}) \<Longrightarrow> r < real (distribution X {x})"
+  and "r < real (joint_distribution X Y {(x, y)}) \<Longrightarrow> r < real (distribution Y {y})"
+  and "distribution X {x} = 0 \<Longrightarrow> real (joint_distribution X Y {(x, y)}) = 0"
+  and "distribution Y {y} = 0 \<Longrightarrow> real (joint_distribution X Y {(x, y)}) = 0"
+  using real_of_pinfreal_mono[OF distribution_finite joint_distribution_restriction_fst, of X Y "{(x, y)}"]
+  using real_of_pinfreal_mono[OF distribution_finite joint_distribution_restriction_snd, of X Y "{(x, y)}"]
+  using real_pinfreal_nonneg[of "joint_distribution X Y {(x, y)}"]
+  by auto
+
 lemma (in finite_information_space) conditional_mutual_information_positive:
   "0 \<le> \<I>(X ; Y | Z)"
 proof -
-  let ?dXYZ = "distribution (\<lambda>x. (X x, Y x, Z x))"
-  let ?dXZ = "joint_distribution X Z"
-  let ?dYZ = "joint_distribution Y Z"
-  let ?dX = "distribution X"
-  let ?dZ = "distribution Z"
+  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"
 
   have split_beta: "\<And>f. split f = (\<lambda>x. f (fst x) (snd x))" by (simp add: expand_fun_eq)
@@ -521,26 +618,28 @@
     show "1 < b" using b_gt_1 .
 
     fix x assume "x \<in> ?M"
-    show "0 \<le> ?dXYZ {(fst x, fst (snd x), snd (snd x))}" using positive_distribution .
+    let ?x = "(fst x, fst (snd x), snd (snd x))"
+
+    show "0 \<le> ?dXYZ {?x}" using real_pinfreal_nonneg .
     show "0 \<le> ?dXZ {(fst x, snd (snd x))} * ?dYZ {(fst (snd x), snd (snd x))} / ?dZ {snd (snd x)}"
-      by (auto intro!: mult_nonneg_nonneg positive_distribution simp: zero_le_divide_iff)
+     by (simp add: real_pinfreal_nonneg mult_nonneg_nonneg divide_nonneg_nonneg)
 
-    assume *: "0 < ?dXYZ {(fst x, fst (snd x), snd (snd x))}"
+    assume *: "0 < ?dXYZ {?x}"
     thus "0 < ?dXZ {(fst x, snd (snd x))} * ?dYZ {(fst (snd x), snd (snd x))} / ?dZ {snd (snd x)}"
-      by (auto intro!: divide_pos_pos mult_pos_pos
-           intro: distribution_order(6) distribution_mono_gt_0)
-  qed (simp_all add: setsum_cartesian_product' sum_over_space_distrib setsum_distribution finite_space)
+      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})"
     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_distribution
+    by (auto simp: setsum_divide_distrib[symmetric] setsum_product[symmetric] setsum_real_distribution
           intro!: setsum_cong)
   finally show ?thesis
-    unfolding conditional_mutual_information_eq sum_over_space_distrib by simp
+    unfolding conditional_mutual_information_eq sum_over_space_real_distribution
+    by (simp add: real_of_pinfreal_mult[symmetric])
 qed
 
-
 definition (in prob_space)
   "conditional_entropy b S T X Y = conditional_mutual_information b S S T X X Y"
 
@@ -556,8 +655,8 @@
 lemma (in finite_information_space) conditional_entropy_eq:
   "\<H>(X | Z) =
      - (\<Sum>(x, z)\<in>X ` space M \<times> Z ` space M.
-         joint_distribution X Z {(x, z)} *
-         log b (joint_distribution X Z {(x, z)} / distribution Z {z}))"
+         real (joint_distribution X Z {(x, z)}) *
+         log b (real (joint_distribution X Z {(x, z)}) / real (distribution Z {z})))"
 proof -
   have *: "\<And>x y z. (\<lambda>x. (X x, X x, Z x)) -` {(x, y, z)} = (if x = y then (\<lambda>x. (X x, Z x)) -` {(x, z)} else {})" by auto
   show ?thesis
@@ -571,7 +670,7 @@
   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_distribution)
+      setsum_left_distrib[symmetric] setsum_addf setsum_real_distribution)
 
 lemma (in finite_information_space) conditional_entropy_less_eq_entropy:
   "\<H>(X | Z) \<le> \<H>(X)"
@@ -587,9 +686,8 @@
   assumes "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),
-    measure = distribution X\<rparr>" by (rule finite_prob_space_of_images)
+  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)
 
   have "distribution X (X ` space M - {x}) = distribution X (X ` space M) - distribution X {x}"
     using X.measure_compl[of "{x}"] assms by auto
@@ -598,10 +696,10 @@
 
   { 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 X.positive[of "{y}"] asm
+    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> distribution X {y} = (if x = y then 1 else 0)"
+  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
@@ -610,71 +708,32 @@
 qed
 (* --------------- upper bound on entropy for a rv ------------------------- *)
 
+lemma (in finite_prob_space) distribution_1:
+  "distribution X A \<le> 1"
+  unfolding distribution_def measure_space_1[symmetric]
+  by (auto intro!: measure_mono simp: sets_eq_Pow)
+
+lemma (in finite_prob_space) real_distribution_1:
+  "real (distribution X A) \<le> 1"
+  unfolding real_pinfreal_1[symmetric]
+  by (rule real_of_pinfreal_mono[OF _ distribution_1]) simp
+
 lemma (in finite_information_space) finite_entropy_le_card:
   "\<H>(X) \<le> log b (real (card (X ` space M \<inter> {x . distribution X {x} \<noteq> 0})))"
 proof -
-  interpret X: finite_prob_space "\<lparr>space = X ` space M,
-                                    sets = Pow (X ` space M),
-                                 measure = distribution X\<rparr>"
-    using finite_prob_space_of_images by auto
-
-  have triv: "\<And> x. (if distribution X {x} \<noteq> 0 then distribution X {x} else 0) = distribution X {x}"
+  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])
+  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
-  hence sum1: "(\<Sum> x \<in> X ` space M \<inter> {y. distribution X {y} \<noteq> 0}. distribution X {x}) = 1"
-    using X.measure_finitely_additive''[of "X ` space M" "\<lambda> x. {x}", simplified]
-      sets_eq_Pow inj_singleton[unfolded inj_on_def, rule_format]
-    unfolding disjoint_family_on_def  X.prob_space[symmetric]
-    using finite_imageI[OF finite_space, of X] by (auto simp add:triv setsum_restrict_set)
-  have pos: "\<And> x. x \<in> X ` space M \<inter> {y. distribution X {y} \<noteq> 0} \<Longrightarrow> inverse (distribution X {x}) > 0"
-    using X.positive sets_eq_Pow unfolding inverse_positive_iff_positive less_le by auto
-  { assume asm: "X ` space M \<inter> {y. distribution X {y} \<noteq> 0} = {}" 
-    { fix x assume "x \<in> X ` space M"
-      hence "distribution X {x} = 0" using asm by blast }
-    hence A: "(\<Sum> x \<in> X ` space M. distribution X {x}) = 0" by auto
-    have B: "(\<Sum> x \<in> X ` space M. distribution X {x})
-      \<ge> (\<Sum> x \<in> X ` space M \<inter> {y. distribution X {y} \<noteq> 0}. distribution X {x})"
-      using finite_imageI[OF finite_space, of X]
-      by (subst setsum_mono2) auto
-    from A B have "False" using sum1 by auto } note not_empty = this
-  { fix x assume asm: "x \<in> X ` space M"
-    have "- distribution X {x} * log b (distribution X {x})
-       = - (if distribution X {x} \<noteq> 0 
-            then distribution X {x} * log b (distribution X {x})
-            else 0)"
-      by auto
-    also have "\<dots> = (if distribution X {x} \<noteq> 0 
-          then distribution X {x} * - log b (distribution X {x})
-          else 0)"
-      by auto
-    also have "\<dots> = (if distribution X {x} \<noteq> 0
-                    then distribution X {x} * log b (inverse (distribution X {x}))
-                    else 0)"
-      using log_inverse b_gt_1 X.positive[of "{x}"] asm by auto
-    finally have "- distribution X {x} * log b (distribution X {x})
-                 = (if distribution X {x} \<noteq> 0 
-                    then distribution X {x} * log b (inverse (distribution X {x}))
-                    else 0)"
-      by auto } note log_inv = this
-  have "- (\<Sum> x \<in> X ` space M. distribution X {x} * log b (distribution X {x}))
-       = (\<Sum> x \<in> X ` space M. (if distribution X {x} \<noteq> 0 
-          then distribution X {x} * log b (inverse (distribution X {x}))
-          else 0))"
-    unfolding setsum_negf[symmetric] using log_inv by auto
-  also have "\<dots> = (\<Sum> x \<in> X ` space M \<inter> {y. distribution X {y} \<noteq> 0}.
-                          distribution X {x} * log b (inverse (distribution X {x})))"
-    unfolding setsum_restrict_set[OF finite_imageI[OF finite_space, of X]] by auto
-  also have "\<dots> \<le> log b (\<Sum> x \<in> X ` space M \<inter> {y. distribution X {y} \<noteq> 0}.
-                          distribution X {x} * (inverse (distribution X {x})))"
-    apply (subst log_setsum[OF _ _ b_gt_1 sum1, 
-     unfolded greaterThan_iff, OF _ _ _]) using pos sets_eq_Pow
-      X.finite_space assms X.positive not_empty by auto
-  also have "\<dots> = log b (\<Sum> x \<in> X ` space M \<inter> {y. distribution X {y} \<noteq> 0}. 1)"
-    by auto
-  also have "\<dots> \<le> log b (real_of_nat (card (X ` space M \<inter> {y. distribution X {y} \<noteq> 0})))"
-    by auto
-  finally have "- (\<Sum>x\<in>X ` space M. distribution X {x} * log b (distribution X {x}))
-               \<le> log b (real_of_nat (card (X ` space M \<inter> {y. distribution X {y} \<noteq> 0})))" by simp
-  thus ?thesis unfolding entropy_eq real_eq_of_nat by auto
+  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: expand_fun_eq real_of_pinfreal_eq_0)
+  finally show ?thesis
+    using finite_space by (auto simp: setsum_cases real_eq_of_nat)
 qed
 
 (* --------------- entropy is maximal for a uniform rv --------------------- *)
@@ -689,7 +748,7 @@
   have "1 = prob (space M)"
     using prob_space by auto
   also have "\<dots> = (\<Sum> x \<in> space M. prob {x})"
-    using measure_finitely_additive''[of "space M" "\<lambda> x. {x}", simplified]
+    using real_finite_measure_finite_Union[of "space M" "\<lambda> x. {x}", simplified]
       sets_eq_Pow inj_singleton[unfolded inj_on_def, rule_format]
       finite_space unfolding disjoint_family_on_def  prob_space[symmetric]
     by (auto simp add:setsum_restrict_set)
@@ -708,33 +767,21 @@
   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 -
-  interpret X: finite_prob_space "\<lparr>space = X ` space M,
-                                    sets = Pow (X ` space M),
-                                 measure = distribution X\<rparr>"
-    using finite_prob_space_of_images by auto
+  note uniform =
+    finite_prob_space_of_images[of X, THEN finite_prob_space.uniform_prob, simplified]
+
+  have card_gt0: "0 < card (X ` space M)" unfolding card_gt_0_iff
+    using finite_space not_empty by auto
 
-  { fix x assume xasm: "x \<in> X ` space M"
-    hence card_gt0: "real (card (X ` space M)) > 0"
-      using card_gt_0_iff X.finite_space by auto
-    from xasm have "\<And> y. y \<in> X ` space M \<Longrightarrow> distribution X {y} = distribution X {x}"
-      using assms by blast
-    hence "- (\<Sum>x\<in>X ` space M. distribution X {x} * log b (distribution X {x}))
-         = - real (card (X ` space M)) * distribution X {x} * log b (distribution X {x})"
-      unfolding real_eq_of_nat by auto
-    also have "\<dots> = - real (card (X ` space M)) * (1 / real (card (X ` space M))) * log b (1 / real (card (X ` space M)))"
-      by (auto simp: X.uniform_prob[simplified, OF xasm assms])
-    also have "\<dots> = log b (real (card (X ` space M)))"
-      unfolding inverse_eq_divide[symmetric]
-      using card_gt0 log_inverse b_gt_1
-      by (auto simp add:field_simps card_gt0)
-    finally have ?thesis
-      unfolding entropy_eq by auto }
-  moreover
-  { assume "X ` space M = {}"
-    hence "distribution X (X ` space M) = 0"
-      using X.empty_measure by simp
-    hence "False" using X.prob_space by auto }
-  ultimately show ?thesis by auto
+  { fix x assume "x \<in> X ` space M"
+    hence "real (distribution X {x}) = 1 / real (card (X ` space M))"
+    proof (rule uniform)
+      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
+    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)
 qed
 
 definition "subvimage A f g \<longleftrightarrow> (\<forall>x \<in> A. f -` {f x} \<inter> A \<subseteq> g -` {g x} \<inter> A)"
@@ -854,13 +901,13 @@
   assumes svi: "subvimage (space M) X P"
   shows "\<H>(X) = \<H>(P) + \<H>(X|P)"
 proof -
-  have "(\<Sum>x\<in>X ` space M. distribution X {x} * log b (distribution X {x})) =
+  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.
-    joint_distribution X P {(x, y)} * log b (joint_distribution X P {(x, y)}))"
+    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)
     fix p x assume in_space: "p \<in> space M" "x \<in> space M"
-    assume "joint_distribution X P {(X x, P p)} * log b (joint_distribution X P {(X x, P p)}) \<noteq> 0"
+    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)
     with svi[unfolded subvimage_def, rule_format, OF `x \<in> space M`]
     show "x \<in> P -` {P p}" by auto
@@ -872,14 +919,14 @@
       by auto
     hence "(\<lambda>x. (X x, P x)) -` {(X x, P p)} \<inter> space M = X -` {X x} \<inter> space M"
       by auto
-    thus "distribution X {X x} * log b (distribution X {X x}) =
-          joint_distribution X P {(X x, P p)} *
-          log b (joint_distribution X P {(X x, P p)})"
+    thus "real (distribution X {X x}) * log b (real (distribution X {X x})) =
+          real (joint_distribution X P {(X x, P p)}) *
+          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
-    by (simp add: setsum_cartesian_product' setsum_subtractf setsum_distribution
+    by (simp add: setsum_cartesian_product' setsum_subtractf setsum_real_distribution
       setsum_left_distrib[symmetric] setsum_commute[where B="P`space M"])
 qed
 
@@ -891,14 +938,14 @@
   assumes "\<And>x. x \<in> space M \<Longrightarrow> X x = Y x"
   shows "distribution X = distribution Y"
   unfolding distribution_def expand_fun_eq
-  using assms by (auto intro!: arg_cong[where f=prob])
+  using assms by (auto intro!: arg_cong[where f="\<mu>"])
 
 lemma (in prob_space) joint_distribution_cong:
   assumes "\<And>x. x \<in> space M \<Longrightarrow> X x = X' x"
   assumes "\<And>x. x \<in> space M \<Longrightarrow> Y x = Y' x"
   shows "joint_distribution X Y = joint_distribution X' Y'"
   unfolding distribution_def expand_fun_eq
-  using assms by (auto intro!: arg_cong[where f=prob])
+  using assms by (auto intro!: arg_cong[where f="\<mu>"])
 
 lemma image_cong:
   "\<lbrakk> \<And>x. x \<in> S \<Longrightarrow> X x = X' x \<rbrakk> \<Longrightarrow> X ` S = X' ` S"
--- a/src/HOL/Probability/Lebesgue.thy	Mon Aug 23 17:46:13 2010 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,1733 +0,0 @@
-header {*Lebesgue Integration*}
-
-theory Lebesgue
-imports Measure Borel
-begin
-
-text{*From the HOL4 Hurd/Coble Lebesgue integration, translated by Armin Heller and Johannes Hoelzl.*}
-
-definition
-  "pos_part f = (\<lambda>x. max 0 (f x))"